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
        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;

    // Defines a mapping from Keywords to a generic value T
    IKeywordMapping<T> = interface
        {$region 'private'}
        function GetFields: TArray<TPair<IKeyword, T>>;
        {$endregion}
        // Finds the 0-based index for a given keyword. Returns -1 if not found.
        function IndexOf(const Key: IKeyword): Integer;
        // Gets all fields in the mapping.
        property Fields: TArray<TPair<IKeyword, T>> read GetFields;
    end;

    // Factory for creating IKeywordMapping instances
    TKeywordMappingRegistry<T> = record
    strict private
        // Implementation class for IKeywordMapping
        type
            TKeywordMapping = class(TInterfacedObject, IKeywordMapping<T>)
            private
                FMap: TArray<Integer>;
                FFields: TArray<TPair<IKeyword, T>>;
                FFirst, FLast: Integer;
                function GetFields: TArray<TPair<IKeyword, T>>;
            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;
        class var
            FRegistry: TDictionary<TArray<Integer>, 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;
    end;

implementation

uses
    System.Generics.Defaults; // For TComparer<Integer>

{ 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;

{ TKeywordMappingRegistry<T>.TKeywordMapping<T> }

constructor TKeywordMappingRegistry<T>.TKeywordMapping.Create(const AFields: TArray<TPair<IKeyword, T>>);
var
    i, idx: Integer;
begin
    inherited Create;
    FFields := AFields;
    FFirst := 0;
    FLast := -1;
    if Length(FFields) = 0 then
        exit;

    // Find min/max Idx for the map. Fields are *not* assumed to be sorted.
    FFirst := FFields[0].Key.Idx;
    FLast := FFirst;
    for i := 1 to High(FFields) do
    begin
        idx := FFields[i].Key.Idx;
        if FFirst > idx then
            FFirst := idx;
        if FLast < idx then
            FLast := idx;
    end;

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

    // Populate map based on the *original field order*
    for i := 0 to High(FFields) do
        FMap[FFields[i].Key.Idx - FFirst] := i;
end;

function TKeywordMappingRegistry<T>.TKeywordMapping.GetFields: TArray<TPair<IKeyword, T>>;
begin
    Result := FFields;
end;

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

    Result := FMap[idx];
end;

{ TKeywordMappingRegistry<T> }

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

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

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

    // 2. Lock
    FLock.Enter;
    try
        // 3. Check cache
        if FRegistry.TryGetValue(key, Result) then
            exit; // Found it, exit
    finally
        FLock.Exit;
    end;

    // 4. Not in cache. Create (O(N+M)) - OUTSIDE lock
    var newMapping := TKeywordMapping.Create(AFields) as IKeywordMapping<T>;

    // 5. Lock again to add
    FLock.Enter;
    try
        // 6. Check again (double-check)
        if FRegistry.TryGetValue(key, Result) then
            exit; // Another thread won the race

        // 7. Add our new mapping.
        Result := newMapping;
        FRegistry.Add(key, Result);
    finally
        FLock.Exit;
    end;
end;

end.