From 039a7c4b3e5b049f668e3c1956596708131e4be1 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 6 Oct 2025 20:07:19 +0200 Subject: [PATCH] Ast binding refactoring --- ASTPlayground/UserLib.json | 116 ++++++++++++++++++++++++++++++++++ Src/AST/Myc.Ast.Binding.pas | 120 +++++++++++++++++++++++------------- 2 files changed, 192 insertions(+), 44 deletions(-) diff --git a/ASTPlayground/UserLib.json b/ASTPlayground/UserLib.json index 03e1987..9076f60 100644 --- a/ASTPlayground/UserLib.json +++ b/ASTPlayground/UserLib.json @@ -199,5 +199,121 @@ ] } } + }, + "factorial": { + "NodeType": "LambdaExpr", + "Parameters": [ + { + "NodeType": "Identifier", + "Name": "n" + } + ], + "Body": { + "NodeType": "FunctionCall", + "Callee": { + "NodeType": "LambdaExpr", + "Parameters": [ + { + "NodeType": "Identifier", + "Name": "n" + }, + { + "NodeType": "Identifier", + "Name": "acc" + } + ], + "Body": { + "NodeType": "TernaryExpr", + "Condition": { + "NodeType": "FunctionCall", + "Callee": { + "NodeType": "Identifier", + "Name": "<=" + }, + "Arguments": [ + { + "NodeType": "Identifier", + "Name": "n" + }, + { + "NodeType": "Constant", + "Value": { + "Kind": "Scalar", + "Value": { + "Kind": "Ordinal", + "Value": 1 + } + } + } + ] + }, + "ThenBranch": { + "NodeType": "Identifier", + "Name": "acc" + }, + "ElseBranch": { + "NodeType": "Recur", + "Arguments": [ + { + "NodeType": "FunctionCall", + "Callee": { + "NodeType": "Identifier", + "Name": "-" + }, + "Arguments": [ + { + "NodeType": "Identifier", + "Name": "n" + }, + { + "NodeType": "Constant", + "Value": { + "Kind": "Scalar", + "Value": { + "Kind": "Ordinal", + "Value": 1 + } + } + } + ] + }, + { + "NodeType": "FunctionCall", + "Callee": { + "NodeType": "Identifier", + "Name": "*" + }, + "Arguments": [ + { + "NodeType": "Identifier", + "Name": "acc" + }, + { + "NodeType": "Identifier", + "Name": "n" + } + ] + } + ] + } + } + }, + "Arguments": [ + { + "NodeType": "Identifier", + "Name": "n" + }, + { + "NodeType": "Constant", + "Value": { + "Kind": "Scalar", + "Value": { + "Kind": "Ordinal", + "Value": 1 + } + } + } + ] + } } } \ No newline at end of file diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 3d8feaf..aeddd42 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -21,10 +21,12 @@ type TAstBinder = class; // Forward declaration + TEvaluateProc = reference to function(const Node: IAstNode): TDataValue; + // This visitor handles the expansion of a single macro body (` `...`). TExpansionVisitor = class(TAstTransformer) private - FBinder: TAstBinder; + FEvaluate: TEvaluateProc; FMacroScope: IExecutionScope; function TransformAndSpliceNodes(const ANodes: TArray): TArray; protected @@ -33,7 +35,8 @@ type function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; public - constructor Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope); + constructor Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc); + class function Expand(const MacroScope: IExecutionScope; const RootNode: IAstNode; const AEvaluate: TEvaluateProc): IAstNode; end; TAstBinder = class(TAstTransformer, IAstBinder) @@ -62,7 +65,6 @@ type procedure EnterScope; procedure ExitScope; function IsValidIdentifier(const Name: string): Boolean; - function EvaluateAtCompileTime(const ANode: IAstNode): TDataValue; protected function Accept(const Node: IAstNode): TDataValue; override; @@ -84,6 +86,13 @@ type constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory); destructor Destroy; override; function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; + + class function Bind( + const InitialScope: IExecutionScope; + const RootNode: IAstNode; + out Descriptor: IScopeDescriptor; + const EvaluatorFactory: TEvaluatorFactory + ): IAstNode; static; end; TBoundIdentifierNode = class(TIdentifierNode) @@ -149,11 +158,21 @@ type { TExpansionVisitor } -constructor TExpansionVisitor.Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope); +constructor TExpansionVisitor.Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc); begin inherited Create; - FBinder := ABinder; FMacroScope := AMacroScope; + FEvaluate := AEvaluate; +end; + +class function TExpansionVisitor.Expand( + const MacroScope: IExecutionScope; + const RootNode: IAstNode; + const AEvaluate: TEvaluateProc +): IAstNode; +begin + var expander := TExpansionVisitor.Create(MacroScope, AEvaluate) as IAstTransformer; + Result := expander.Execute(RootNode); end; function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: TArray): TArray; @@ -216,7 +235,8 @@ begin end; end; - value := FBinder.EvaluateAtCompileTime(expr); + // externally evaluate the expression using the injected evaluator + value := FEvaluate(expr); if value.Kind in [vkScalar, vkText, vkVoid] then Result := TDataValue.FromIntf(TAst.Constant(value)) @@ -370,28 +390,22 @@ begin end; end; +class function TAstBinder.Bind( + const InitialScope: IExecutionScope; + const RootNode: IAstNode; + out Descriptor: IScopeDescriptor; + const EvaluatorFactory: TEvaluatorFactory +): IAstNode; +begin + var binder := TAstBinder.Create(InitialScope, EvaluatorFactory) as IAstBinder; + Result := binder.Execute(RootNode, Descriptor); +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 - tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil); - subBinder := TAstBinder.Create(tempInitScope, FEvaluatorFactory); - boundSubAst := subBinder.Execute(ANode, subDescriptor); - evalScope := subDescriptor.CreateScope(tempInitScope); - evaluator := FEvaluatorFactory(evalScope); - Result := evaluator.Execute(boundSubAst); -end; - function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; begin FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent); @@ -425,15 +439,16 @@ var unaryOp: TScalar.TUnaryOp; macroDef: IMacroDefinitionNode; begin - // --- Optimization: Operator Folding --- if (Node.Callee is TIdentifierNode) then begin calleeIdentifier := Node.Callee as TIdentifierNode; + // --- Optimization: Operator Folding --- + // Try to fold binary operators - if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then + if Length(Node.Arguments) = 2 then begin - if Length(Node.Arguments) = 2 then + if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then begin FNextIsTail := False; var left := Accept(Node.Arguments[0]).AsIntf; @@ -444,27 +459,28 @@ begin end; // Try to fold unary operators - if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then + if Length(Node.Arguments) = 1 then begin - if Length(Node.Arguments) = 1 then + if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then begin FNextIsTail := False; var right := Accept(Node.Arguments[0]).AsIntf; Result := TDataValue.FromIntf(TAst.UnaryExpr(unaryOp, right)); exit; end; - end; - // Special case for negation '-' - if (calleeIdentifier.Name = '-') and (Length(Node.Arguments) = 1) then - begin - FNextIsTail := False; - var right := Accept(Node.Arguments[0]).AsIntf; - Result := TDataValue.FromIntf(TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right)); - exit; + // Special case for negation '-' + if (calleeIdentifier.Name = '-') then + begin + FNextIsTail := False; + var right := Accept(Node.Arguments[0]).AsIntf; + Result := TDataValue.FromIntf(TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right)); + exit; + end; end; // --- Macro Expansion --- + macroDef := FCurrentDescriptor.FindMacro(calleeIdentifier.Name); if macroDef <> nil then begin @@ -478,16 +494,32 @@ begin for var i := 0 to High(params) do expansionScope.Define(params[i].Name, TDataValue.FromIntf(Node.Arguments[i])); - if not (macroDef.Body is TQuasiquoteNode) then - raise Exception.CreateFmt('Macro body for "%s" must be a quasiquoted expression.', [calleeIdentifier.Name]); + // expand + var expandedBody := + TExpansionVisitor.Expand( + expansionScope, + macroDef.Body.Expression, + function(const Node: IAstNode): TDataValue + var + subDescriptor: IScopeDescriptor; + begin + // in place evaluator for expanded expressions + var tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil); + var boundSubAst := TAstBinder.Bind(tempInitScope, Node, subDescriptor, FEvaluatorFactory); + var evalScope := subDescriptor.CreateScope(tempInitScope); + var evaluator := FEvaluatorFactory(evalScope); + Result := evaluator.Execute(boundSubAst); + end + ); - var quasiquoteBody := macroDef.Body as TQuasiquoteNode; - var expander := TExpansionVisitor.Create(Self, expansionScope); - var expandedBody := expander.Execute(quasiquoteBody.Expression); + // bind expanded body var boundExpandedBody := Self.Accept(expandedBody).AsIntf; - var macroNode := TMacroExpansionNode.Create(Node, boundExpandedBody); - Result := TDataValue.FromIntf(macroNode); - exit; + + // wrap in new expansion node + var macroNode := TMacroExpansionNode.Create(Node, boundExpandedBody) as IMacroExpansionNode; + + // done + exit(TDataValue.FromIntf(macroNode)); end; end;