diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index d707702..222069d 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -164,12 +164,12 @@ begin TAst.Identifier('n'), TAst.BinaryExpr( TAst.FunctionCall( - TAst.Identifier('fib'), + TAst.Identifier('Self'), [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] ), boAdd, TAst.FunctionCall( - TAst.Identifier('fib'), + TAst.Identifier('Self'), [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(2)))] ) ) @@ -230,7 +230,7 @@ begin TAst.Identifier('n'), boMultiply, TAst.FunctionCall( - TAst.Identifier('factorial'), + TAst.Identifier('Self'), [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] ) ) diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index f29ddb6..a52f2ed 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -88,19 +88,25 @@ type // The signature for a native Delphi function callable from the script. TNativeFunction = function(const Args: TArray): TAstValue; - // Concrete implementation of the TAstValue.IClosure interface for script-defined functions. TClosureValue = class(TInterfacedObject, TAstValue.IClosure) private FBody: IExpressionNode; FClosureScope: IExecutionScope; FLambdaNode: ILambdaExpressionNode; + FUpvalues: TArray; function GetBody: IExpressionNode; function GetParameters: TArray; function GetClosureScope: IExecutionScope; + function GetUpvalues: TArray; public - constructor Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope); + constructor Create( + const ALambdaNode: ILambdaExpressionNode; + const AClosureScope: IExecutionScope; + const AUpvalues: TArray + ); property ClosureScope: IExecutionScope read GetClosureScope; property LambdaNode: ILambdaExpressionNode read FLambdaNode; + property Upvalues: TArray read FUpvalues; end; // Concrete implementation of TAstValue.IClosure for native Delphi functions. @@ -110,6 +116,7 @@ type function GetBody: IExpressionNode; function GetParameters: TArray; function GetClosureScope: IExecutionScope; + function GetUpvalues: TArray; public constructor Create(const AMethod: TNativeFunction); property Method: TNativeFunction read FMethod; @@ -205,12 +212,17 @@ end; { TClosureValue } -constructor TClosureValue.Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope); +constructor TClosureValue.Create( + const ALambdaNode: ILambdaExpressionNode; + const AClosureScope: IExecutionScope; + const AUpvalues: TArray +); begin inherited Create; FLambdaNode := ALambdaNode; FBody := ALambdaNode.Body; FClosureScope := AClosureScope; + FUpvalues := AUpvalues; // Store the captured cells end; function TClosureValue.GetBody: IExpressionNode; @@ -228,6 +240,11 @@ begin Result := FLambdaNode.Parameters; end; +function TClosureValue.GetUpvalues: TArray; +begin + Result := FUpvalues; +end; + { TNativeClosure } constructor TNativeClosure.Create(const AMethod: TNativeFunction); @@ -251,6 +268,10 @@ begin Result := nil; end; +function TNativeClosure.GetUpvalues: TArray; +begin +end; + { TEvaluatorVisitor } constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope); @@ -475,8 +496,27 @@ begin end; function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; +var + capturedCells: TArray; + i: Integer; + sourceAddr: TResolvedAddress; + sourceAddresses: TArray; begin - Result := TAstValue.FromClosure(TClosureValue.Create(Node, FScope)); + // The binder has identified the upvalues. Capture the cells from the current scope + // using the original source addresses provided by the binder. + sourceAddresses := Node.UpvalueSourceAddresses; + SetLength(capturedCells, Length(sourceAddresses)); + for i := 0 to High(sourceAddresses) do + begin + sourceAddr := sourceAddresses[i]; + // The binder gives the depth relative to the lambda's + // inner scope. The evaluator is in the outer scope, so we adjust the + // depth by -1 to find the cell in the current context. + dec(sourceAddr.ScopeDepth); + capturedCells[i] := FScope.GetCell(sourceAddr); + end; + + Result := TAstValue.FromClosure(TClosureValue.Create(Node, FScope, capturedCells)); end; function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; @@ -510,17 +550,21 @@ begin if not Assigned(descriptor) then raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?'); - var callScope := descriptor.CreateScope(closure.ClosureScope); + // Create the execution scope for the call, providing the captured upvalues. + var callScope := TExecutionScope.Create(closure.ClosureScope, descriptor, (closure as TClosureValue).Upvalues) as IExecutionScope; var adr: TResolvedAddress; + adr.Kind := akLocalOrParent; adr.ScopeDepth := 0; + + // Slot 0 is 'Self'. adr.SlotIndex := 0; - callScope[adr] := calleeValue; + callScope.Values[adr] := calleeValue; for i := 0 to Node.Arguments.Count - 1 do begin adr.SlotIndex := closure.Parameters[i].Address.SlotIndex; - callScope[adr] := Node.Arguments[i].Accept(Self); + callScope.Values[adr] := Node.Arguments[i].Accept(Self); end; Result := closure.Body.Accept(CreateVisitorForScope(callScope)); diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index fca1309..9ce284c 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -46,6 +46,7 @@ type ISeriesLengthNode = interface; IExecutionScope = interface; IScopeDescriptor = interface; + IValueCell = interface; // --- Concrete Type Definitions --- @@ -56,10 +57,12 @@ type function GetBody: IExpressionNode; function GetClosureScope: IExecutionScope; function GetParameters: TArray; + function GetUpvalues: TArray; {$endregion} property Body: IExpressionNode read GetBody; property ClosureScope: IExecutionScope read GetClosureScope; property Parameters: TArray read GetParameters; + property Upvalues: TArray read GetUpvalues; end; TVal = class(TInterfacedObject) @@ -96,7 +99,21 @@ type property Kind: TAstValueKind read GetKind; end; + // A managed, reference-counted cell that holds a TAstValue, + // allowing it to be shared by reference between scopes (for closures). + IValueCell = interface + {$region 'private'} + function GetValue: TAstValue; + procedure SetValue(const AValue: TAstValue); + {$endregion} + property Value: TAstValue read GetValue write SetValue; + end; + + // Defines how an identifier's address was resolved. + TAddressKind = (akUnresolved, akLocalOrParent, akUpvalue); + TResolvedAddress = record + Kind: TAddressKind; ScopeDepth: Integer; SlotIndex: Integer; end; @@ -106,12 +123,14 @@ type function GetParent: IExecutionScope; function GetValues(const Address: TResolvedAddress): TAstValue; procedure SetValues(const Address: TResolvedAddress; const Value: TAstValue); + function GetCell(const Address: TResolvedAddress): IValueCell; {$endregion} procedure Define(const Name: string; const Value: TAstValue); function Dump: string; procedure Clear; + property Cell[const Address: TResolvedAddress]: IValueCell read GetCell; property Values[const Address: TResolvedAddress]: TAstValue read GetValues write SetValues; default; property Parent: IExecutionScope read GetParent; @@ -222,10 +241,14 @@ type function GetParameters: TArray; function GetBody: IExpressionNode; function GetScopeDescriptor: IScopeDescriptor; + function GetUpvalues: TArray; + function GetUpvalueSourceAddresses: TArray; {$endregion} property Parameters: TArray read GetParameters; property Body: IExpressionNode read GetBody; property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor; + property Upvalues: TArray read GetUpvalues; + property UpvalueSourceAddresses: TArray read GetUpvalueSourceAddresses; end; IFunctionCallNode = interface(IExpressionNode) diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index f3aaf16..6326e83 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -12,21 +12,28 @@ type TExecutionScope = class(TInterfacedObject, IExecutionScope) private FParent: IExecutionScope; - FValues: TArray; + FValues: TArray; + // Stores references to the value cells captured by a closure. + FCapturedUpvalues: TArray; FNameToIndex: TDictionary; procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); function GetValues(const Address: TResolvedAddress): TAstValue; procedure SetValues(const Address: TResolvedAddress; const Value: TAstValue); function GetParent: IExecutionScope; + function GetCell(const Address: TResolvedAddress): IValueCell; public - constructor Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil); + constructor Create( + AParent: IExecutionScope = nil; + const ADescriptor: IScopeDescriptor = nil; + const ACapturedUpvalues: TArray = nil + ); destructor Destroy; override; procedure Clear; function Dump: string; procedure Define(const Name: string; const Value: TAstValue); property NameToIndex: TDictionary read FNameToIndex; property Parent: IExecutionScope read FParent; - property Values: TArray read FValues; + property Values: TArray read FValues; end; implementation @@ -34,19 +41,54 @@ implementation uses System.Generics.Defaults; +type + TValueCell = class(TInterfacedObject, IValueCell) + private + FValue: TAstValue; + function GetValue: TAstValue; + procedure SetValue(const AValue: TAstValue); + end; + +{ TValueCell } + +function TValueCell.GetValue: TAstValue; +begin + Result := FValue; +end; + +procedure TValueCell.SetValue(const AValue: TAstValue); +begin + FValue := AValue; +end; + { TExecutionScope } -constructor TExecutionScope.Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil); +{ TExecutionScope } + +constructor TExecutionScope.Create( + AParent: IExecutionScope; + const ADescriptor: IScopeDescriptor; + const ACapturedUpvalues: TArray +); +var + slotCount: Integer; + i: Integer; begin inherited Create; FParent := AParent; FValues := []; FNameToIndex := TDictionary.Create; + FCapturedUpvalues := ACapturedUpvalues; // Store upvalues + if ADescriptor <> nil then begin for var item in ADescriptor.Symbols do FNameToIndex.AddOrSetValue(item.Key, item.Value); - SetLength(FValues, ADescriptor.SlotCount); + + slotCount := ADescriptor.SlotCount; + SetLength(FValues, slotCount); + for i := 0 to slotCount - 1 do + FValues[i] := TValueCell.Create as IValueCell; end; end; @@ -56,6 +98,26 @@ begin inherited Destroy; end; +function TExecutionScope.GetCell(const Address: TResolvedAddress): IValueCell; +var + targetScope: TExecutionScope; + i: Integer; +begin + // Cells can only be retrieved from local/parent scopes. + if Address.Kind <> akLocalOrParent then + raise EInvalidOpException.Create('Cannot get a cell for a non-local address.'); + + targetScope := Self; + for i := 1 to Address.ScopeDepth do + begin + targetScope := targetScope.Parent as TExecutionScope; + Assert(Assigned(targetScope), 'Invalid scope depth during cell retrieval.'); + end; + + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid scope index during cell retrieval.'); + Result := targetScope.FValues[Address.SlotIndex]; +end; + function TExecutionScope.GetParent: IExecutionScope; begin Result := FParent; @@ -76,7 +138,8 @@ begin index := Length(FValues); SetLength(FValues, index + 1); - FValues[index] := Value; + FValues[index] := TValueCell.Create as IValueCell; + FValues[index].Value := Value; FNameToIndex.Add(Name, index); end; @@ -97,7 +160,8 @@ begin ); for pair in sortedPairs do - ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].ToString])); + // Access the value inside the cell for printing. + ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].Value.ToString])); end else begin @@ -130,16 +194,33 @@ var targetScope: TExecutionScope; i: Integer; begin - targetScope := Self; - - for i := 0 to Address.ScopeDepth - 1 do - begin - targetScope := targetScope.Parent as TExecutionScope; - Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.'); + 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 during value retrieval.' + ); + Result := FCapturedUpvalues[Address.SlotIndex].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 during value retrieval.'); + end; + Assert( + (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)), + 'Invalid scope index during value retrieval.' + ); + Result := targetScope.Values[Address.SlotIndex].Value; + end; + else + raise EInvalidOpException.Create('Cannot get value for an unresolved address.'); end; - - Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)), 'Invalid scope index during value retrieval.'); - Result := targetScope.Values[Address.SlotIndex]; end; procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TAstValue); @@ -147,18 +228,34 @@ var targetScope: IExecutionScope; i: Integer; begin - targetScope := Self; - for i := 1 to Address.ScopeDepth do - begin - if Assigned(targetScope) then - targetScope := targetScope.Parent - else - raise EInvalidOpException.Create('Invalid scope depth during assignment.'); - end; + 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 during value assignment.' + ); + FCapturedUpvalues[Address.SlotIndex].Value := Value; + end; + akLocalOrParent: + begin + targetScope := Self; + for i := 0 to Address.ScopeDepth - 1 do + begin + if Assigned(targetScope) then + targetScope := targetScope.Parent + else + raise EInvalidOpException.Create('Invalid scope depth during assignment.'); + end; - if Address.SlotIndex >= Length((targetScope as TExecutionScope).FValues) then - raise EInvalidOpException.Create('Invalid scope index during assignment.'); - (targetScope as TExecutionScope).FValues[Address.SlotIndex] := Value; + if Address.SlotIndex >= Length((targetScope as TExecutionScope).Values) then + raise EInvalidOpException.Create('Invalid scope index during assignment.'); + (targetScope as TExecutionScope).Values[Address.SlotIndex].Value := Value; + end; + else + raise EInvalidOpException.Create('Cannot set value for an unresolved address.'); + end; end; end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 129a3f1..df4d90c 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -6,6 +6,7 @@ uses System.Classes, System.SysUtils, System.Generics.Collections, + System.Generics.Defaults, Myc.Data.Scalar, Myc.Ast.Nodes, Myc.Ast.Scope; @@ -121,9 +122,7 @@ type public constructor Create(AName: string); function Accept(const Visitor: IAstVisitor): TAstValue; override; - property IsResolved: Boolean read GetIsResolved; - property Name: string read FName; property Address: TResolvedAddress read GetAddress; end; @@ -187,14 +186,20 @@ type private FParameters: TArray; FBody: IExpressionNode; - FScopeDescriptor: IScopeDescriptor; // Backing field for the new property + FScopeDescriptor: IScopeDescriptor; + FUpvalues: TArray; + FUpvalueSourceAddresses: TArray; function GetParameters: TArray; function GetBody: IExpressionNode; function GetScopeDescriptor: IScopeDescriptor; + function GetUpvalues: TArray; + function GetUpvalueSourceAddresses: TArray; public constructor Create(const AParameters: TArray; const ABody: IExpressionNode); function Accept(const Visitor: IAstVisitor): TAstValue; override; + procedure SetUpvalueData(const AUpvalues: TArray; const ASourceAddresses: TArray); property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor; + property Upvalues: TArray read GetUpvalues; end; { TFunctionCallNode } @@ -303,21 +308,46 @@ type function Accept(const Visitor: IAstVisitor): TAstValue; override; end; + TResolvedAddressComparer = class(TEqualityComparer) + public + function Equals(const Left, Right: TResolvedAddress): Boolean; override; + function GetHashCode(const Value: TResolvedAddress): Integer; override; + end; + // --- Binder Implementation --- TBinder = class(TAstTraverser) private FCurrentDescriptor: IScopeDescriptor; + FUpvalueMapStack: TStack>; + FUpvalueNodesStack: TStack>; procedure EnterScope; procedure ExitScope; public constructor Create(const AInitialScope: IExecutionScope); + destructor Destroy; override; function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override; property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor; end; +{ TResolvedAddressComparer } + +function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean; +begin + Result := (Left.Kind = Right.Kind) and (Left.ScopeDepth = Right.ScopeDepth) and (Left.SlotIndex = Right.SlotIndex); +end; + +function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer; +begin + // Simple combining hash function + Result := 17; + Result := Result * 23 + Ord(Value.Kind); + Result := Result * 23 + Value.ScopeDepth; + Result := Result * 23 + Value.SlotIndex; +end; + { TScopeDescriptor } constructor TScopeDescriptor.Create(AParent: IScopeDescriptor); @@ -406,6 +436,8 @@ constructor TIdentifierNode.Create(AName: string); begin inherited Create; FName := AName; + // Default to unresolved. + FResolvedAddress.Kind := akUnresolved; FResolvedAddress.ScopeDepth := -1; FResolvedAddress.SlotIndex := -1; end; @@ -417,7 +449,8 @@ end; function TIdentifierNode.GetIsResolved: Boolean; begin - Result := FResolvedAddress.ScopeDepth >= 0; + // An identifier is resolved if its kind is not unresolved anymore. + Result := FResolvedAddress.Kind <> akUnresolved; end; function TIdentifierNode.GetName: string; @@ -429,7 +462,6 @@ function TIdentifierNode.GetAddress: TResolvedAddress; begin if not IsResolved then raise EInvalidOpException.Create('Identifier not bound'); - Result := FResolvedAddress; end; @@ -555,6 +587,19 @@ begin FBody := ABody; FParameters := AParameters; FScopeDescriptor := nil; + FUpvalues := []; + FUpvalueSourceAddresses := []; // Initialize new field +end; + +function TLambdaExpressionNode.GetUpvalueSourceAddresses: TArray; +begin + Result := FUpvalueSourceAddresses; +end; + +procedure TLambdaExpressionNode.SetUpvalueData(const AUpvalues: TArray; const ASourceAddresses: TArray); +begin + FUpvalues := AUpvalues; + FUpvalueSourceAddresses := ASourceAddresses; end; function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; @@ -577,6 +622,11 @@ begin Result := FScopeDescriptor; end; +function TLambdaExpressionNode.GetUpvalues: TArray; +begin + Result := FUpvalues; +end; + { TFunctionCallNode } constructor TFunctionCallNode.Create(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode); @@ -807,6 +857,21 @@ constructor TBinder.Create(const AInitialScope: IExecutionScope); begin inherited Create; FCurrentDescriptor := TAst.CreateDescriptor(AInitialScope); + FUpvalueMapStack := TStack>.Create; + FUpvalueNodesStack := TStack>.Create; +end; + +destructor TBinder.Destroy; +begin + while FUpvalueMapStack.Count > 0 do + FUpvalueMapStack.Pop.Free; + FUpvalueMapStack.Free; + + while FUpvalueNodesStack.Count > 0 do + FUpvalueNodesStack.Pop.Free; + FUpvalueNodesStack.Free; + + inherited; end; procedure TBinder.EnterScope; @@ -821,17 +886,45 @@ end; function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue; var - index, depth: Integer; + originalDepth, originalIndex: Integer; identNode: TIdentifierNode; + upvalueMap: TDictionary; + upvalueNodes: TList; + originalAddress: TResolvedAddress; + upvalueIndex: Integer; begin identNode := Node as TIdentifierNode; if identNode.IsResolved then Exit; - if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, index, depth) then + if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, originalIndex, originalDepth) then begin - identNode.FResolvedAddress.ScopeDepth := depth; - identNode.FResolvedAddress.SlotIndex := index; + if (originalDepth > 0) and (FUpvalueMapStack.Count > 0) then + begin + upvalueMap := FUpvalueMapStack.Peek; + upvalueNodes := FUpvalueNodesStack.Peek; + + originalAddress.Kind := akLocalOrParent; + originalAddress.ScopeDepth := originalDepth; + originalAddress.SlotIndex := originalIndex; + + if not upvalueMap.TryGetValue(originalAddress, upvalueIndex) then + begin + upvalueIndex := upvalueNodes.Count; + upvalueMap.Add(originalAddress, upvalueIndex); + upvalueNodes.Add(identNode); + end; + + identNode.FResolvedAddress.Kind := akUpvalue; + identNode.FResolvedAddress.SlotIndex := upvalueIndex; + identNode.FResolvedAddress.ScopeDepth := 0; + end + else + begin + identNode.FResolvedAddress.Kind := akLocalOrParent; + identNode.FResolvedAddress.ScopeDepth := originalDepth; + identNode.FResolvedAddress.SlotIndex := originalIndex; + end; end else raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]); @@ -840,27 +933,65 @@ end; function TBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; var param: IIdentifierNode; + upvalueMap: TDictionary; + upvalueNodes: TList; + sourceAddresses: TArray; + sortedPairs: TArray>; begin - EnterScope; + FUpvalueMapStack.Push(TDictionary.Create(TResolvedAddressComparer.Default)); + FUpvalueNodesStack.Push(TList.Create); try - (FCurrentDescriptor as TScopeDescriptor).Define('Self'); + EnterScope; + try + (FCurrentDescriptor as TScopeDescriptor).Define('Self'); - for param in Node.Parameters do - (FCurrentDescriptor as TScopeDescriptor).Define(param.Name); + for param in Node.Parameters do + (FCurrentDescriptor as TScopeDescriptor).Define(param.Name); - inherited VisitLambdaExpression(Node); + inherited VisitLambdaExpression(Node); - // Annotate the lambda node with the completed scope descriptor. - (Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor; + (Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor; + finally + ExitScope; + end; finally - ExitScope; + upvalueMap := FUpvalueMapStack.Pop; + upvalueNodes := FUpvalueNodesStack.Pop; + + // The map's keys are the source addresses, and values are the indices. + // We need to sort by index to get the addresses in the correct order. + sortedPairs := upvalueMap.ToArray; + TArray.Sort>( + sortedPairs, + TComparer>.Construct( + function(const Left, Right: TPair): Integer begin Result := Left.Value - Right.Value; end + ) + ); + + SetLength(sourceAddresses, Length(sortedPairs)); + for var i := 0 to High(sortedPairs) do + sourceAddresses[i] := sortedPairs[i].Key; + + (Node as TLambdaExpressionNode).SetUpvalueData(upvalueNodes.ToArray, sourceAddresses); + + upvalueMap.Free; + upvalueNodes.Free; end; end; function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; +var + slotIndex: Integer; + identNode: TIdentifierNode; begin - (FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name); - inherited; + identNode := Node.Identifier as TIdentifierNode; + + Node.Initializer.Accept(Self); + + slotIndex := (FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name); + identNode.FResolvedAddress.Kind := akLocalOrParent; + identNode.FResolvedAddress.ScopeDepth := 0; + identNode.FResolvedAddress.SlotIndex := slotIndex; end; { TAst }