ASFcnMgr.pas

unit ASFcnMgr;

{ **************************************************************************** }
{ Rejbrand AlgoSim Function Manager                                            }
{ Copyright © 2018 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  SysUtils, Types, Classes, ASKernelDefs, ASExpression, Generics.Defaults,
  Generics.Collections, GenHelpers;

type
  FunctionAttribute = class(TCustomAttribute)
  strict private
    FNames: TArray<string>;
  public
    constructor Create(const AName: string); overload;
    constructor Create(const AName1, AName2: string); overload;
    constructor Create(const AName1, AName2, AName3: string); overload;
    property Names: TArray<string> read FNames;
  end;

  TFcnCategory = (fcSystem, fcGeneral, fcMath, fcTrigonometry, fcHyperbolic,
    fcNumberTheory, fcLogic, fcSets, fcStrings, fcTables, fcLists, fcStructures,
    fcDateTime, fcPixmaps, fcSounds, fcMIDI, fcBinaryData, fcVisualization);

  TFcnCategoryHelper = record helper for TFcnCategory
    function ToString: string;
  end;

  CategoryAttribute = class(TCustomAttribute)
  strict private
    FCategories: TArray<TFcnCategory>;
  public
    constructor Create(const ACat: TFcnCategory); overload;
    constructor Create(const ACat1, ACat2: TFcnCategory); overload;
    constructor Create(const ACat1, ACat2, ACat3: TFcnCategory); overload;
    constructor Create(const ACat1, ACat2, ACat3, ACat4: TFcnCategory); overload;
    constructor Create(const ACat1, ACat2, ACat3, ACat4, ACat5: TFcnCategory); overload;
    property Categories: TArray<TFcnCategory> read FCategories;
  end;

  TFunctionMgr = record
    class var Functions: TDictionary<string, TASFunctionClass>;
    class var Names: TDictionary<TASFunctionClass, TArray<string>>;
    class var Categories: TDictionary<TASFunctionClass, TArray<TFcnCategory>>;
    class var FcnNames: TArray<string>;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  end;

implementation

uses
  System.Rtti;

{ TFunctionAttribute }

constructor FunctionAttribute.Create(const AName: string);
begin
  FNames := [AName];
end;

constructor FunctionAttribute.Create(const AName1, AName2: string);
begin
  FNames := [AName1, AName2];
end;

constructor FunctionAttribute.Create(const AName1, AName2, AName3: string);
begin
  FNames := [AName1, AName2, AName3];
end;

{ CategoryAttribute }

constructor CategoryAttribute.Create(const ACat: TFcnCategory);
begin
  FCategories := [ACat];
end;

constructor CategoryAttribute.Create(const ACat1, ACat2: TFcnCategory);
begin
  FCategories := [ACat1, ACat2];
end;

constructor CategoryAttribute.Create(const ACat1, ACat2, ACat3: TFcnCategory);
begin
  FCategories := [ACat1, ACat2, ACat3];
end;

constructor CategoryAttribute.Create(const ACat1, ACat2, ACat3,
  ACat4: TFcnCategory);
begin
  FCategories := [ACat1, ACat2, ACat3, ACat4];
end;

constructor CategoryAttribute.Create(const ACat1, ACat2, ACat3, ACat4,
  ACat5: TFcnCategory);
begin
  FCategories := [ACat1, ACat2, ACat3, ACat4, ACat5];
end;

{ TFunctionMgr }

class constructor TFunctionMgr.ClassCreate;
var
  Context: TRttiContext;
  &Type: TRttiType;
  Attribute: TCustomAttribute;
  i: Integer;
begin

  Functions := TDictionary<string, TASFunctionClass>.Create;
  Names := TDictionary<TASFunctionClass, TArray<string>>.Create;
  Categories := TDictionary<TASFunctionClass, TArray<TFcnCategory>>.Create;

  Context := TRttiContext.Create;
  try
    for &Type in Context.GetTypes do
      if &Type.IsInstance and TRttiInstanceType(&Type).MetaclassType.InheritsFrom(TASFunction) then
        for Attribute in &Type.GetAttributes do
          if Attribute is FunctionAttribute then
          begin
            for i := 0 to High(FunctionAttribute(Attribute).Names) do
              Functions.Add(
                FunctionAttribute(Attribute).Names[i],
                TASFunctionClass(TRttiInstanceType(&Type).MetaclassType)
              );
            Names.Add(
              TASFunctionClass(TRttiInstanceType(&Type).MetaclassType),
              FunctionAttribute(Attribute).Names
            );
          end
          else if Attribute is CategoryAttribute then
            Categories.Add(
              TASFunctionClass(TRttiInstanceType(&Type).MetaclassType),
              CategoryAttribute(Attribute).Categories
            )
  finally
    Context.Free;
  end;

  FcnNames := Functions.Keys.ToArray;
  TArray.Sort<string>(
    FcnNames,
    TComparer<string>.Construct(
      function(const Left, Right: string): Integer
      begin
        Result := CompareText(Left, Right);
      end
    )
    );

end;

class destructor TFunctionMgr.ClassDestroy;
begin
  FreeAndNil(Categories);
  FreeAndNil(Names);
  FreeAndNil(Functions);
end;

{ TFcnCategoryHelper }

function TFcnCategoryHelper.ToString: string;
begin
  case Self of
    fcSystem:
      Result := 'system';
    fcGeneral:
      Result := 'general';
    fcMath:
      Result := 'math';
    fcTrigonometry:
      Result := 'trigonometry';
    fcHyperbolic:
      Result := 'hyperbolic';
    fcNumberTheory:
      Result := 'number theory';
    fcLogic:
      Result := 'logic';
    fcSets:
      Result := 'sets';
    fcStrings:
      Result := 'strings';
    fcTables:
      Result := 'tables';
    fcLists:
      Result := 'lists';
    fcStructures:
      Result := 'structures';
    fcDateTime:
      Result := 'datetime';
    fcPixmaps:
      Result := 'pixmaps';
    fcSounds:
      Result := 'sounds';
    fcMIDI:
      Result := 'MIDI';
    fcBinaryData:
      Result := 'binary data';
    fcVisualization:
      Result := 'visualization';
  else
    Result := '';
  end;
end;

end.