Keyword mapping refactoring

This commit is contained in:
Michael Schimmel
2025-12-09 12:59:36 +01:00
parent 43afbd6050
commit f8dc5b945c
13 changed files with 257 additions and 188 deletions
+100 -77
View File
@@ -4,15 +4,17 @@ interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
System.Generics.Defaults,
System.SyncObjs;
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;
@@ -33,10 +35,8 @@ type
strict private
class var
FLock: TSpinLock;
class var
FRegistry: TDictionary<string, Integer>;
class var
FReverseMap: TList<IKeyword>; // Use TList
FReverseMap: TList<IKeyword>;
class constructor Create;
class destructor Destroy;
public
@@ -49,12 +49,18 @@ type
// Defines a mapping from Keywords to a generic value T
IKeywordMapping<T> = interface
{$region 'private'}
function GetFields: TArray<TPair<IKeyword, T>>;
function GetItems(Idx: Integer): TPair<IKeyword, T>;
function GetFields(const Key: IKeyword): T;
function GetCount: Integer;
{$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;
// Access value by Keyword (raises exception if not found)
property Fields[const Key: IKeyword]: T read GetFields;
// Access Key-Value pair by Index (0..Count-1)
property Items[Idx: Integer]: TPair<IKeyword, T> read GetItems; default;
property Count: Integer read GetCount;
end;
// Factory for creating IKeywordMapping instances
@@ -67,7 +73,11 @@ type
FMap: TArray<Integer>;
FFields: TArray<TPair<IKeyword, T>>;
FFirst, FLast: Integer;
function GetFields: TArray<TPair<IKeyword, T>>;
function GetItem(Idx: Integer): TPair<IKeyword, T>;
function GetItems(Idx: Integer): TPair<IKeyword, T>;
function GetFields(const Key: IKeyword): T;
function GetCount: Integer;
public
// Expects AFields to be in the desired (canonical) order
constructor Create(const AFields: TArray<TPair<IKeyword, T>>);
@@ -77,7 +87,6 @@ type
// Cache implementation
class var
FLock: TSpinLock;
class var
FRegistry: TDictionary<TArray<Integer>, IKeywordMapping<T>>;
class constructor Create;
class destructor Destroy;
@@ -89,10 +98,6 @@ type
implementation
uses
WinApi.Windows,
System.Generics.Defaults; // For TComparer<Integer>
{ TKeywordRegistry.TKeyword }
constructor TKeywordRegistry.TKeyword.Create(const AName: string; AIdx: Integer);
@@ -116,9 +121,9 @@ end;
class constructor TKeywordRegistry.Create;
begin
FLock := TSpinLock.Create(false);
FRegistry := TDictionary<string, Integer>.Create;
FReverseMap := TList<IKeyword>.Create;
FLock := TSpinLock.Create(False);
end;
class destructor TKeywordRegistry.Destroy;
@@ -127,18 +132,6 @@ begin
FReverseMap.Free;
end;
class function TKeywordRegistry.GetName(AIdx: Integer): string;
begin
FLock.Enter;
try
// Check bounds
if (AIdx >= 0) and (AIdx < FReverseMap.Count) then
Result := FReverseMap[AIdx].Name;
finally
FLock.Exit;
end;
end;
class function TKeywordRegistry.Intern(const AName: string): IKeyword;
var
idx: Integer;
@@ -147,72 +140,118 @@ begin
try
if not FRegistry.TryGetValue(AName, idx) then
begin
Result := TKeyword.Create(AName, FRegistry.Count);
FRegistry.Add(AName, FReverseMap.Add(Result));
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;
{ TKeywordMappingRegistry<T>.TKeywordMapping<T> }
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>.TKeywordMapping }
constructor TKeywordMappingRegistry<T>.TKeywordMapping.Create(const AFields: TArray<TPair<IKeyword, T>>);
var
i, idx: Integer;
i: Integer;
keyIdx: 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.
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
idx := FFields[i].Key.Idx;
if FFirst > idx then
FFirst := idx;
if FLast < idx then
FLast := idx;
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;
// Populate map based on the *original field order*
for i := 0 to High(FFields) do
FMap[FFields[i].Key.Idx - FFirst] := i;
begin
keyIdx := FFields[i].Key.Idx;
FMap[keyIdx - FFirst] := i;
end;
end;
function TKeywordMappingRegistry<T>.TKeywordMapping.GetFields: TArray<TPair<IKeyword, T>>;
function TKeywordMappingRegistry<T>.TKeywordMapping.GetCount: Integer;
begin
Result := FFields;
Result := Length(FFields);
end;
// Internal helper required for interface implementation match if defined in stricter mode
function TKeywordMappingRegistry<T>.TKeywordMapping.GetItem(Idx: Integer): TPair<IKeyword, T>;
begin
Result := FFields[Idx];
end;
// Interface method for Items property
function TKeywordMappingRegistry<T>.TKeywordMapping.GetItems(Idx: Integer): TPair<IKeyword, T>;
begin
Result := FFields[Idx];
end;
// Interface method for Fields property
function TKeywordMappingRegistry<T>.TKeywordMapping.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>.TKeywordMapping.IndexOf(const Key: IKeyword): Integer;
var
idx: Integer;
keyIdx, mapIdx: Integer;
begin
idx := Key.Idx - FFirst;
if (idx < 0) or (Idx > High(FMap)) then
exit(-1);
keyIdx := Key.Idx;
if (keyIdx < FFirst) or (keyIdx > FLast) then
Exit(-1);
Result := FMap[idx];
mapIdx := keyIdx - FFirst;
if (mapIdx < Length(FMap)) then
Result := FMap[mapIdx]
else
Result := -1;
end;
{ TKeywordMappingRegistry<T> }
class constructor TKeywordMappingRegistry<T>.Create;
begin
FLock := TSpinLock.Create(false);
FRegistry := TDictionary<TArray<Integer>, IKeywordMapping<T>>.Create;
FRegistry := TDictionary<TArray<Integer>, IKeywordMapping<T>>.Create(TEqualityComparer<TArray<Integer>>.Default);
FLock := TSpinLock.Create(False);
end;
class destructor TKeywordMappingRegistry<T>.Destroy;
@@ -222,36 +261,20 @@ end;
class function TKeywordMappingRegistry<T>.Intern(const AFields: TArray<TPair<IKeyword, T>>): IKeywordMapping<T>;
var
key: TArray<Integer>;
newMapping: IKeywordMapping<T>;
signature: TArray<Integer>;
i: Integer;
begin
SetLength(key, Length(AFields));
for var i := 0 to High(key) do
key[i] := AFields[i].Key.Idx;
SetLength(signature, Length(AFields));
for i := 0 to High(AFields) do
signature[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
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);
if not FRegistry.TryGetValue(signature, Result) then
begin
Result := TKeywordMapping.Create(AFields);
FRegistry.Add(signature, Result);
end;
finally
FLock.Exit;
end;