diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 0c3726f..bc12b1e 100644 --- a/ASTPlayground/MainForm.pas +++ b/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 diff --git a/Src/AST/Myc.Ast.Compiler.Macros.pas b/Src/AST/Myc.Ast.Compiler.Macros.pas index 85b4c44..62ce301 100644 --- a/Src/AST/Myc.Ast.Compiler.Macros.pas +++ b/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); diff --git a/Src/AST/Myc.Ast.Environment.pas b/Src/AST/Myc.Ast.Environment.pas index 87ecab0..6968eb4 100644 --- a/Src/AST/Myc.Ast.Environment.pas +++ b/Src/AST/Myc.Ast.Environment.pas @@ -501,7 +501,7 @@ end; function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray): 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; diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index c81baf0..bd2a2f4 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/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 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; + FSlotTypes: TArray; + function GetParent: IScopeDescriptor; + function GetSlotCount: Integer; + function GetSymbols: TDictionary; + 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 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; // (* Runtime values *) + FDescriptor: IScopeDescriptor; + FValues: TArray; FCapturedUpvalues: TArray; FNames: TDictionary; FNameStrings: TList; @@ -145,6 +159,7 @@ type procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); procedure NeedNameToIndex; function GetParent: IExecutionScope; + function GetDescriptor: IScopeDescriptor; // (* ADDED *) function GetNameToIndex: TDictionary; 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 read FNames; property NameStrings: TList read FNameStrings; property NameToIndex: TDictionary read GetNameToIndex; property Parent: IExecutionScope read FParent; - property ValuesArray: TArray read FValues; // Expose FValues for PopulateFromScope - end; - - TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor) - private - FParent: IScopeDescriptor; - FSymbols: TDictionary; - FSlotTypes: TArray; // Stores types by SlotIndex - function GetParent: IScopeDescriptor; - function GetSlotCount: Integer; - function GetSymbols: TDictionary; - 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 read FSymbols; + property ValuesArray: TArray 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.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; - end + Result := item.Value.AsIntf 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(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(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).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;