diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index 313f622..17e46a3 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -19,7 +19,8 @@ uses Myc.Fmx.AstEditor.Workspace in 'Myc.Fmx.AstEditor.Workspace.pas', Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas', Myc.Utils in '..\Src\Myc.Utils.pas', - Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas'; + Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas', + Myc.Ast.MacroExpander in '..\Src\AST\Myc.Ast.MacroExpander.pas'; {$R *.res} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 0b40ffb..9476190 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -105,6 +105,7 @@ true true true + off false @@ -151,6 +152,7 @@ + Base diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 1a6a38a..b94b893 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -33,6 +33,7 @@ uses Myc.Ast.Binding, Myc.Ast.RTL, Myc.Ast.Script, + Myc.Ast.MacroExpander, FMX.Layouts, FMX.Objects, Myc.Ast.Debugger, @@ -214,8 +215,24 @@ var scriptScope: IExecutionScope; visitor: IEvaluatorVisitor; begin + var macroExpander := + TMacroExpander.Create( + function(const ANode: IAstNode): TDataValue + begin + var binder := TAstBinder.Create(AParentScope) as IAstBinder; + + var descriptor: IScopeDescriptor; + var boundAst := binder.Execute(ANode, descriptor); + + var evalScope := descriptor.CreateScope(AParentScope); + var evaluator := CreateEvaluator(evalScope); + + Result := evaluator.Execute(boundAst); + end) + as IMacroExpander; + binder := TAstBinder.Create(AParentScope); - FCurrAst := binder.Execute(ANode, FCurrDesc); + FCurrAst := binder.Execute(macroExpander.Execute(ANode), FCurrDesc); scriptScope := FCurrDesc.CreateScope(AParentScope); visitor := CreateEvaluator(scriptScope); diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas index e093905..3c16c24 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas @@ -27,6 +27,9 @@ type function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; function VisitIndexer(const Node: IIndexerNode): TDataValue; override; function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; + function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override; + function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; + function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; @@ -200,6 +203,21 @@ begin Result := Format('%s.%s', [baseStr, Node.Member.Name]); end; +function TAstToTextVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; +begin + Result := '`' + Node.Expression.Accept(Self).AsText; +end; + +function TAstToTextVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue; +begin + Result := '~' + Node.Expression.Accept(Self).AsText; +end; + +function TAstToTextVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; +begin + Result := '~@' + Node.Expression.Accept(Self).AsText; +end; + function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; var seriesStr: string; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.pas b/ASTPlayground/Myc.Fmx.AstEditor.pas index 0e8f66d..84ab62d 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.pas @@ -115,6 +115,9 @@ type function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; + function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override; + function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; + function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; function VisitIndexer(const Node: IIndexerNode): TDataValue; override; function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; @@ -1245,6 +1248,75 @@ begin Result := TDataValue.Void; end; +function TAstToAuraNodeVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; +begin + VisitOperatorNode( + [Node.Expression], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + qqNode: TAuraNode; + inputPin, outPin: TControl; + begin + qqNode := BuildNodeControl('`', ''); + qqNode.TitleFont.Size := 20; + inputPin := CreateInput(qqNode, ''); + outPin := CreateOutput(qqNode); + if Assigned(InputResults[0].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, inputPin)); + FinalizeNodeLayout(qqNode); + Result.LayoutNode := qqNode; + Result.OutputPin := outPin; + end + ); + Result := TDataValue.Void; +end; + +function TAstToAuraNodeVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue; +begin + VisitOperatorNode( + [Node.Expression], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + uqNode: TAuraNode; + inputPin, outPin: TControl; + begin + uqNode := BuildNodeControl('~', ''); + uqNode.TitleFont.Size := 20; + inputPin := CreateInput(uqNode, ''); + outPin := CreateOutput(uqNode); + if Assigned(InputResults[0].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, inputPin)); + FinalizeNodeLayout(uqNode); + Result.LayoutNode := uqNode; + Result.OutputPin := outPin; + end + ); + Result := TDataValue.Void; +end; + +function TAstToAuraNodeVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; +begin + VisitOperatorNode( + [Node.Expression], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + uqsNode: TAuraNode; + inputPin, outPin: TControl; + begin + uqsNode := BuildNodeControl('~@', ''); + uqsNode.TitleFont.Size := 20; + inputPin := CreateInput(uqsNode, ''); + outPin := CreateOutput(uqsNode); + if Assigned(InputResults[0].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, inputPin)); + FinalizeNodeLayout(uqsNode); + Result.LayoutNode := uqsNode; + Result.OutputPin := outPin; + end + ); + Result := TDataValue.Void; +end; + function TAstToAuraNodeVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; var details: string; diff --git a/Src/AST/Myc.Ast.Analyzer.pas b/Src/AST/Myc.Ast.Analyzer.pas index ba5adcc..9357871 100644 --- a/Src/AST/Myc.Ast.Analyzer.pas +++ b/Src/AST/Myc.Ast.Analyzer.pas @@ -8,21 +8,23 @@ uses System.Generics.Collections, Myc.Ast.Nodes, Myc.Ast.Visitor, - Myc.Ast.Scope; + Myc.Ast.Scope, + Myc.Data.Value; type // This visitor analyzes the AST to find all variables that need to be "lifted" or "boxed" // because they are captured by a nested lambda. - TUpvalueAnalyzer = class(TAstTraverser) + TUpvalueAnalyzer = class(TAstTransformer) private FBoxedDeclarations: THashSet; FCurrentScope: IScopeDescriptor; FDeclarationMap: TDictionary>; procedure MarkDeclarationForBoxing(const AName: string); protected - function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; override; - function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; override; - function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; override; + // Overridden Visit methods to perform analysis during traversal. + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; public constructor Create(const AParent: IScopeDescriptor); destructor Destroy; override; @@ -96,24 +98,26 @@ begin end; end; -function TUpvalueAnalyzer.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; +function TUpvalueAnalyzer.VisitIdentifier(const Node: IIdentifierNode): TDataValue; var address: TResolvedAddress; begin - Result := Node; - if not Assigned(FCurrentScope) then - exit; - - address := FCurrentScope.FindSymbol(Node.Name); - - if (address.Kind = akLocalOrParent) and (address.ScopeDepth > 0) then + if Assigned(FCurrentScope) then begin - // This is an upvalue. Mark its original declaration for boxing. - MarkDeclarationForBoxing(Node.Name); + address := FCurrentScope.FindSymbol(Node.Name); + + if (address.Kind = akLocalOrParent) and (address.ScopeDepth > 0) then + begin + // This is an upvalue. Mark its original declaration for boxing. + MarkDeclarationForBoxing(Node.Name); + end; end; + + // As a traverser, return the original node wrapped in a TDataValue. + Result := TDataValue.FromIntf(Node); end; -function TUpvalueAnalyzer.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; +function TUpvalueAnalyzer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; begin // A lambda creates a new lexical scope, inheriting from the current one. FCurrentScope := TScope.CreateDescriptor(FCurrentScope); @@ -124,19 +128,21 @@ begin // Traverse the lambda body within the new scope context. Node.Body.Accept(Self); - Result := Node; // We do not transform, just analyze. + + // We do not transform, just analyze. Return the original node wrapped. + Result := TDataValue.FromIntf(Node); finally // Restore the parent scope after leaving the lambda. FCurrentScope := FCurrentScope.Parent; end; end; -function TUpvalueAnalyzer.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; +function TUpvalueAnalyzer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; var scopeDeclarations: TDictionary; begin - Result := Node; - + // Traverse the initializer first. It's evaluated in the current scope + // before the new variable is defined. if Assigned(Node.Initializer) then Node.Initializer.Accept(Self); @@ -150,6 +156,9 @@ begin FDeclarationMap.Add(FCurrentScope, scopeDeclarations); end; scopeDeclarations.Add(Node.Identifier.Name, Node); + + // As a traverser, return the original node wrapped in a TDataValue. + Result := TDataValue.FromIntf(Node); end; end. diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 3a3d599..0b2965d 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -49,25 +49,24 @@ type // Stack management for tail-call state is centralized here. function Accept(const Node: IAstNode): TDataValue; override; + // The binder overrides specific visit methods to enrich the AST. + 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); destructor Destroy; override; function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; - - // The binder overrides specific transform methods to enrich the AST. - function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; override; - function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; override; - function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; override; - function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; override; - function TransformMacroDefinition(const Node: IMacroDefinitionNode): IMacroDefinitionNode; override; - function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; override; - function TransformRecur(const Node: IRecurNode): IRecurNode; override; - function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; override; - function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; override; - function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; override; - function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; override; - function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; override; end; TBoundIdentifierNode = class(TIdentifierNode) @@ -285,9 +284,10 @@ begin Result := True; end; -function TAstBinder.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; +function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue; var adr: TResolvedAddress; + boundNode: IIdentifierNode; begin adr := FCurrentDescriptor.FindSymbol(Node.Name); if adr.Kind = akLocalOrParent then @@ -306,22 +306,24 @@ begin upvalue.Map.Add(adr, upvalueIndex); end; - Result := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex)); + boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex)); end else - Result := TBoundIdentifierNode.Create(Node, adr); + boundNode := TBoundIdentifierNode.Create(Node, adr); + Result := TDataValue.FromIntf(boundNode); end else raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]); end; -function TAstBinder.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; +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]); @@ -340,28 +342,29 @@ begin isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node); // Always create a bound declaration node, passing the IsBoxed flag. - Result := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed); + boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed); + Result := TDataValue.FromIntf(boundDecl); end; -function TAstBinder.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; +function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin FNextIsTail := False; - Result := inherited TransformAssignment(Node); + Result := inherited VisitAssignment(Node); end; -function TAstBinder.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; +function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; begin FNextIsTail := False; - Result := inherited TransformBinaryExpression(Node); + Result := inherited VisitBinaryExpression(Node); end; -function TAstBinder.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; +function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; begin FNextIsTail := False; - Result := inherited TransformUnaryExpression(Node); + Result := inherited VisitUnaryExpression(Node); end; -function TAstBinder.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; +function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; var i: integer; boundParams: TArray; @@ -370,6 +373,7 @@ var upvalues: TArray; hasNestedLambdas: Boolean; lastNestedLambdaCount: Integer; + boundLambda: ILambdaExpressionNode; begin FUpvalueStack.Push(TUpvalueMapping.Create); try @@ -415,14 +419,16 @@ begin end; inc(FNestedLambdaCount); - Result := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas); + boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas); + Result := TDataValue.FromIntf(boundLambda); end; -function TAstBinder.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; +function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; var isTailCall: Boolean; callee: IAstNode; args: TArray; + boundCall: IFunctionCallNode; begin isTailCall := FIsTailStack.Peek; @@ -430,19 +436,20 @@ begin callee := Accept(Node.Callee).AsIntf; args := TransformNodes(Node.Arguments); - Result := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall); + boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall); + Result := TDataValue.FromIntf(boundCall); end; -function TAstBinder.TransformRecur(const Node: IRecurNode): IRecurNode; +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 TransformRecur(Node); + Result := inherited VisitRecurNode(Node); end; -function TAstBinder.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; +function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; var exprs: TArray; i: Integer; @@ -450,16 +457,16 @@ var begin isContextTail := FIsTailStack.Peek; - SetLength(exprs, Node.Expressions.Count); - for i := 0 to Node.Expressions.Count - 1 do + SetLength(exprs, Length(Node.Expressions)); + for i := 0 to High(exprs) do begin - FNextIsTail := isContextTail and (i = Node.Expressions.Count - 1); + FNextIsTail := isContextTail and (i = High(exprs)); exprs[i] := Accept(Node.Expressions[i]).AsIntf; end; - Result := TAst.Block(exprs); + Result := TDataValue.FromIntf(TAst.Block(exprs)); end; -function TAstBinder.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; +function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; var isContextTail: Boolean; condition, thenBranch, elseBranch: IAstNode; @@ -474,18 +481,18 @@ begin elseBranch := Accept(Node.ElseBranch).AsIntf; if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then - Result := TAst.IfExpr(condition, thenBranch, elseBranch) + Result := TDataValue.FromIntf(TAst.IfExpr(condition, thenBranch, elseBranch)) else - Result := Node; + Result := TDataValue.FromIntf(Node); end; -function TAstBinder.TransformMacroDefinition(const Node: IMacroDefinitionNode): IMacroDefinitionNode; +function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; begin // The binder runs after the macro expander. It should never see a macro definition. raise Exception.Create('IMacroDefinitionNode found in AST after macro expansion phase.'); end; -function TAstBinder.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; +function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; var isContextTail: Boolean; condition, thenBranch, elseBranch: IAstNode; @@ -500,9 +507,9 @@ begin elseBranch := Accept(Node.ElseBranch).AsIntf; if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then - Result := TAst.TernaryExpr(condition, thenBranch, elseBranch) + Result := TDataValue.FromIntf(TAst.TernaryExpr(condition, thenBranch, elseBranch)) else - Result := Node; + Result := TDataValue.FromIntf(Node); end; end. diff --git a/Src/AST/Myc.Ast.Debugger.pas b/Src/AST/Myc.Ast.Debugger.pas index a9450af..0f318c7 100644 --- a/Src/AST/Myc.Ast.Debugger.pas +++ b/Src/AST/Myc.Ast.Debugger.pas @@ -26,7 +26,7 @@ type protected // Overridden to provide the debug-specific visitor factory. - function CreateVisitorFactory: TVisitorFactory; override; + function CreateVisitorFactory: TEvaluatorFactory; override; public constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); @@ -66,13 +66,13 @@ begin ShowScope; end; -function TDebugEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory; +function TDebugEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory; begin // Return a closure that creates a new Debug visitor, using the current context - var callingVisitor := Self as IAstVisitor; + var callingVisitor := Self as IEvaluatorVisitor; Result := - function(const AScope: IExecutionScope): IAstVisitor + function(const AScope: IExecutionScope): IEvaluatorVisitor begin var visitor := callingVisitor as TDebugEvaluatorVisitor; Result := TDebugEvaluatorVisitor.Create(AScope, visitor.FLog, visitor.FShowScope, visitor.FIndentLevel); diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas index 6c989f2..7a4d007 100644 --- a/Src/AST/Myc.Ast.Dumper.pas +++ b/Src/AST/Myc.Ast.Dumper.pas @@ -42,6 +42,9 @@ type function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; + function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override; + function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; + function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; function VisitIndexer(const Node: IIndexerNode): TDataValue; override; function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; @@ -350,6 +353,33 @@ begin Result := TDataValue.Void; end; +function TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; +begin + Log('Quasiquote'); + Indent; + Node.Expression.Accept(Self); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitUnquote(const Node: IUnquoteNode): TDataValue; +begin + Log('Unquote'); + Indent; + Node.Expression.Accept(Self); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; +begin + Log('UnquoteSplicing'); + Indent; + Node.Expression.Accept(Self); + Unindent; + Result := TDataValue.Void; +end; + function TAstDumper.VisitIndexer(const Node: IIndexerNode): TDataValue; begin Log('Indexer'); diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 22db272..8c235b3 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -14,13 +14,13 @@ uses Myc.Ast.Scope; type - // A factory for creating visitors, primarily used by the debugger subsystem. - TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor; - IEvaluatorVisitor = interface(IAstVisitor) function Execute(const RootNode: IAstNode): TDataValue; end; + // A factory for creating visitors, primarily used by the debugger subsystem. + TEvaluatorFactory = reference to function(const Scope: IExecutionScope): IEvaluatorVisitor; + // The standard AST evaluator for production use. TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor) private @@ -36,6 +36,9 @@ type function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; + function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override; + function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; + function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; @@ -50,7 +53,7 @@ type function IsTruthy(const AValue: TDataValue): Boolean; inline; // Returns a closure that can create the correct type of visitor for a lambda's body. - function CreateVisitorFactory: TVisitorFactory; virtual; + function CreateVisitorFactory: TEvaluatorFactory; virtual; property Scope: IExecutionScope read FScope; public @@ -132,10 +135,10 @@ begin HandleTCO(Result); end; -function TEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory; +function TEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory; begin // The production visitor returns a factory that creates another production visitor. - Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end; + Result := function(const AScope: IExecutionScope): IEvaluatorVisitor begin Result := TEvaluatorVisitor.Create(AScope); end; end; procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue); @@ -173,7 +176,7 @@ var i: Integer; sourceAddresses: TArray; closureScope: IExecutionScope; - visitorFactory: TVisitorFactory; + visitorFactory: TEvaluatorFactory; begin // Cast to the bound node to access binder-specific information. boundNode := Node as TBoundLambdaExpressionNode; @@ -249,6 +252,21 @@ begin raise Exception.Create('Macro definitions cannot be evaluated at runtime.'); end; +function TEvaluatorVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; +begin + raise Exception.Create('Quasiquote nodes are a compile-time construct and cannot be evaluated at runtime.'); +end; + +function TEvaluatorVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue; +begin + raise Exception.Create('Unquote nodes are a compile-time construct and cannot be evaluated at runtime.'); +end; + +function TEvaluatorVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; +begin + raise Exception.Create('Unquote-splicing nodes are a compile-time construct and cannot be evaluated at runtime.'); +end; + function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; var calleeValue: TDataValue; diff --git a/Src/AST/Myc.Ast.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index 477258f..6e045a0 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -35,6 +35,9 @@ type function JsonToTernaryExprNode(const AObj: TJSONObject): ITernaryExpressionNode; function JsonToLambdaExprNode(const AObj: TJSONObject): ILambdaExpressionNode; function JsonToMacroDefNode(const AObj: TJSONObject): IMacroDefinitionNode; + function JsonToQuasiquoteNode(const AObj: TJSONObject): IQuasiquoteNode; + function JsonToUnquoteNode(const AObj: TJSONObject): IUnquoteNode; + function JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode; function JsonToFunctionCallNode(const AObj: TJSONObject): IFunctionCallNode; function JsonToRecurNode(const AObj: TJSONObject): IRecurNode; function JsonToBlockNode(const AObj: TJSONObject): IBlockExpressionNode; @@ -55,6 +58,9 @@ type function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; + function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override; + function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; + function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; function VisitRecurNode(const Node: IRecurNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; @@ -295,6 +301,21 @@ begin Result := TDataValue.Void; end; +function TJsonAstConverter.JsonToQuasiquoteNode(const AObj: TJSONObject): IQuasiquoteNode; +begin + Result := TAst.Quasiquote(JsonToNode(AObj.GetValue('Expression'))); +end; + +function TJsonAstConverter.JsonToUnquoteNode(const AObj: TJSONObject): IUnquoteNode; +begin + Result := TAst.Unquote(JsonToNode(AObj.GetValue('Expression'))); +end; + +function TJsonAstConverter.JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode; +begin + Result := TAst.UnquoteSplicing(JsonToNode(AObj.GetValue('Expression'))); +end; + function TJsonAstConverter.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; var obj, calleeObj: TJSONObject; @@ -362,7 +383,7 @@ begin for expr in Node.Expressions do expr.Accept(Self); - SetLength(tempExprs, Node.Expressions.Count); + SetLength(tempExprs, Length(Node.Expressions)); for i := High(tempExprs) downto 0 do tempExprs[i] := FJsonObjectStack.Pop; @@ -646,6 +667,48 @@ begin Result := TAst.MacroDef(name, params, body); end; +function TJsonAstConverter.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; +var + obj, exprObj: TJSONObject; +begin + Node.Expression.Accept(Self); + exprObj := FJsonObjectStack.Pop; + + obj := TJSONObject.Create; + obj.AddPair('NodeType', TJSONString.Create('Quasiquote')); + obj.AddPair('Expression', exprObj); + FJsonObjectStack.Push(obj); + Result := TDataValue.Void; +end; + +function TJsonAstConverter.VisitUnquote(const Node: IUnquoteNode): TDataValue; +var + obj, exprObj: TJSONObject; +begin + Node.Expression.Accept(Self); + exprObj := FJsonObjectStack.Pop; + + obj := TJSONObject.Create; + obj.AddPair('NodeType', TJSONString.Create('Unquote')); + obj.AddPair('Expression', exprObj); + FJsonObjectStack.Push(obj); + Result := TDataValue.Void; +end; + +function TJsonAstConverter.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; +var + obj, exprObj: TJSONObject; +begin + Node.Expression.Accept(Self); + exprObj := FJsonObjectStack.Pop; + + obj := TJSONObject.Create; + obj.AddPair('NodeType', TJSONString.Create('UnquoteSplicing')); + obj.AddPair('Expression', exprObj); + FJsonObjectStack.Push(obj); + Result := TDataValue.Void; +end; + function TJsonAstConverter.JsonToFunctionCallNode(const AObj: TJSONObject): IFunctionCallNode; var callee: IAstNode; @@ -774,6 +837,12 @@ begin Result := JsonToLambdaExprNode(obj) else if nodeType = 'MacroDef' then Result := JsonToMacroDefNode(obj) + else if nodeType = 'Quasiquote' then + Result := JsonToQuasiquoteNode(obj) + else if nodeType = 'Unquote' then + Result := JsonToUnquoteNode(obj) + else if nodeType = 'UnquoteSplicing' then + Result := JsonToUnquoteSplicingNode(obj) else if nodeType = 'FunctionCall' then Result := JsonToFunctionCallNode(obj) else if nodeType = 'Recur' then diff --git a/Src/AST/Myc.Ast.MacroExpander.pas b/Src/AST/Myc.Ast.MacroExpander.pas new file mode 100644 index 0000000..8a34aeb --- /dev/null +++ b/Src/AST/Myc.Ast.MacroExpander.pas @@ -0,0 +1,269 @@ +unit Myc.Ast.MacroExpander; + +interface + +uses + System.SysUtils, + System.Classes, + System.Generics.Collections, + Myc.Data.Value, + Myc.Ast.Nodes, + Myc.Ast.Scope, + Myc.Ast.Visitor; + +type + // Defines the strategy for compiling and evaluating an AST node at compile time. + TCompileTimeExecutor = reference to function(const ANode: IAstNode): TDataValue; + + IMacroExpander = interface(IAstVisitor) + function Execute(const RootNode: IAstNode): IAstNode; + end; + + // The macro expander is now a pure AST transformation engine. + TMacroExpander = class(TAstTransformer, IMacroExpander) + private + FMacros: TDictionary; + FExecutor: TCompileTimeExecutor; + function ExpandNode(const ANode: IAstNode): IAstNode; + protected + function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + public + constructor Create(const AExecutor: TCompileTimeExecutor); + destructor Destroy; override; + function Execute(const RootNode: IAstNode): IAstNode; + end; + +implementation + +uses + Myc.Ast; + +type + TExpansionHelper = class(TAstTransformer) + private + FExpansionScope: IExecutionScope; + FExpander: TMacroExpander; + FExecutor: TCompileTimeExecutor; + 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(AExpansionScope: IExecutionScope; AExpander: TMacroExpander; AExecutor: TCompileTimeExecutor); + class function Expand( + Node: IAstNode; + ExpansionScope: IExecutionScope; + Expander: TMacroExpander; + Executor: TCompileTimeExecutor + ): IAstNode; static; + end; + + TSubstitutor = class(TAstTransformer) + private + FParamScope: IExecutionScope; + protected + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; + public + constructor Create(AParamScope: IExecutionScope); + end; + +{ TMacroExpander } + +constructor TMacroExpander.Create(const AExecutor: TCompileTimeExecutor); +begin + inherited Create; + Assert(Assigned(AExecutor), 'A TCompileTimeExecutor must be provided.'); + FMacros := TDictionary.Create; + FExecutor := AExecutor; +end; + +destructor TMacroExpander.Destroy; +begin + FMacros.Free; + inherited; +end; + +function TMacroExpander.ExpandNode(const ANode: IAstNode): IAstNode; +var + lastNode: IAstNode; +begin + Result := ANode; + if not Assigned(Result) then + exit; + repeat + lastNode := Result; + Result := Self.Accept(lastNode).AsIntf; + until Result = lastNode; +end; + +function TMacroExpander.Execute(const RootNode: IAstNode): IAstNode; +begin + FMacros.Clear; + Result := ExpandNode(RootNode); +end; + +function TMacroExpander.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; +var + macroDef: IMacroDefinitionNode; + expandedNode: IAstNode; + i: Integer; +begin + if not (Node.Callee is TIdentifierNode) then + begin + Result := inherited VisitFunctionCall(Node); + exit; + end; + + var calleeIdentifier := Node.Callee as TIdentifierNode; + + if FMacros.TryGetValue(calleeIdentifier.Name, macroDef) then + begin + var expansionScope := TAst.CreateScope(nil); // Temporary scope for parameters, no parent needed. + + if Length(Node.Arguments) <> Length(macroDef.Parameters) then + raise Exception.CreateFmt( + 'Macro %s expects %d arguments, but got %d', + [macroDef.Name.Name, Length(macroDef.Parameters), Length(Node.Arguments)]); + + for i := 0 to High(macroDef.Parameters) do + expansionScope.Define(macroDef.Parameters[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.', [macroDef.Name.Name]); + + expandedNode := TExpansionHelper.Expand(IQuasiquoteNode(macroDef.Body).Expression, expansionScope, Self, FExecutor); + + Result := Self.Accept(expandedNode); + end + else + begin + Result := inherited VisitFunctionCall(Node); + end; +end; + +function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; +begin + FMacros.AddOrSetValue(Node.Name.Name, Node); + Result := TDataValue.FromIntf(TBlockExpressionNode.Create([])); +end; + +{ TExpansionHelper } + +constructor TExpansionHelper.Create(AExpansionScope: IExecutionScope; AExpander: TMacroExpander; AExecutor: TCompileTimeExecutor); +begin + inherited Create; + FExpansionScope := AExpansionScope; + FExpander := AExpander; + FExecutor := AExecutor; +end; + +class function TExpansionHelper.Expand( + Node: IAstNode; + ExpansionScope: IExecutionScope; + Expander: TMacroExpander; + Executor: TCompileTimeExecutor +): IAstNode; +var + helper: TExpansionHelper; +begin + helper := TExpansionHelper.Create(ExpansionScope, Expander, Executor); + try + Result := helper.Accept(Node).AsIntf; + finally + helper.Free; + end; +end; + +function TExpansionHelper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; +var + newArgs: TList; + transformedArgValue: TDataValue; + transformedArgNode: IAstNode; + transformedCallee: IAstNode; +begin + newArgs := TList.Create; + try + for var arg in Node.Arguments do + begin + transformedArgValue := Self.Accept(arg); + if transformedArgValue.IsVoid then + continue; + transformedArgNode := transformedArgValue.AsIntf; + if (transformedArgNode is TBlockExpressionNode) then + newArgs.AddRange((transformedArgNode as TBlockExpressionNode).Expressions) + else + newArgs.Add(transformedArgNode); + end; + transformedCallee := Self.Accept(Node.Callee).AsIntf; + Result := TDataValue.FromIntf(TAst.FunctionCall(transformedCallee, newArgs.ToArray)); + finally + newArgs.Free; + end; +end; + +function TExpansionHelper.VisitUnquote(const Node: IUnquoteNode): TDataValue; +var + substitutor: TSubstitutor; + substitutedAst, expandedAst: IAstNode; + value: TDataValue; +begin + // Step 1: Substitute macro parameters with their AST node values. + substitutor := TSubstitutor.Create(FExpansionScope); + try + substitutedAst := substitutor.Execute(Node.Expression); + finally + substitutor.Free; + end; + + // Step 2: Recursively expand any macros within the substituted expression. + expandedAst := FExpander.ExpandNode(substitutedAst); + + // Step 3: Call the injected executor strategy to bind and evaluate the AST. + value := FExecutor(expandedAst); + + // Step 4: Wrap the resulting value for insertion into the template. + if value.Kind in [vkScalar, vkText] then + Result := TDataValue.FromIntf(TAst.Constant(value)) + else + Result := value; +end; + +function TExpansionHelper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; +var + unquotedValue: TDataValue; + unquotedNode: IAstNode; +begin + unquotedValue := Self.VisitUnquote(TAst.Unquote(Node.Expression)); + if unquotedValue.Kind = vkInterface then + unquotedNode := unquotedValue.AsIntf + else + unquotedNode := nil; + if not (unquotedNode is TBlockExpressionNode) then + raise Exception.Create('Expression inside unquote-splicing (`~@`) must evaluate to a list of nodes (a block).'); + Result := unquotedValue; +end; + +{ TSubstitutor } +constructor TSubstitutor.Create(AParamScope: IExecutionScope); +begin + inherited Create; + FParamScope := AParamScope; +end; + +function TSubstitutor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; +var + addr: TResolvedAddress; + nodeValue: TDataValue; +begin + addr := FParamScope.CreateDescriptor.FindSymbol(Node.Name); + if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then + begin + nodeValue := FParamScope.Values[addr]; + Result := nodeValue; + exit; + end; + Result := inherited VisitIdentifier(Node); +end; + +end. diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 1a56ec2..e96f439 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -162,9 +162,9 @@ type IBlockExpressionNode = interface(IAstNode) {$region 'private'} - function GetExpressions: TList; + function GetExpressions: TArray; {$endregion} - property Expressions: TList read GetExpressions; + property Expressions: TArray read GetExpressions; end; IVariableDeclarationNode = interface(IAstNode) diff --git a/Src/AST/Myc.Ast.Script.pas b/Src/AST/Myc.Ast.Script.pas index 557062c..430595d 100644 --- a/Src/AST/Myc.Ast.Script.pas +++ b/Src/AST/Myc.Ast.Script.pas @@ -386,11 +386,11 @@ begin // (defmacro name [params] body) if (Length(tailNodes) <> 3) or (tailTokens[0].Kind <> tkIdentifier) then raise Exception.Create('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.'); - if elements[1].Node <> nil then + if elements[2].Params = nil then raise Exception.Create('Syntax Error: Expected a parameter list [...] after macro name.'); var macroName := IIdentifierNode(tailNodes[0]); - var macroParams := elements[1].Params; + var macroParams := elements[2].Params; var macroBody := tailNodes[2]; Result := TAst.MacroDef(macroName, macroParams, macroBody); @@ -405,7 +405,7 @@ begin begin if Length(tailNodes) <> 2 then raise Exception.Create('Syntax Error: ''fn'' requires a parameter list and a body.'); - if elements[1].Node <> nil then + if elements[1].Params = nil then raise Exception.Create('Syntax Error: Expected a parameter list [...] after ''fn''.'); Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1]); end diff --git a/Src/AST/Myc.Ast.Visitor.pas b/Src/AST/Myc.Ast.Visitor.pas index bbc2cda..dc2ba36 100644 --- a/Src/AST/Myc.Ast.Visitor.pas +++ b/Src/AST/Myc.Ast.Visitor.pas @@ -41,59 +41,34 @@ type end; // A base visitor that walks the AST and rebuilds it node by node. - // This class uses the Template Method pattern: - // - The Visit... methods are the template and should not be overridden. - // - The virtual Transform... methods are the hooks for derived classes to customize behavior. + // Derived classes can override the virtual Visit... methods to customize behavior. TAstTransformer = class abstract(TAstVisitor, IAstTransformer) private FDone: Boolean; protected - // Final Visit methods - these should not be overridden. They call the virtual Transform methods. - function VisitConstant(const Node: IConstantNode): TDataValue; override; final; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; final; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; final; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; final; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; final; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; final; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; final; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; final; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; final; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; final; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; final; - function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; final; - function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override; final; - function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; final; - function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; final; - function VisitIndexer(const Node: IIndexerNode): TDataValue; override; final; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; final; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; final; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; final; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; final; - function VisitRecurNode(const Node: IRecurNode): TDataValue; override; final; - - // Dispatch methods for each node type. Derived classes override these to change the transformation. - function TransformConstant(const Node: IConstantNode): IConstantNode; virtual; - function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; virtual; - function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; virtual; - function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; virtual; - function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; virtual; - function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; virtual; - function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; virtual; - function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; virtual; - function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; virtual; - function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; virtual; - function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; virtual; - function TransformMacroDefinition(const Node: IMacroDefinitionNode): IMacroDefinitionNode; virtual; - function TransformQuasiquote(const Node: IQuasiquoteNode): IQuasiquoteNode; virtual; - function TransformUnquote(const Node: IUnquoteNode): IUnquoteNode; virtual; - function TransformUnquoteSplicing(const Node: IUnquoteSplicingNode): IUnquoteSplicingNode; virtual; - function TransformIndexer(const Node: IIndexerNode): IIndexerNode; virtual; - function TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode; virtual; - function TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode; virtual; - function TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode; virtual; - function TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode; virtual; - function TransformRecur(const Node: IRecurNode): IRecurNode; virtual; + // These virtual methods implement the default identity-transformation (cloning) behavior. + function VisitConstant(const Node: IConstantNode): TDataValue; override; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; + function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; + function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override; + function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; + function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; + function VisitIndexer(const Node: IIndexerNode): TDataValue; override; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; + function VisitRecurNode(const Node: IRecurNode): TDataValue; override; // Helper to transform an array of nodes. function TransformNodes(const Nodes: TArray): TArray; @@ -106,11 +81,8 @@ type function Execute(const RootNode: IAstNode): IAstNode; end; - // TAstTraverser simply inherits the identity-transform (cloning) behavior from TAstTransformer. - TAstTraverser = class(TAstTransformer); - // Generic traverser for managing state during AST walks. - TAstTraverser = class(TAstTraverser) + TAstTraverser = class(TAstTransformer) private FData: TStack; protected @@ -141,202 +113,210 @@ begin Result := Accept(RootNode).AsIntf; end; -// --- Default implementations for Transform... methods (Identity Transformation / Cloning) --- - -function TAstTransformer.TransformConstant(const Node: IConstantNode): IConstantNode; +function TAstTransformer.VisitConstant(const Node: IConstantNode): TDataValue; begin // The node itself is immutable, return it directly. - Result := Node; + Result := TDataValue.FromIntf(Node); end; -function TAstTransformer.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; +function TAstTransformer.VisitIdentifier(const Node: IIdentifierNode): TDataValue; begin - Result := Node; + Result := TDataValue.FromIntf(Node); end; -function TAstTransformer.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; +function TAstTransformer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; begin var left := Accept(Node.Left).AsIntf; var right := Accept(Node.Right).AsIntf; if (left = Node.Left) and (right = Node.Right) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.BinaryExpr(left, Node.Operator, right); + Result := TDataValue.FromIntf(TAst.BinaryExpr(left, Node.Operator, right)); end; -function TAstTransformer.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; +function TAstTransformer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; begin var right := Accept(Node.Right).AsIntf; if right = Node.Right then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.UnaryExpr(Node.Operator, right); + Result := TDataValue.FromIntf(TAst.UnaryExpr(Node.Operator, right)); end; -function TAstTransformer.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; +function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; begin var condition := Accept(Node.Condition).AsIntf; var thenBranch := Accept(Node.ThenBranch).AsIntf; var elseBranch := Accept(Node.ElseBranch).AsIntf; if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.IfExpr(condition, thenBranch, elseBranch); + Result := TDataValue.FromIntf(TAst.IfExpr(condition, thenBranch, elseBranch)); end; -function TAstTransformer.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; +function TAstTransformer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; begin var condition := Accept(Node.Condition).AsIntf; var thenBranch := Accept(Node.ThenBranch).AsIntf; var elseBranch := Accept(Node.ElseBranch).AsIntf; if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.TernaryExpr(condition, thenBranch, elseBranch); + Result := TDataValue.FromIntf(TAst.TernaryExpr(condition, thenBranch, elseBranch)); end; -function TAstTransformer.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; +function TAstTransformer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; begin var parameters := TransformNodes(Node.Parameters); var body := Accept(Node.Body).AsIntf; if (parameters = Node.Parameters) and (body = Node.Body) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.LambdaExpr(parameters, body); + Result := TDataValue.FromIntf(TAst.LambdaExpr(parameters, body)); end; -function TAstTransformer.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; +function TAstTransformer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; begin var callee := Accept(Node.Callee).AsIntf; var args := TransformNodes(Node.Arguments); if (callee = Node.Callee) and (args = Node.Arguments) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.FunctionCall(callee, args); + Result := TDataValue.FromIntf(TAst.FunctionCall(callee, args)); end; -function TAstTransformer.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; +function TAstTransformer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; +var + expressions: TArray; + i: Integer; + hasChanged: Boolean; begin - // TList is mutable, so we always transform. - var exprs: TArray; - var i: Integer; - SetLength(exprs, Node.Expressions.Count); - for i := 0 to Node.Expressions.Count - 1 do - exprs[i] := Accept(Node.Expressions[i]).AsIntf; - Result := TAst.Block(exprs); + // Check if any child expression has changed before creating a new node. + hasChanged := false; + SetLength(expressions, Length(Node.Expressions)); + for i := 0 to High(Node.Expressions) do + begin + expressions[i] := Accept(Node.Expressions[i]).AsIntf; + if expressions[i] <> Node.Expressions[i] then + hasChanged := true; + end; + + if hasChanged then + Result := TDataValue.FromIntf(TAst.Block(expressions)) + else + Result := TDataValue.FromIntf(Node); end; -function TAstTransformer.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; +function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; begin var identifier := Accept(Node.Identifier).AsIntf; var initializer := Accept(Node.Initializer).AsIntf; if (identifier = Node.Identifier) and (initializer = Node.Initializer) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.VarDecl(identifier, initializer); + Result := TDataValue.FromIntf(TAst.VarDecl(identifier, initializer)); end; -function TAstTransformer.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; +function TAstTransformer.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin var identifier := Accept(Node.Identifier).AsIntf; var value := Accept(Node.Value).AsIntf; if (identifier = Node.Identifier) and (value = Node.Value) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.Assign(identifier, value); + Result := TDataValue.FromIntf(TAst.Assign(identifier, value)); end; -function TAstTransformer.TransformMacroDefinition(const Node: IMacroDefinitionNode): IMacroDefinitionNode; +function TAstTransformer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; begin - // Added identity transform for macro definitions. var name := Accept(Node.Name).AsIntf; var parameters := TransformNodes(Node.Parameters); var body := Accept(Node.Body).AsIntf; if (name = Node.Name) and (parameters = Node.Parameters) and (body = Node.Body) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.MacroDef(name, parameters, body); + Result := TDataValue.FromIntf(TAst.MacroDef(name, parameters, body)); end; -function TAstTransformer.TransformQuasiquote(const Node: IQuasiquoteNode): IQuasiquoteNode; +function TAstTransformer.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; begin var expr := Accept(Node.Expression).AsIntf; if expr = Node.Expression then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.Quasiquote(expr); + Result := TDataValue.FromIntf(TAst.Quasiquote(expr)); end; -function TAstTransformer.TransformUnquote(const Node: IUnquoteNode): IUnquoteNode; +function TAstTransformer.VisitUnquote(const Node: IUnquoteNode): TDataValue; begin var expr := Accept(Node.Expression).AsIntf; if expr = Node.Expression then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.Unquote(expr); + Result := TDataValue.FromIntf(TAst.Unquote(expr)); end; -function TAstTransformer.TransformUnquoteSplicing(const Node: IUnquoteSplicingNode): IUnquoteSplicingNode; +function TAstTransformer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; begin var expr := Accept(Node.Expression).AsIntf; if expr = Node.Expression then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.UnquoteSplicing(expr); + Result := TDataValue.FromIntf(TAst.UnquoteSplicing(expr)); end; -function TAstTransformer.TransformIndexer(const Node: IIndexerNode): IIndexerNode; +function TAstTransformer.VisitIndexer(const Node: IIndexerNode): TDataValue; begin var base := Accept(Node.Base).AsIntf; var index := Accept(Node.Index).AsIntf; if (base = Node.Base) and (index = Node.Index) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.Indexer(base, index); + Result := TDataValue.FromIntf(TAst.Indexer(base, index)); end; -function TAstTransformer.TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode; +function TAstTransformer.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; begin var base := Accept(Node.Base).AsIntf; var member := Node.Member; if (base = Node.Base) and (member = Node.Member) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.MemberAccess(base, member); + Result := TDataValue.FromIntf(TAst.MemberAccess(base, member)); end; -function TAstTransformer.TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode; +function TAstTransformer.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; begin - Result := Node; + Result := TDataValue.FromIntf(Node); end; -function TAstTransformer.TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode; +function TAstTransformer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; begin var series := Accept(Node.Series).AsIntf; var value := Accept(Node.Value).AsIntf; var lookback := Accept(Node.Lookback).AsIntf; if (series = Node.Series) and (value = Node.Value) and (lookback = Node.Lookback) then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.AddSeriesItem(series, value, lookback); + Result := TDataValue.FromIntf(TAst.AddSeriesItem(series, value, lookback)); end; -function TAstTransformer.TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode; +function TAstTransformer.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; begin var series := Accept(Node.Series).AsIntf; if series = Node.Series then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.SeriesLength(series); + Result := TDataValue.FromIntf(TAst.SeriesLength(series)); end; -function TAstTransformer.TransformRecur(const Node: IRecurNode): IRecurNode; +function TAstTransformer.VisitRecurNode(const Node: IRecurNode): TDataValue; begin var args := TransformNodes(Node.Arguments); if args = Node.Arguments then - Result := Node + Result := TDataValue.FromIntf(Node) else - Result := TAst.Recur(args); + Result := TDataValue.FromIntf(TAst.Recur(args)); end; function TAstTransformer.TransformNodes(const Nodes: TArray): TArray; @@ -356,111 +336,6 @@ begin Result := Nodes; end; -function TAstTransformer.VisitConstant(const Node: IConstantNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformConstant(Node)); -end; - -function TAstTransformer.VisitIdentifier(const Node: IIdentifierNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformIdentifier(Node)); -end; - -function TAstTransformer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformBinaryExpression(Node)); -end; - -function TAstTransformer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformUnaryExpression(Node)); -end; - -function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformIfExpression(Node)); -end; - -function TAstTransformer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformTernaryExpression(Node)); -end; - -function TAstTransformer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformLambdaExpression(Node)); -end; - -function TAstTransformer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformFunctionCall(Node)); -end; - -function TAstTransformer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformBlockExpression(Node)); -end; - -function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformVariableDeclaration(Node)); -end; - -function TAstTransformer.VisitAssignment(const Node: IAssignmentNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformAssignment(Node)); -end; - -function TAstTransformer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformMacroDefinition(Node)); -end; - -function TAstTransformer.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformQuasiquote(Node)); -end; - -function TAstTransformer.VisitUnquote(const Node: IUnquoteNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformUnquote(Node)); -end; - -function TAstTransformer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformUnquoteSplicing(Node)); -end; - -function TAstTransformer.VisitIndexer(const Node: IIndexerNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformIndexer(Node)); -end; - -function TAstTransformer.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformMemberAccess(Node)); -end; - -function TAstTransformer.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformCreateSeries(Node)); -end; - -function TAstTransformer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformAddSeriesItem(Node)); -end; - -function TAstTransformer.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformSeriesLength(Node)); -end; - -function TAstTransformer.VisitRecurNode(const Node: IRecurNode): TDataValue; -begin - Result := TDataValue.FromIntf(TransformRecur(Node)); -end; - { TAstTraverser } constructor TAstTraverser.Create; diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 9189cb0..ab0aef7 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -211,13 +211,12 @@ type TBlockExpressionNode = class(TAstNode, IBlockExpressionNode) private - FExpressions: TList; - function GetExpressions: TList; + FExpressions: TArray; + function GetExpressions: TArray; public constructor Create(const AExpressions: array of IAstNode); - destructor Destroy; override; function Accept(const Visitor: IAstVisitor): TDataValue; override; - property Expressions: TList read FExpressions; + property Expressions: TArray read FExpressions; end; TVariableDeclarationNode = class(TAstNode, IVariableDeclarationNode) @@ -605,19 +604,10 @@ end; { TBlockExpressionNode } constructor TBlockExpressionNode.Create(const AExpressions: array of IAstNode); -var - expr: IAstNode; begin inherited Create; - FExpressions := TList.Create; - for expr in AExpressions do - FExpressions.Add(expr); -end; - -destructor TBlockExpressionNode.Destroy; -begin - FExpressions.Free; - inherited; + SetLength(FExpressions, Length(AExpressions)); + TArray.Copy(AExpressions, FExpressions, 0, 0, Length(AExpressions)); end; function TBlockExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; @@ -625,7 +615,7 @@ begin Result := Visitor.VisitBlockExpression(Self); end; -function TBlockExpressionNode.GetExpressions: TList; +function TBlockExpressionNode.GetExpressions: TArray; begin Result := FExpressions; end;