Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Static specialization WIP

Browse Source 
Fix in ScopeDescriptor 2
This commit is contained in:
Michael Schimmel
2025-11-19 16:01:14 +01:00
parent 3ae1ed8f48
commit d0d1053faf
4 changed files with 79 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+1 -1
View File
@@ -419,7 +419,7 @@ begin
try
Memo1.Lines.Add(Format('--- Loading User Library from %s ---', [ExtractFileName(UserLibName)]));
var scopeDescr := FEnvironment.RootScope.CreateDescriptor;
var scopeDescr := FEnvironment.RootScope.Descriptor;
// Populate the list view with loaded functions and macros.
RTLListView.Items.BeginUpdate;
try
Src/AST/Myc.Ast.Compiler.Macros.pas
+2 -2
View File
@@ -319,7 +319,7 @@ begin
// Check if we are unquoting a macro parameter (simple identifier)
if expr.Kind = akIdentifier then
begin
symbol := FMacroScope.CreateDescriptor.FindSymbol(expr.AsIdentifier.Name);
symbol := FMacroScope.Descriptor.FindSymbol(expr.AsIdentifier.Name);
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth = 0) then
begin
// It's a parameter. Return the TDataValue containing the AST node passed as argument.
@@ -519,7 +519,7 @@ begin
begin
// This is the compile-time evaluation (Binder + Evaluator)
// [*] It must bind against the *expansion* scope, not the initial scope
boundSubAst := TAstBinder.Bind(expansionScope.CreateDescriptor, ANodeToEvaluate, subDescriptor);
boundSubAst := TAstBinder.Bind(expansionScope.Descriptor, ANodeToEvaluate, subDescriptor);
// Create eval scope from the new descriptor, parented to the expansion scope
evalScope := subDescriptor.CreateScope(expansionScope);
Src/AST/Myc.Ast.Environment.pas
+1 -1
View File
@@ -501,7 +501,7 @@ end;
function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray<IStaticType>): IAstNode;
begin
var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, Node, Descriptor, FFunctionRegistry, ArgTypes);
var boundAst := TAstBinder.Bind(FRootScope.Descriptor, Node, Descriptor, FFunctionRegistry, ArgTypes);
var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);
Result := typedAst;
Src/AST/Myc.Ast.Scope.pas
+75 -169
View File
@@ -49,35 +49,7 @@ type
property Value: TDataValue read GetValue write SetValue;
end;
IExecutionScope = interface
{$region 'private'}
function GetParent: IExecutionScope;
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
{$endregion}
// Defines a symbol and returns its runtime address
function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
// Defines a variable at a given address and stores it directly in a shared cell (boxing).
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
function Dump: string;
procedure Clear;
function Capture(const Address: TResolvedAddress): IValueCell;
function GetNameID(const Name: String): Integer;
// Resolves a name to an address by searching the runtime scope chain.
function Resolve(const Name: string): TResolvedAddress;
function CreateDescriptor: IScopeDescriptor;
property Values[const Address: TResolvedAddress]: TDataValue read GetValues write SetValues; default;
property Parent: IExecutionScope read GetParent;
end;
// Describes the layout of a scope: variable names, their slot indices and macros.
// This is generated by the binder and used to create TExecutionScope instances at runtime.
IScopeDescriptor = interface
{$region 'private'}
function GetParent: IScopeDescriptor;
@@ -86,12 +58,9 @@ type
function GetType(SlotIndex: Integer): IStaticType;
{$endregion}
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
// Defines a symbol, returns its slot index.
function Define(const Name: string; const AType: IStaticType = nil): Integer;
// Updates the type of an already defined symbol (e.g., for lambda self-reference).
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType);
// Finds a symbol, returns its address and type.
function Define(const Name: string; const AType: IStaticType = nil): Integer;
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType);
function FindSymbol(const Name: string): TResolvedSymbol;
property Parent: IScopeDescriptor read GetParent;
@@ -99,6 +68,31 @@ type
property Symbols: TDictionary<string, Integer> read GetSymbols;
end;
IExecutionScope = interface
{$region 'private'}
function GetParent: IExecutionScope;
function GetDescriptor: IScopeDescriptor; // (* ADDED *)
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
{$endregion}
function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
function Dump: string;
procedure Clear;
function Capture(const Address: TResolvedAddress): IValueCell;
function GetNameID(const Name: String): Integer;
function Resolve(const Name: string): TResolvedAddress;
// (* REMOVED: function CreateDescriptor: IScopeDescriptor; *)
property Values[const Address: TResolvedAddress]: TDataValue read GetValues write SetValues; default;
property Parent: IExecutionScope read GetParent;
property Descriptor: IScopeDescriptor read GetDescriptor; // (* ADDED *)
end;
TScope = record
class function CreateScope(
const Parent: IExecutionScope;
@@ -115,6 +109,26 @@ uses
System.SyncObjs;
type
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
FSlotTypes: TArray<IStaticType>;
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
function GetType(SlotIndex: Integer): IStaticType;
public
constructor Create(const AParent: IScopeDescriptor);
destructor Destroy; override;
// (* REMOVED: class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; *)
function Define(const Name: string; const AType: IStaticType): Integer;
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType = nil);
function FindSymbol(const Name: string): TResolvedSymbol;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
TExecutionScope = class(TInterfacedObject, IExecutionScope)
private
type
@@ -135,8 +149,8 @@ type
private
FParent: IExecutionScope;
FDescriptor: IScopeDescriptor; // (* Will store static types *)
FValues: TArray<TScopeItem>; // (* Runtime values *)
FDescriptor: IScopeDescriptor;
FValues: TArray<TScopeItem>;
FCapturedUpvalues: TArray<IValueCell>;
FNames: TDictionary<string, Integer>;
FNameStrings: TList<string>;
@@ -145,6 +159,7 @@ type
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
procedure NeedNameToIndex;
function GetParent: IExecutionScope;
function GetDescriptor: IScopeDescriptor; // (* ADDED *)
function GetNameToIndex: TDictionary<Integer, Integer>;
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
@@ -158,40 +173,19 @@ type
function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
function Capture(const Address: TResolvedAddress): IValueCell;
function CreateDescriptor: IScopeDescriptor;
// (* REMOVED: function CreateDescriptor: IScopeDescriptor; *)
property Names: TDictionary<string, Integer> read FNames;
property NameStrings: TList<string> read FNameStrings;
property NameToIndex: TDictionary<Integer, Integer> read GetNameToIndex;
property Parent: IExecutionScope read FParent;
property ValuesArray: TArray<TScopeItem> read FValues; // Expose FValues for PopulateFromScope
end;
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
FSlotTypes: TArray<IStaticType>; // Stores types by SlotIndex
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
function GetType(SlotIndex: Integer): IStaticType;
public
constructor Create(const AParent: IScopeDescriptor);
destructor Destroy; override;
class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static;
function Define(const Name: string; const AType: IStaticType): Integer;
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType = nil);
function FindSymbol(const Name: string): TResolvedSymbol;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(Scope: TExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
property ValuesArray: TArray<TScopeItem> read FValues;
end;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
Result := (Left = Right); // Use the record's operator
Result := (Left = Right);
end;
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
@@ -199,7 +193,6 @@ var
adr: TResolvedAddress;
begin
adr := Value;
// Use THashBobJenkins as requested
Result := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
Result := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), Result);
Result := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), Result);
@@ -236,7 +229,6 @@ end;
class operator TResolvedSymbol.Initialize(out Dest: TResolvedSymbol);
begin
// TResolvedAddress has its own Initialize operator
Dest.StaticType := TTypes.Unknown;
end;
@@ -269,13 +261,18 @@ begin
inherited Create;
FParent := AParent;
// Ensure FDescriptor is always assigned
// (* MODIFIED: Clean logic for Descriptor initialization *)
if Assigned(ADescriptor) then
FDescriptor := ADescriptor
else if Assigned(AParent) then
FDescriptor := TScopeDescriptor.Create(AParent.CreateDescriptor)
begin
// Create a NEW empty descriptor that is a CHILD of the parent's descriptor.
// Use the Descriptor property of the parent scope.
FDescriptor := TScopeDescriptor.Create(AParent.Descriptor);
end
else
FDescriptor := TScope.CreateDescriptor(nil); // Create new root descriptor
// Create a new root descriptor (parent = nil)
FDescriptor := TScopeDescriptor.Create(nil);
FValues := [];
FCapturedUpvalues := ACapturedUpvalues;
@@ -291,7 +288,6 @@ begin
FNameStrings := TList<string>.Create;
end;
// Pre-allocate the runtime value array based on the compile-time descriptor's size.
if Assigned(ADescriptor) then
SetLength(FValues, ADescriptor.SlotCount);
end;
@@ -312,6 +308,11 @@ begin
Result := FParent;
end;
function TExecutionScope.GetDescriptor: IScopeDescriptor;
begin
Result := FDescriptor;
end;
procedure TExecutionScope.Clear;
begin
FValues := [];
@@ -326,32 +327,22 @@ begin
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
Assert(Assigned(FCapturedUpvalues));
Result := FCapturedUpvalues[Address.SlotIndex];
end;
akLocalOrParent:
begin
targetScope := Self;
for i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during capture.');
end;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index during capture.');
// The check-and-update for JIT-boxing must be atomic.
TMonitor.Enter(targetScope);
try
var item := targetScope.FValues[Address.SlotIndex];
if item.IsBoxed then
begin
// The variable is already boxed, so just return its cell.
Result := item.Value.AsIntf<IValueCell>;
end
Result := item.Value.AsIntf<IValueCell>
else
begin
// This is an unboxed variable. Box it "just-in-time" and update the scope.
Result := TValueCell.Create(item.Value);
targetScope.FValues[Address.SlotIndex].Value := TDataValue.FromIntf<IValueCell>(Result);
targetScope.FValues[Address.SlotIndex].IsBoxed := True;
@@ -365,14 +356,6 @@ begin
end;
end;
function TExecutionScope.CreateDescriptor: IScopeDescriptor;
begin
// We create a *copy* to prevent modification of the live descriptor
// TScopeDescriptor.CreateDescriptor(Self) will do this.
Result := TScopeDescriptor.CreateDescriptor(Self);
end;
// (* MODIFIED: Signature changed, logic added *)
function TExecutionScope.Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
var
id: Integer;
@@ -384,29 +367,21 @@ begin
if FNameToIndex.ContainsKey(id) then
raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
// 1. Determine the static type
if Assigned(AStaticType) then
staticType := AStaticType
else
staticType := TTypes.Unknown; // Default if not provided
staticType := TTypes.Unknown;
// 2. Define in the runtime storage (FValues)
index := Length(FValues);
SetLength(FValues, index + 1);
FValues[index].Value := Value;
FValues[index].IsBoxed := False;
FNameToIndex.Add(id, index);
// 3. Define in the compile-time descriptor (FDescriptor)
// This stores the static type information for the Binder/TypeChecker.
// Note: This relies on FDescriptor being non-nil (ensured in constructor)
// Update the descriptor
var descSlot := FDescriptor.Define(Name, staticType);
// 4. Ensure runtime slot matches descriptor slot
// This is critical for root scope initialization.
Assert(descSlot = index, 'Scope descriptor slot mismatch during Define');
// Return the address
Result.Kind := akLocalOrParent;
Result.ScopeDepth := 0;
Result.SlotIndex := index;
@@ -414,8 +389,6 @@ end;
procedure TExecutionScope.DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
begin
Assert((SlotIndex >= 0) and (SlotIndex < Length(FValues)), 'Invalid slot index during DefineBoxed.');
FValues[SlotIndex].Value := TDataValue.FromIntf<IValueCell>(TValueCell.Create(Value));
FValues[SlotIndex].IsBoxed := True;
end;
@@ -492,19 +465,14 @@ begin
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
Assert(Assigned(FCapturedUpvalues));
Result := FCapturedUpvalues[Address.SlotIndex].Value;
end;
akLocalOrParent:
begin
var targetScope := Self;
for var i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth for GetValues.');
end;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index for GetValues.');
item := targetScope.FValues[Address.SlotIndex];
if item.IsBoxed then
@@ -548,31 +516,22 @@ var
begin
currentScope := Self;
depth := 0;
// GetNameID is shared (or recreated) across the scope chain
nameID := GetNameID(Name);
while Assigned(currentScope) do
begin
// We must cast to the implementation class to access 'NameToIndex'
var execScopeImpl := (currentScope as TExecutionScope);
// Accessing .NameToIndex property ensures NeedNameToIndex is called
if execScopeImpl.NameToIndex.TryGetValue(nameID, slotIndex) then
begin
// Found in this scope
Result.Kind := akLocalOrParent;
Result.ScopeDepth := depth;
Result.SlotIndex := slotIndex;
exit;
end;
// Not found, go to parent
inc(depth);
currentScope := currentScope.Parent;
end;
// Not found in the entire chain
Result := Default(TResolvedAddress); // Kind = akUnresolved
Result := Default(TResolvedAddress);
end;
procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TDataValue);
@@ -583,21 +542,15 @@ begin
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
Assert(Assigned(FCapturedUpvalues));
FCapturedUpvalues[Address.SlotIndex].Value := Value;
end;
akLocalOrParent:
begin
targetScope := Self;
for i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth for SetValues.');
end;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index for SetValues.');
// Use a reference/pointer to modify the array element in place
var pItem: ^TScopeItem := @targetScope.FValues[Address.SlotIndex];
if pItem.IsBoxed then
(pItem.Value.AsIntf<IValueCell>).Value := Value
@@ -633,28 +586,6 @@ begin
inherited;
end;
class function TScopeDescriptor.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor;
begin
// Create a *copy* of the descriptor chain
if (Scope is TExecutionScope) and (Assigned(Scope.Parent)) then
begin
// Recursively create parent descriptors
var res := TScopeDescriptor.Create(CreateDescriptor(Scope.Parent));
// Populate this descriptor level
res.PopulateFromScope(Scope as TExecutionScope);
Result := res;
end
else if (Scope is TExecutionScope) then
begin
// This is the root scope
var res := TScopeDescriptor.Create(nil);
res.PopulateFromScope(Scope as TExecutionScope);
Result := res;
end
else
Result := TScopeDescriptor.Create(nil); // Default empty descriptor
end;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.Create(Parent, Self, nil);
@@ -684,7 +615,6 @@ var
currentDescriptor: IScopeDescriptor;
slotIndex: Integer;
begin
// (* MODIFIED: Initialize StaticType *)
Result.StaticType := TTypes.Unknown;
Result.Address.Kind := akUnresolved;
Result.Address.ScopeDepth := 0;
@@ -696,13 +626,12 @@ begin
begin
Result.Address.Kind := akLocalOrParent;
Result.Address.SlotIndex := slotIndex;
Result.StaticType := currentDescriptor.GetType(slotIndex); // (* Read type *)
Result.StaticType := currentDescriptor.GetType(slotIndex);
exit;
end;
inc(Result.Address.ScopeDepth);
currentDescriptor := currentDescriptor.Parent;
end;
// (* If not found, Result.StaticType remains TTypes.Unknown *)
end;
function TScopeDescriptor.GetParent: IScopeDescriptor;
@@ -727,34 +656,11 @@ begin
Result := FSlotTypes[SlotIndex];
end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
var
i: Integer;
begin
// (* MODIFIED: We are populating 'Self' from 'Scope's *internal* descriptor *)
// We must cast to access the descriptor implementation
if not (Scope.FDescriptor is TScopeDescriptor) then
exit; // Cannot populate from an unknown descriptor type
var scopeDesc := (Scope.FDescriptor as TScopeDescriptor);
// Recreate descriptor by copying all defined symbols and types.
SetLength(Self.FSlotTypes, Length(scopeDesc.FSlotTypes));
for i := 0 to High(Self.FSlotTypes) do
Self.FSlotTypes[i] := scopeDesc.FSlotTypes[i]; // Copy static type
for var pair in scopeDesc.FSymbols do
begin
// Add to variable symbol table.
if not Self.FSymbols.ContainsKey(pair.Key) then
Self.FSymbols.Add(pair.Key, pair.Value);
end;
end;
{ TScope }
class function TScope.CreateDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor;
begin
// Factory for a new, empty descriptor
Result := TScopeDescriptor.Create(Parent);
end;