Michael Schimmel
758 lines
27 KiB
ObjectPascal
758 lines
27 KiB
ObjectPascal
unit Myc.Ast.Binding;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.Generics.Collections,
|
|
Myc.Data.Value,
|
|
Myc.Ast.Nodes,
|
|
Myc.Ast.Visitor,
|
|
Myc.Ast.Scope,
|
|
Myc.Ast.Analyzer,
|
|
Myc.Ast;
|
|
|
|
type
|
|
IAstBinder = interface(IAstVisitor)
|
|
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
|
end;
|
|
|
|
TAstBinder = class; // Forward declaration
|
|
|
|
// This visitor handles the expansion of a single macro body (` `...`).
|
|
// It correctly distinguishes between syntactic unquoting and value unquoting.
|
|
TExpansionVisitor = class(TAstTransformer)
|
|
private
|
|
FBinder: TAstBinder;
|
|
FMacroScope: IExecutionScope;
|
|
protected
|
|
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
|
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
|
public
|
|
constructor Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope);
|
|
end;
|
|
|
|
TAstBinder = class(TAstTransformer, IAstBinder)
|
|
private
|
|
type
|
|
TUpvalueMapping = class
|
|
public
|
|
Map: TDictionary<TResolvedAddress, Integer>;
|
|
Nodes: TList<IIdentifierNode>;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
private
|
|
FInitialScope: IExecutionScope;
|
|
FCurrentDescriptor: IScopeDescriptor;
|
|
FUpvalueStack: TStack<TUpvalueMapping>;
|
|
FNestedLambdaCount: Integer;
|
|
FIsTailStack: TStack<Boolean>;
|
|
FNextIsTail: Boolean;
|
|
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
|
|
FEvaluatorFactory: TEvaluatorFactory;
|
|
FMacros: TDictionary<string, IMacroDefinitionNode>;
|
|
|
|
procedure EnterScope;
|
|
procedure ExitScope;
|
|
function IsValidIdentifier(const Name: string): Boolean;
|
|
function EvaluateAtCompileTime(const ANode: IAstNode): TDataValue;
|
|
|
|
protected
|
|
function Accept(const Node: IAstNode): TDataValue; override;
|
|
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
|
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
|
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
|
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
|
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
|
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
|
|
|
public
|
|
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
|
|
destructor Destroy; override;
|
|
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
|
end;
|
|
|
|
TBoundIdentifierNode = class(TIdentifierNode)
|
|
private
|
|
FAddress: TResolvedAddress;
|
|
public
|
|
constructor Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
|
|
property Address: TResolvedAddress read FAddress;
|
|
end;
|
|
|
|
TBoundVariableDeclarationNode = class(TVariableDeclarationNode)
|
|
private
|
|
FIsBoxed: Boolean;
|
|
public
|
|
constructor Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode; AIsBoxed: Boolean);
|
|
property IsBoxed: Boolean read FIsBoxed;
|
|
end;
|
|
|
|
TBoundLambdaExpressionNode = class(TLambdaExpressionNode)
|
|
private
|
|
FScopeDescriptor: IScopeDescriptor;
|
|
FUpvalues: TArray<TResolvedAddress>;
|
|
FHasNestedLambdas: Boolean;
|
|
public
|
|
constructor Create(
|
|
const AUnboundNode: ILambdaExpressionNode;
|
|
const ABody: IAstNode;
|
|
const AParameters: TArray<IIdentifierNode>;
|
|
const AScopeDescriptor: IScopeDescriptor;
|
|
const AUpvalues: TArray<TResolvedAddress>;
|
|
AHasNestedLambdas: Boolean
|
|
);
|
|
property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor;
|
|
property Upvalues: TArray<TResolvedAddress> read FUpvalues;
|
|
property HasNestedLambdas: Boolean read FHasNestedLambdas;
|
|
end;
|
|
|
|
TBoundFunctionCallNode = class(TFunctionCallNode)
|
|
private
|
|
FIsTailCall: Boolean;
|
|
public
|
|
constructor Create(
|
|
const AUnboundNode: IFunctionCallNode;
|
|
const ACallee: IAstNode;
|
|
const AArguments: TArray<IAstNode>;
|
|
AIsTailCall: Boolean
|
|
);
|
|
property IsTailCall: Boolean read FIsTailCall;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Generics.Defaults,
|
|
System.Character;
|
|
|
|
type
|
|
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
|
|
public
|
|
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
|
|
function GetHashCode(const Value: TResolvedAddress): Integer; override;
|
|
end;
|
|
|
|
{ TExpansionVisitor }
|
|
|
|
constructor TExpansionVisitor.Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope);
|
|
begin
|
|
inherited Create;
|
|
FBinder := ABinder;
|
|
FMacroScope := AMacroScope;
|
|
end;
|
|
|
|
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
|
var
|
|
value: TDataValue;
|
|
expr: IAstNode;
|
|
addr: TResolvedAddress;
|
|
begin
|
|
expr := Node.Expression;
|
|
|
|
// Check if the expression is a simple identifier that refers to a macro parameter.
|
|
if (expr is TIdentifierNode) then
|
|
begin
|
|
addr := FMacroScope.CreateDescriptor.FindSymbol((expr as TIdentifierNode).Name);
|
|
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
|
|
begin
|
|
// It's a macro parameter. Get its value, which is the AST passed as an argument.
|
|
var argValue := FMacroScope.Values[addr];
|
|
if argValue.Kind = vkInterface then
|
|
begin
|
|
// This is syntactic unquoting. Return the AST directly.
|
|
Result := argValue;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// If it's not a parameter or the parameter doesn't hold an AST, it's value unquoting.
|
|
// Evaluate the expression at compile time using the binder's context.
|
|
value := FBinder.EvaluateAtCompileTime(expr);
|
|
|
|
// Convert the resulting value back into an AST node to splice it into the tree.
|
|
if value.Kind in [vkScalar, vkText, vkVoid] then
|
|
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value))
|
|
else
|
|
// For now, other complex types are not supported for value unquoting.
|
|
raise Exception.CreateFmt('Cannot unquote complex value of type %s at compile time.', [value.Kind.ToString]);
|
|
end;
|
|
|
|
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
|
begin
|
|
// Similar to VisitUnquote, but we expect the result to be a list of nodes.
|
|
// We evaluate the inner expression. The result is a TDataValue.
|
|
// We don't do anything with it here; we just return it.
|
|
// The VisitFunctionCall override will check for this and perform the "splicing".
|
|
var value := VisitUnquote(TAst.Unquote(Node.Expression)).AsIntf<IAstNode>;
|
|
Result := TDataValue.FromIntf<IUnquoteSplicingNode>(TAst.UnquoteSplicing(value));
|
|
end;
|
|
|
|
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
|
var
|
|
newArgs: TList<IAstNode>;
|
|
transformedArg: IAstNode;
|
|
splicingNode: IUnquoteSplicingNode;
|
|
begin
|
|
// This override handles splicing arguments (~@).
|
|
newArgs := TList<IAstNode>.Create;
|
|
try
|
|
for var arg in Node.Arguments do
|
|
begin
|
|
var transformedArgValue := Self.Accept(arg); // This might return an UnquoteSplicing node.
|
|
if transformedArgValue.IsVoid then
|
|
continue;
|
|
|
|
transformedArg := transformedArgValue.AsIntf<IAstNode>;
|
|
|
|
if (transformedArg is TUnquoteSplicingNode) then
|
|
begin
|
|
splicingNode := transformedArg as TUnquoteSplicingNode;
|
|
// The inner expression should have been evaluated to an AST block
|
|
if (splicingNode.Expression is TBlockExpressionNode) then
|
|
newArgs.AddRange((splicingNode.Expression as TBlockExpressionNode).Expressions)
|
|
else
|
|
raise Exception.Create('Expression inside unquote-splicing (`~@`) must evaluate to a list of nodes (a block).');
|
|
end
|
|
else
|
|
begin
|
|
newArgs.Add(transformedArg);
|
|
end;
|
|
end;
|
|
|
|
var transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
|
|
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs.ToArray));
|
|
finally
|
|
newArgs.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TBoundIdentifierNode }
|
|
constructor TBoundIdentifierNode.Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
|
|
begin
|
|
inherited Create(AUnboundNode.Name);
|
|
FAddress := AAddress;
|
|
end;
|
|
|
|
{ TBoundVariableDeclarationNode }
|
|
constructor TBoundVariableDeclarationNode.Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode; AIsBoxed: Boolean);
|
|
begin
|
|
inherited Create(AIdentifier, AInitializer);
|
|
FIsBoxed := AIsBoxed;
|
|
end;
|
|
|
|
{ TBoundLambdaExpressionNode }
|
|
constructor TBoundLambdaExpressionNode.Create(
|
|
const AUnboundNode: ILambdaExpressionNode;
|
|
const ABody: IAstNode;
|
|
const AParameters: TArray<IIdentifierNode>;
|
|
const AScopeDescriptor: IScopeDescriptor;
|
|
const AUpvalues: TArray<TResolvedAddress>;
|
|
AHasNestedLambdas: Boolean
|
|
);
|
|
begin
|
|
inherited Create(AParameters, ABody);
|
|
FScopeDescriptor := AScopeDescriptor;
|
|
FUpvalues := AUpvalues;
|
|
FHasNestedLambdas := AHasNestedLambdas;
|
|
end;
|
|
|
|
{ TBoundFunctionCallNode }
|
|
constructor TBoundFunctionCallNode.Create(
|
|
const AUnboundNode: IFunctionCallNode;
|
|
const ACallee: IAstNode;
|
|
const AArguments: TArray<IAstNode>;
|
|
AIsTailCall: Boolean
|
|
);
|
|
begin
|
|
inherited Create(ACallee, AArguments);
|
|
FIsTailCall := AIsTailCall;
|
|
end;
|
|
|
|
{ TResolvedAddressComparer }
|
|
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
|
|
begin
|
|
Result := (Left = Right);
|
|
end;
|
|
|
|
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
|
|
begin
|
|
Result := 17;
|
|
Result := Result * 23 + Ord(Value.Kind);
|
|
Result := Result * 23 + Value.ScopeDepth;
|
|
Result := Result * 23 + Value.SlotIndex;
|
|
end;
|
|
|
|
{ TAstBinder.TUpvalueMapping }
|
|
constructor TAstBinder.TUpvalueMapping.Create;
|
|
begin
|
|
inherited Create;
|
|
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Create);
|
|
Nodes := TList<IIdentifierNode>.Create();
|
|
end;
|
|
|
|
destructor TAstBinder.TUpvalueMapping.Destroy;
|
|
begin
|
|
Nodes.Free;
|
|
Map.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TAstBinder }
|
|
|
|
constructor TAstBinder.Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
|
|
begin
|
|
inherited Create;
|
|
Assert(Assigned(AInitialScope));
|
|
Assert(Assigned(AEvaluatorFactory));
|
|
|
|
FInitialScope := AInitialScope;
|
|
FEvaluatorFactory := AEvaluatorFactory;
|
|
FCurrentDescriptor := AInitialScope.CreateDescriptor;
|
|
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
|
|
FNestedLambdaCount := 0;
|
|
FIsTailStack := TStack<Boolean>.Create;
|
|
FNextIsTail := True;
|
|
FBoxedDeclarations := nil;
|
|
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
|
|
end;
|
|
|
|
destructor TAstBinder.Destroy;
|
|
begin
|
|
FIsTailStack.Free;
|
|
FUpvalueStack.Free;
|
|
FBoxedDeclarations.Free;
|
|
FMacros.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TAstBinder.Accept(const Node: IAstNode): TDataValue;
|
|
begin
|
|
if (not Assigned(Node)) or Done then
|
|
exit;
|
|
|
|
FIsTailStack.Push(FNextIsTail);
|
|
try
|
|
Result := inherited Accept(Node);
|
|
finally
|
|
FNextIsTail := FIsTailStack.Pop;
|
|
end;
|
|
end;
|
|
|
|
procedure TAstBinder.EnterScope;
|
|
begin
|
|
FCurrentDescriptor := TScope.CreateDescriptor(FCurrentDescriptor);
|
|
end;
|
|
|
|
function TAstBinder.EvaluateAtCompileTime(const ANode: IAstNode): TDataValue;
|
|
var
|
|
subBinder: IAstBinder;
|
|
subDescriptor: IScopeDescriptor;
|
|
boundSubAst: IAstNode;
|
|
evalScope: IExecutionScope;
|
|
evaluator: IEvaluatorVisitor;
|
|
tempInitScope: IExecutionScope;
|
|
begin
|
|
// Create a temporary scope that represents the binder's current lexical context.
|
|
tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil);
|
|
|
|
// 1. Bind the sub-tree in a new binder, using the current scope descriptor.
|
|
subBinder := TAstBinder.Create(tempInitScope, FEvaluatorFactory);
|
|
boundSubAst := subBinder.Execute(ANode, subDescriptor);
|
|
|
|
// 2. Create the execution scope for this specific evaluation.
|
|
evalScope := subDescriptor.CreateScope(tempInitScope);
|
|
|
|
// 3. Create the correct evaluator (Debug/Production) using the injected factory.
|
|
evaluator := FEvaluatorFactory(evalScope);
|
|
|
|
// 4. Execute and return the resulting value.
|
|
Result := evaluator.Execute(boundSubAst);
|
|
end;
|
|
|
|
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
|
begin
|
|
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
|
|
try
|
|
EnterScope;
|
|
try
|
|
var transformedNode := Accept(RootNode).AsIntf<IAstNode>;
|
|
|
|
// If the result of the transformation is a single void constant, return an empty block instead.
|
|
if (transformedNode is TConstantNode) and (TConstantNode(transformedNode).Value.IsVoid) then
|
|
Result := TAst.Block([])
|
|
else
|
|
Result := transformedNode;
|
|
|
|
Descriptor := FCurrentDescriptor;
|
|
finally
|
|
ExitScope;
|
|
end;
|
|
finally
|
|
// The binder now owns the hash set, which will be freed in the destructor.
|
|
end;
|
|
end;
|
|
|
|
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
|
begin
|
|
// Register the macro for the current binder instance.
|
|
FMacros.AddOrSetValue(Node.Name.Name, Node);
|
|
|
|
// Return an empty block node. This is a valid "no-op" node
|
|
// that is simply ignored by the evaluator.
|
|
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block([]));
|
|
end;
|
|
|
|
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
|
var
|
|
macroDef: IMacroDefinitionNode;
|
|
calleeIdentifier: TIdentifierNode;
|
|
i: Integer;
|
|
expansionScope: IExecutionScope;
|
|
expander: TExpansionVisitor;
|
|
expandedBody: IAstNode;
|
|
isTailCall: Boolean;
|
|
callee: IAstNode;
|
|
args: TArray<IAstNode>;
|
|
boundCall: IFunctionCallNode;
|
|
begin
|
|
// First, check if this is a macro call.
|
|
if (Node.Callee is TIdentifierNode) then
|
|
begin
|
|
calleeIdentifier := Node.Callee as TIdentifierNode;
|
|
if FMacros.TryGetValue(calleeIdentifier.Name, macroDef) then
|
|
begin
|
|
// It's a macro. Expand it now.
|
|
expansionScope := TAst.CreateScope(nil);
|
|
|
|
// Check for variadic macro parameter
|
|
var params := macroDef.Parameters;
|
|
var lastParamName := '';
|
|
if Length(params) > 0 then
|
|
lastParamName := params[High(params)].Name;
|
|
|
|
if (Length(params) > 1) and (lastParamName.StartsWith('&')) then
|
|
begin
|
|
var requiredArgs := Length(params) - 1;
|
|
if Length(Node.Arguments) < requiredArgs then
|
|
raise Exception.CreateFmt(
|
|
'Macro %s expects at least %d arguments, but got %d',
|
|
[calleeIdentifier.Name, requiredArgs, Length(Node.Arguments)]);
|
|
|
|
// Bind fixed arguments
|
|
for i := 0 to requiredArgs - 1 do
|
|
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
|
|
|
|
// Bind rest arguments as a list (AST block)
|
|
var restArgs: TArray<IAstNode>;
|
|
SetLength(restArgs, Length(Node.Arguments) - requiredArgs);
|
|
for i := 0 to High(restArgs) do
|
|
restArgs[i] := Node.Arguments[requiredArgs + i];
|
|
expansionScope.Define(lastParamName.Substring(1), TDataValue.FromIntf<IAstNode>(TAst.Block(restArgs)));
|
|
end
|
|
else
|
|
begin
|
|
if Length(Node.Arguments) <> Length(params) then
|
|
raise Exception.CreateFmt(
|
|
'Macro %s expects %d arguments, but got %d',
|
|
[calleeIdentifier.Name, Length(params), Length(Node.Arguments)]);
|
|
|
|
for i := 0 to High(params) do
|
|
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
|
|
end;
|
|
|
|
// A macro body MUST be a quasiquote.
|
|
if not (macroDef.Body is TQuasiquoteNode) then
|
|
raise Exception.CreateFmt('Macro body for "%s" must be a quasiquoted expression.', [calleeIdentifier.Name]);
|
|
|
|
// Use the dedicated expansion visitor to process the CONTENT of the macro body.
|
|
var quasiquoteBody := macroDef.Body as TQuasiquoteNode;
|
|
expander := TExpansionVisitor.Create(Self, expansionScope);
|
|
expandedBody := expander.Execute(quasiquoteBody.Expression);
|
|
|
|
// IMPORTANT: Recursively call Accept on the newly generated AST fragment
|
|
// to bind it within the current scope.
|
|
Result := Self.Accept(expandedBody);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// It's a regular function call, proceed with normal binding.
|
|
isTailCall := FIsTailStack.Peek;
|
|
|
|
FNextIsTail := False;
|
|
callee := Accept(Node.Callee).AsIntf<IAstNode>;
|
|
args := TransformNodes<IAstNode>(Node.Arguments);
|
|
|
|
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
|
|
Result := TDataValue.FromIntf<IFunctionCallNode>(boundCall);
|
|
end;
|
|
|
|
procedure TAstBinder.ExitScope;
|
|
begin
|
|
FCurrentDescriptor := FCurrentDescriptor.Parent;
|
|
end;
|
|
|
|
function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
|
|
var
|
|
c: Char;
|
|
begin
|
|
if Name.IsEmpty then
|
|
exit(False);
|
|
|
|
c := Name[1];
|
|
if not (c.IsLetter or (c = '_')) then
|
|
exit(False);
|
|
|
|
for c in Name do
|
|
begin
|
|
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
|
|
exit(False);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
|
begin
|
|
FNextIsTail := False;
|
|
Result := inherited VisitAssignment(Node);
|
|
end;
|
|
|
|
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
|
begin
|
|
FNextIsTail := False;
|
|
Result := inherited VisitBinaryExpression(Node);
|
|
end;
|
|
|
|
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
|
var
|
|
exprs: TArray<IAstNode>;
|
|
i: Integer;
|
|
isContextTail: Boolean;
|
|
transformedValue: TDataValue;
|
|
exprList: TList<IAstNode>;
|
|
begin
|
|
isContextTail := FIsTailStack.Peek;
|
|
exprList := TList<IAstNode>.Create;
|
|
try
|
|
for i := 0 to High(Node.Expressions) do
|
|
begin
|
|
FNextIsTail := isContextTail and (i = High(Node.Expressions));
|
|
transformedValue := Accept(Node.Expressions[i]);
|
|
// If a sub-expression (like a macro definition) returns void, skip it.
|
|
if not transformedValue.IsVoid then
|
|
exprList.Add(transformedValue.AsIntf<IAstNode>);
|
|
end;
|
|
exprs := exprList.ToArray;
|
|
finally
|
|
exprList.Free;
|
|
end;
|
|
|
|
// Avoid creating a new node if nothing changed.
|
|
if (Length(exprs) = Length(Node.Expressions)) then
|
|
begin
|
|
var same := True;
|
|
for i := 0 to High(exprs) do
|
|
if exprs[i] <> Node.Expressions[i] then
|
|
begin
|
|
same := False;
|
|
break;
|
|
end;
|
|
if same then
|
|
begin
|
|
Result := TDataValue.FromIntf<IBlockExpressionNode>(Node);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(exprs));
|
|
end;
|
|
|
|
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
|
var
|
|
isContextTail: Boolean;
|
|
condition, thenBranch, elseBranch: IAstNode;
|
|
begin
|
|
isContextTail := FIsTailStack.Peek;
|
|
|
|
FNextIsTail := False;
|
|
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
|
|
|
FNextIsTail := isContextTail;
|
|
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
|
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
|
|
|
|
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
|
|
Result := TDataValue.FromIntf<IIfExpressionNode>(TAst.IfExpr(condition, thenBranch, elseBranch))
|
|
else
|
|
Result := TDataValue.FromIntf<IIfExpressionNode>(Node);
|
|
end;
|
|
|
|
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
|
var
|
|
i: integer;
|
|
boundParams: TArray<IIdentifierNode>;
|
|
boundBody: IAstNode;
|
|
lambdaScope: IScopeDescriptor;
|
|
upvalues: TArray<TResolvedAddress>;
|
|
hasNestedLambdas: Boolean;
|
|
lastNestedLambdaCount: Integer;
|
|
boundLambda: ILambdaExpressionNode;
|
|
begin
|
|
FUpvalueStack.Push(TUpvalueMapping.Create);
|
|
try
|
|
EnterScope;
|
|
try
|
|
FCurrentDescriptor.Define('<self>');
|
|
|
|
SetLength(boundParams, Length(Node.Parameters));
|
|
for i := 0 to High(Node.Parameters) do
|
|
begin
|
|
var paramNode := Node.Parameters[i];
|
|
var slotIndex := FCurrentDescriptor.Define(paramNode.Name);
|
|
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
|
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
|
|
end;
|
|
|
|
lastNestedLambdaCount := FNestedLambdaCount;
|
|
|
|
FNextIsTail := True;
|
|
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
|
|
|
|
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
|
|
lambdaScope := FCurrentDescriptor;
|
|
finally
|
|
ExitScope;
|
|
end;
|
|
|
|
var upvalueMapping := FUpvalueStack.Peek;
|
|
var sortedPairs := upvalueMapping.Map.ToArray;
|
|
TArray.Sort<TPair<TResolvedAddress, Integer>>(
|
|
sortedPairs,
|
|
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
|
|
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
|
|
)
|
|
);
|
|
|
|
SetLength(upvalues, Length(sortedPairs));
|
|
for i := 0 to High(sortedPairs) do
|
|
upvalues[i] := sortedPairs[i].Key;
|
|
|
|
finally
|
|
FUpvalueStack.Pop;
|
|
end;
|
|
|
|
inc(FNestedLambdaCount);
|
|
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
|
|
Result := TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda);
|
|
end;
|
|
|
|
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
|
begin
|
|
if not FIsTailStack.Peek then
|
|
raise Exception.Create('''recur'' can only be used in a tail position.');
|
|
|
|
FNextIsTail := False;
|
|
Result := inherited VisitRecurNode(Node);
|
|
end;
|
|
|
|
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
|
var
|
|
isContextTail: Boolean;
|
|
condition, thenBranch, elseBranch: IAstNode;
|
|
begin
|
|
isContextTail := FIsTailStack.Peek;
|
|
|
|
FNextIsTail := False;
|
|
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
|
|
|
FNextIsTail := isContextTail;
|
|
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
|
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
|
|
|
|
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
|
|
Result := TDataValue.FromIntf<ITernaryExpressionNode>(TAst.TernaryExpr(condition, thenBranch, elseBranch))
|
|
else
|
|
Result := TDataValue.FromIntf<ITernaryExpressionNode>(Node);
|
|
end;
|
|
|
|
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
|
begin
|
|
FNextIsTail := False;
|
|
Result := inherited VisitUnaryExpression(Node);
|
|
end;
|
|
|
|
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
|
var
|
|
adr: TResolvedAddress;
|
|
boundNode: IIdentifierNode;
|
|
begin
|
|
adr := FCurrentDescriptor.FindSymbol(Node.Name);
|
|
if adr.Kind = akLocalOrParent then
|
|
begin
|
|
if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
|
|
begin
|
|
var upvalue := FUpvalueStack.Peek;
|
|
|
|
// up to outer scope
|
|
dec(adr.ScopeDepth);
|
|
|
|
var upvalueIndex: Integer;
|
|
if not upvalue.Map.TryGetValue(adr, upvalueIndex) then
|
|
begin
|
|
upvalueIndex := upvalue.Map.Count;
|
|
upvalue.Map.Add(adr, upvalueIndex);
|
|
end;
|
|
|
|
boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex));
|
|
end
|
|
else
|
|
boundNode := TBoundIdentifierNode.Create(Node, adr);
|
|
Result := TDataValue.FromIntf<IIdentifierNode>(boundNode);
|
|
end
|
|
else
|
|
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
|
|
end;
|
|
|
|
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
|
var
|
|
initializer: IAstNode;
|
|
slotIndex: Integer;
|
|
address: TResolvedAddress;
|
|
boundIdentifier: IIdentifierNode;
|
|
isBoxed: Boolean;
|
|
boundDecl: IVariableDeclarationNode;
|
|
begin
|
|
if not IsValidIdentifier(Node.Identifier.Name) then
|
|
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
|
|
|
|
FNextIsTail := False;
|
|
initializer := nil;
|
|
if Node.Initializer <> nil then
|
|
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
|
|
|
|
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name);
|
|
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
|
|
|
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
|
|
|
|
// Check if the analysis pass marked this declaration as being captured by a closure.
|
|
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
|
|
|
|
// Always create a bound declaration node, passing the IsBoxed flag.
|
|
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
|
|
Result := TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl);
|
|
end;
|
|
|
|
end.
|