Static specialization WIP

Fix in ScopeDescriptor 2

ASTPlayground/MainForm.pas

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

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

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

@@ -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 *)
+        FDescriptor: IScopeDescriptor;
-        FValues: TArray<TScopeItem>; // (* Runtime values *)
+        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
+        property ValuesArray: TArray<TScopeItem> read FValues;
-    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;
     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(Assigned(FCapturedUpvalues));
-            Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
             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
+                    Result := item.Value.AsIntf<IValueCell>
-                    // The variable is already boxed, so just return its cell.
-                    Result := item.Value.AsIntf<IValueCell>;
-                end
                 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)
+    // Update the descriptor
-    // This stores the static type information for the Binder/TypeChecker.
-    // Note: This relies on FDescriptor being non-nil (ensured in constructor)
     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(Assigned(FCapturedUpvalues));
-            Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
             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;
-
+    Result := Default(TResolvedAddress);
-    // Not found in the entire chain
-    Result := Default(TResolvedAddress); // Kind = akUnresolved
 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(Assigned(FCapturedUpvalues));
-            Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
             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;