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

unit Myc.Data.Keyword;

interface

uses
    System.SysUtils,
    System.Generics.Collections,
    System.Generics.Defaults,
    System.SyncObjs,
    Myc.Data.Tuple;

type
    // The runtime representation of an interned keyword
    IKeyword = interface
        {$region 'private'}
        function GetIdx: Integer;
        function GetName: string;
        {$endregion}
        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;
            FRegistry: TDictionary<string, Integer>;
            FReverseMap: TList<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;
        // Gets the name for a given keyword index.
        class function GetName(AIdx: Integer): string; static;
        // Gets the keyword for a given keyword index.
        class function GetKeyword(AIdx: Integer): IKeyword; static;
    end;

    // Defines a mapping from Keywords to a generic value T
    IKeywordMapping<T> = interface(ITuple<T>)
        {$region 'private'}
        function GetFields(const Key: IKeyword): T;
        function GetKeywords(Idx: Integer): IKeyword;
        {$endregion}
        // Finds the 0-based index for a given keyword. Returns -1 if not found.
        function IndexOf(const Key: IKeyword): Integer;

        property Keywords[Idx: Integer]: IKeyword read GetKeywords;
        property Fields[const Key: IKeyword]: T read GetFields;
    end;

    // Factory for creating IKeywordMapping instances
    TKeywordMappingRegistry<T> = record
    strict private
        type
            TMapping = class(TInterfacedObject, IKeywordMapping<T>)
            private
                FMap: TArray<Integer>;
                FFields: TArray<TPair<IKeyword, T>>;
                FFirst, FLast: Integer;

                function GetItems(Idx: Integer): T;
                function GetFields(const Key: IKeyword): T;
                function GetKeywords(Idx: Integer): IKeyword;
                function GetCount: Integer;
            public
                // Expects AFields to be in the desired (canonical) order
                constructor Create(const AFields: TArray<TPair<IKeyword, T>>);
                function IndexOf(const Key: IKeyword): Integer;
            end;
    strict private
        // Cache implementation
        class var
            FLock: TSpinLock;
            FRegistry: TDictionary<TArray<Integer>, IKeywordMapping<T>>;
            FEmpty: IKeywordMapping<T>;
        class constructor Create;
        class destructor Destroy;

    public
        // Creates or gets the cached keyword mapping.
        class function Intern(const AFields: TArray<TPair<IKeyword, T>>): IKeywordMapping<T>; static;
        class property Empty: IKeywordMapping<T> read FEmpty;
    end;

    TGenericRecord<T> = class(TInterfacedObject, IKeywordMapping<T>)
    private
        FFields: TArray<TPair<IKeyword, T>>;

        function GetItems(Idx: Integer): T;
        function GetKeywords(Idx: Integer): IKeyword;
        function GetFields(const Key: IKeyword): T;
        function GetCount: Integer;
    public
        constructor Create(const AFields: TArray<TPair<IKeyword, T>>);
        function IndexOf(const Key: IKeyword): Integer;
    end;

implementation

uses
    Winapi.Windows;

{ 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
    FRegistry := TDictionary<string, Integer>.Create;
    FReverseMap := TList<IKeyword>.Create;
    FLock := TSpinLock.Create(False);
end;

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

class function TKeywordRegistry.GetKeyword(AIdx: Integer): IKeyword;
begin
    Result := FReverseMap[AIdx];
end;

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

class function TKeywordRegistry.GetName(AIdx: Integer): string;
begin
    if (AIdx >= 0) and (AIdx < FReverseMap.Count) then
        Result := FReverseMap[AIdx].Name
    else
        Result := '';
end;

{ TKeywordMappingRegistry<T>.TMapping }

constructor TKeywordMappingRegistry<T>.TMapping.Create(const AFields: TArray<TPair<IKeyword, T>>);
var
    i: Integer;
    keyIdx: Integer;
begin
    inherited Create;
    FFields := AFields;

    if Length(FFields) = 0 then
    begin
        FFirst := 0;
        FLast := -1;
        FMap := nil;
        Exit;
    end;

    FFirst := FFields[0].Key.Idx;
    FLast := FFirst;

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

    SetLength(FMap, FLast - FFirst + 1);
    for i := 0 to High(FMap) do
        FMap[i] := -1;

    for i := 0 to High(FFields) do
    begin
        keyIdx := FFields[i].Key.Idx;
        FMap[keyIdx - FFirst] := i;
    end;
end;

function TKeywordMappingRegistry<T>.TMapping.GetCount: Integer;
begin
    Result := Length(FFields);
end;

// Interface method for Items property
function TKeywordMappingRegistry<T>.TMapping.GetItems(Idx: Integer): T;
begin
    Result := FFields[Idx].Value;
end;

// Interface method for Fields property
function TKeywordMappingRegistry<T>.TMapping.GetFields(const Key: IKeyword): T;
var
    idx: Integer;
begin
    idx := IndexOf(Key);
    if idx < 0 then
        raise EArgumentException.CreateFmt('Keyword "%s" not found in mapping.', [Key.Name]);
    Result := FFields[idx].Value;
end;

function TKeywordMappingRegistry<T>.TMapping.GetKeywords(Idx: Integer): IKeyword;
begin
    Result := FFields[Idx].Key;
end;

function TKeywordMappingRegistry<T>.TMapping.IndexOf(const Key: IKeyword): Integer;
var
    keyIdx, mapIdx: Integer;
begin
    keyIdx := Key.Idx;
    if (keyIdx < FFirst) or (keyIdx > FLast) then
        Exit(-1);

    mapIdx := keyIdx - FFirst;
    if (mapIdx < Length(FMap)) then
        Result := FMap[mapIdx]
    else
        Result := -1;
end;

{ TKeywordMappingRegistry<T> }

class constructor TKeywordMappingRegistry<T>.Create;
begin
    FRegistry := TDictionary<TArray<Integer>, IKeywordMapping<T>>.Create(TEqualityComparer<TArray<Integer>>.Default);
    FLock := TSpinLock.Create(False);

    FEmpty := Intern([]);
end;

class destructor TKeywordMappingRegistry<T>.Destroy;
begin
    FRegistry.Free;
end;

class function TKeywordMappingRegistry<T>.Intern(const AFields: TArray<TPair<IKeyword, T>>): IKeywordMapping<T>;
var
    signature: TArray<Integer>;
    i: Integer;
begin
    SetLength(signature, Length(AFields));
    for i := 0 to High(AFields) do
        signature[i] := AFields[i].Key.Idx;

    FLock.Enter;
    try
        if not FRegistry.TryGetValue(signature, Result) then
        begin
            Result := TMapping.Create(AFields);
            FRegistry.Add(signature, Result);
        end;
    finally
        FLock.Exit;
    end;
end;

{ TGenericRecord }

constructor TGenericRecord<T>.Create(const AFields: TArray<TPair<IKeyword, T>>);
begin
    inherited Create;
    FFields := AFields;
end;

function TGenericRecord<T>.GetCount: Integer;
begin
    Result := Length(FFields);
end;

function TGenericRecord<T>.GetFields(const Key: IKeyword): T;
var
    idx: Integer;
begin
    idx := IndexOf(Key);
    if idx < 0 then
        raise EArgumentException.CreateFmt('Field "%s" not found in dynamic record.', [Key.Name]);
    Result := FFields[idx].Value;
end;

function TGenericRecord<T>.GetItems(Idx: Integer): T;
begin
    Result := FFields[Idx].Value;
end;

function TGenericRecord<T>.GetKeywords(Idx: Integer): IKeyword;
begin
    Result := FFields[Idx].Key;
end;

function TGenericRecord<T>.IndexOf(const Key: IKeyword): Integer;
var
    i: Integer;
begin
    // Linear search (O(n)). Fast enough for typical records.
    // Keyword comparison is integer-based (Idx), so this is efficient.
    for i := 0 to High(FFields) do
    begin
        if FFields[i].Key.Idx = Key.Idx then
        begin
            Result := i;
            exit;
        end;
    end;
    Result := -1;
end;

end.