MycLib/Src/Data/Myc.Data.Keyword.pas

unit Myc.Data.Keyword;

interface

uses
    System.SysUtils,
    System.Classes,
    System.Generics.Collections,
    System.SyncObjs;

type
    // The runtime representation of an interned keyword
    IKeyword = interface(IInterface)
        function GetIdx: Integer;
        function GetName: string;
        property Idx: Integer read GetIdx;
        property Name: string read GetName;
    end;

    // Factory and registry for all keywords (Flyweight Pattern)
    TKeywordRegistry = record
    strict private
        type
            TKeyword = class(TInterfacedObject, IKeyword)
            private
                FName: string;
                FIdx: Integer;
                function GetName: string;
                function GetIdx: Integer;
            public
                constructor Create(const AName: string; AIdx: Integer);
            end;
    strict private
        class var
            FLock: TSpinLock;
        class var
            FRegistry: TDictionary<string, IKeyword>;
        class constructor Create;
        class destructor Destroy;
    public
        // Gets or creates the interned keyword for the given name.
        class function Intern(const AName: string): IKeyword; static;
    end;

    TKeywordMapping<T> = record
        type
            TField = record
                Key: IKeyword;
                Value: T;
            public
                constructor Create(const AKey: IKeyword; const AValue: T);
            end;
    private
        FMap: TArray<Integer>;
        FFields: TArray<TField>;
        FFirst, FLast: Integer;
    public
        constructor Create(const AFields: TArray<TField>);
        function IndexOf(const Key: IKeyword): Integer;
        property Fields: TArray<TField> read FFields;
    end;

implementation

{ TKeywordRegistry.TKeyword }

constructor TKeywordRegistry.TKeyword.Create(const AName: string; AIdx: Integer);
begin
    inherited Create;
    FName := AName;
    FIdx := AIdx;
end;

function TKeywordRegistry.TKeyword.GetIdx: Integer;
begin
    Result := FIdx;
end;

function TKeywordRegistry.TKeyword.GetName: string;
begin
    Result := FName;
end;

{ TKeywordRegistry }

class constructor TKeywordRegistry.Create;
begin
    FLock := TSpinLock.Create(false);
    FRegistry := TDictionary<string, IKeyword>.Create;
end;

class destructor TKeywordRegistry.Destroy;
begin
    FRegistry.Free;
end;

class function TKeywordRegistry.Intern(const AName: string): IKeyword;
begin
    FLock.Enter;
    try
        if not FRegistry.TryGetValue(AName, Result) then
        begin
            Result := TKeyword.Create(AName, FRegistry.Count);
            FRegistry.Add(AName, Result);
        end;
    finally
        FLock.Exit;
    end;
end;

{ TKeywordMapping }

constructor TKeywordMapping<T>.Create(const AFields: TArray<TField>);
begin
    FFields := AFields;
    FFirst := 0;
    FLast := -1;
    if Length(FFields) = 0 then
        exit;

    FFirst := FFields[0].Key.Idx;
    FLast := FFirst;
    for var i := 1 to High(FFields) do
    begin
        var idx := FFields[i].Key.Idx;
        if FFirst > idx then
            FFirst := idx;
        if FLast < idx then
            FLast := idx;
    end;

    SetLength(FMap, FLast - FFirst + 1);
    for var i := 0 to High(FMap) do
        FMap[i] := -1;
    for var i := 0 to High(FFields) do
        FMap[FFirst + FFields[i].Key.Idx] := i;
end;

function TKeywordMapping<T>.IndexOf(const Key: IKeyword): Integer;
begin
    var idx := Key.Idx - FFirst;
    if (idx < 0) or (Idx > High(FMap)) then
        exit(-1);

    Result := FMap[idx];
end;

constructor TKeywordMapping<T>.TField.Create(const AKey: IKeyword; const AValue: T);
begin
    Key := AKey;
    Value := AValue;
end;

end.