From 54bf350c7086d31cb352619e3e287bed9c18023c Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 4 Oct 2025 22:41:01 +0200 Subject: [PATCH] Macro expander integrated in binder --- ASTPlayground/MainForm.pas | 19 +++- ASTPlayground/Myc.Fmx.AstEditor.Text.pas | 9 ++ ASTPlayground/Myc.Fmx.AstEditor.pas | 49 +++++++- ASTPlayground/UserLib.json | 118 +++++++++++++++++++ Src/AST/Myc.Ast.Binding.pas | 54 +++++++-- Src/AST/Myc.Ast.Dumper.pas | 28 +++++ Src/AST/Myc.Ast.Evaluator.pas | 8 ++ Src/AST/Myc.Ast.JSON.pas | 138 +++++++++++++++++------ Src/AST/Myc.Ast.Nodes.pas | 11 ++ Src/AST/Myc.Ast.Script.pas | 55 +++++---- Src/AST/Myc.Ast.Visitor.pas | 27 +++++ Src/AST/Myc.Ast.pas | 37 ++++++ 12 files changed, 480 insertions(+), 73 deletions(-) diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 95fb36e..c3d40eb 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -224,7 +224,7 @@ begin boundAst := binder.Execute(ANode, descriptor); // Store the final bound AST for visualization and debugging. - FCurrAst := ANode; + FCurrAst := boundAst; FCurrDesc := descriptor; // Step 2: Create the final scope and evaluator for runtime execution. @@ -393,6 +393,13 @@ begin begin var decl := expr as TVariableDeclarationNode; definitions.Add(decl.Identifier.Name, decl.Initializer); + end + // Handle macro definitions inside the block + else if expr is TMacroDefinitionNode then + begin + var macroDef := expr as TMacroDefinitionNode; + // Store the entire macro definition node for serialization. + definitions.Add(macroDef.Name.Name, macroDef); end; end; end @@ -400,11 +407,17 @@ begin begin var decl := rootNode as TVariableDeclarationNode; definitions.Add(decl.Identifier.Name, decl.Initializer); + end + // Handle a single macro definition + else if rootNode is TMacroDefinitionNode then + begin + var macroDef := rootNode as TMacroDefinitionNode; + definitions.Add(macroDef.Name.Name, macroDef); end; if definitions.Count = 0 then begin - Memo1.Lines.Add('No top-level "(def ...)" definitions found in the script to save.'); + Memo1.Lines.Add('No top-level "(def ...)" or "(defmacro ...)" definitions found in the script to save.'); exit; end; @@ -428,7 +441,7 @@ begin for var pair in definitions do begin - // Track if we are adding or updating a function + // Track if we are adding or updating a function/macro if jsonLib.Values[pair.Key] <> nil then begin Inc(updatedCount); diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas index 3c16c24..4fec989 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas @@ -22,6 +22,7 @@ type function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; @@ -104,6 +105,14 @@ begin end; end; +function TAstToTextVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +begin + // To represent a macro expansion as a single line of text, the most + // informative representation is the original call itself. We can simply + // delegate to the VisitFunctionCall implementation to format it. + Result := VisitFunctionCall(Node); +end; + function TAstToTextVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; var i: Integer; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.pas b/ASTPlayground/Myc.Fmx.AstEditor.pas index 84ab62d..7d827f3 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.pas @@ -111,6 +111,7 @@ type function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; @@ -573,6 +574,52 @@ begin Result := TDataValue.Void; end; +function TAstToAuraNodeVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +begin + // Visualize the macro expansion as a single, opaque node. + // The original macro arguments are visited and wired up as inputs to this new node. + // The expanded body is deliberately NOT visited to hide the complexity. + VisitOperatorNode( + Node.Arguments, // Use original arguments as inputs + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + macroNode: TAuraNode; + calleeStr: string; + argPins: TArray; + i: Integer; + outPin: TControl; + begin + // Get the name of the macro that was called. + if (Node.Callee is TBoundIdentifierNode) then + calleeStr := (Node.Callee as TBoundIdentifierNode).Name + else + calleeStr := '(...)'; // Fallback for complex callee expressions + + macroNode := BuildNodeControl('Macro Expansion', calleeStr); + // Give it a distinct color to make it stand out in the graph. + macroNode.Canvas.Fill.Color := TAlphaColors.Darkslateblue; + + // Create input pins for the original arguments. + SetLength(argPins, Length(Node.Arguments)); + for i := 0 to High(argPins) do + argPins[i] := CreateInput(macroNode, 'Arg' + i.ToString); + + // Create a single data output pin for the result of the expansion. + outPin := CreateOutput(macroNode); + + // Connect the argument nodes to the input pins. + for i := 0 to High(Node.Arguments) do + if Assigned(InputResults[i].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[i].OutputPin, argPins[i])); + + FinalizeNodeLayout(macroNode); + Result.LayoutNode := macroNode; + Result.OutputPin := outPin; + end + ); + Result := TDataValue.Void; +end; + function TAstToAuraNodeVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; var details: string; @@ -1161,7 +1208,7 @@ var maxRight, maxBottom: Single; control: TControl; childLastResult: TAuraNodeResult; - entryNode, exitNode: TAuraNode; + exitNode: TAuraNode; paramDescriptor: IScopeDescriptor; begin // Create a string representation of the parameters for the node title. diff --git a/ASTPlayground/UserLib.json b/ASTPlayground/UserLib.json index 17812f9..03e1987 100644 --- a/ASTPlayground/UserLib.json +++ b/ASTPlayground/UserLib.json @@ -81,5 +81,123 @@ "Name": "c" } } + }, + "repeat": { + "NodeType": "MacroDef", + "Name": { + "NodeType": "Identifier", + "Name": "repeat" + }, + "Parameters": [ + { + "NodeType": "Identifier", + "Name": "n" + }, + { + "NodeType": "Identifier", + "Name": "body" + } + ], + "Body": { + "NodeType": "Quasiquote", + "Expression": { + "NodeType": "Block", + "Expressions": [ + { + "NodeType": "VarDecl", + "Identifier": { + "NodeType": "Identifier", + "Name": "loop" + }, + "Initializer": { + "NodeType": "LambdaExpr", + "Parameters": [ + { + "NodeType": "Identifier", + "Name": "counter" + } + ], + "Body": { + "NodeType": "IfExpr", + "Condition": { + "NodeType": "BinaryExpr", + "Operator": ">", + "Left": { + "NodeType": "Identifier", + "Name": "counter" + }, + "Right": { + "NodeType": "Constant", + "Value": { + "Kind": "Scalar", + "Value": { + "Kind": "Ordinal", + "Value": 0 + } + } + } + }, + "ThenBranch": { + "NodeType": "Block", + "Expressions": [ + { + "NodeType": "Unquote", + "Expression": { + "NodeType": "Identifier", + "Name": "body" + } + }, + { + "NodeType": "Recur", + "Arguments": [ + { + "NodeType": "BinaryExpr", + "Operator": "-", + "Left": { + "NodeType": "Identifier", + "Name": "counter" + }, + "Right": { + "NodeType": "Constant", + "Value": { + "Kind": "Scalar", + "Value": { + "Kind": "Ordinal", + "Value": 1 + } + } + } + } + ] + } + ] + }, + "ElseBranch": { + "NodeType": "Block", + "Expressions": [ + ] + } + } + } + }, + { + "NodeType": "FunctionCall", + "Callee": { + "NodeType": "Identifier", + "Name": "loop" + }, + "Arguments": [ + { + "NodeType": "Unquote", + "Expression": { + "NodeType": "Identifier", + "Name": "n" + } + } + ] + } + ] + } + } } } \ No newline at end of file diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 22dfd8f..0103ac7 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -68,6 +68,7 @@ type function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; function VisitRecurNode(const Node: IRecurNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; @@ -386,13 +387,15 @@ begin try EnterScope; try - var transformedNode := Accept(RootNode).AsIntf; + var transformedValue := Accept(RootNode); - // 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 + // Handle the case where the entire script was just declarations. + if transformedValue.IsVoid then + // Return a valid, empty AST. Result := TAst.Block([]) else - Result := transformedNode; + // The script produced a valid, executable AST. + Result := transformedValue.AsIntf; Descriptor := FCurrentDescriptor; finally @@ -409,8 +412,8 @@ begin 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(TAst.Block([])); + // that is simply ignored by the evaluator and safely handled by all visitors. + Result := TDataValue.Void; end; function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; @@ -480,9 +483,14 @@ begin 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); + // Bind the newly generated AST fragment. + var boundExpandedBody := Self.Accept(expandedBody).AsIntf; + + // Wrap the result in a TMacroExpansionNode. + // The original 'Node' is passed to preserve the call site information for tools. + var macroNode := TMacroExpansionNode.Create(Node, boundExpandedBody); + + Result := TDataValue.FromIntf(macroNode); exit; end; end; @@ -498,6 +506,32 @@ begin Result := TDataValue.FromIntf(boundCall); end; +function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +var + boundCallee: IAstNode; + boundArgs: TArray; + boundExpandedBody: IAstNode; + boundOriginalCall: IFunctionCallNode; +begin + // This handles the case where a macro expansion node is injected into the + // tree before binding. The binder must recursively bind its contents. + + // 1. Bind the components of the original call site. + boundCallee := Accept(Node.Callee).AsIntf; + boundArgs := TransformNodes(Node.Arguments); + + // 2. Bind the expanded body. + boundExpandedBody := Accept(Node.ExpandedBody).AsIntf; + + // 3. Re-create the IFunctionCallNode part of the original call with bound children. + boundOriginalCall := TAst.FunctionCall(boundCallee, boundArgs); + + // 4. Create a new TMacroExpansionNode that wraps the now-bound components. + var newMacroNode := TMacroExpansionNode.Create(boundOriginalCall, boundExpandedBody); + + Result := TDataValue.FromIntf(newMacroNode); +end; + procedure TAstBinder.ExitScope; begin FCurrentDescriptor := FCurrentDescriptor.Parent; @@ -549,7 +583,7 @@ begin 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 a sub-expression (like a macro definition) returns a void value, skip it. if not transformedValue.IsVoid then exprList.Add(transformedValue.AsIntf); end; diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas index 7a4d007..e7a63e2 100644 --- a/Src/AST/Myc.Ast.Dumper.pas +++ b/Src/AST/Myc.Ast.Dumper.pas @@ -37,6 +37,7 @@ type function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; function VisitRecurNode(const Node: IRecurNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; @@ -269,6 +270,33 @@ begin Result := TDataValue.Void; end; +function TAstDumper.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +var + arg: IAstNode; +begin + Log('MacroExpansion'); + Indent; + + Log('Original Call:'); + Indent; + Log('Callee:'); + Node.Callee.Accept(Self); + LogFmt('Arguments (%d):', [Length(Node.Arguments)]); + Indent; + for arg in Node.Arguments do + arg.Accept(Self); + Unindent; + Unindent; + + Log('Expanded Body:'); + Indent; + Node.ExpandedBody.Accept(Self); + Unindent; + + Unindent; + Result := TDataValue.Void; +end; + function TAstDumper.VisitRecurNode(const Node: IRecurNode): TDataValue; var arg: IAstNode; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index fda7da0..5541f1e 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -33,6 +33,7 @@ type function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; @@ -289,6 +290,13 @@ begin end; end; +function TEvaluatorVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +begin + // The evaluator simply "unwraps" the macro expansion node + // and executes the expanded body it contains. + Result := Node.ExpandedBody.Accept(Self); +end; + function TEvaluatorVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; var argValues: TArray; diff --git a/Src/AST/Myc.Ast.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index 6e045a0..055a7a6 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -39,6 +39,7 @@ type function JsonToUnquoteNode(const AObj: TJSONObject): IUnquoteNode; function JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode; function JsonToFunctionCallNode(const AObj: TJSONObject): IFunctionCallNode; + function JsonToMacroExpansionNode(const AObj: TJSONObject): IMacroExpansionNode; function JsonToRecurNode(const AObj: TJSONObject): IRecurNode; function JsonToBlockNode(const AObj: TJSONObject): IBlockExpressionNode; function JsonToVarDeclNode(const AObj: TJSONObject): IVariableDeclarationNode; @@ -62,6 +63,7 @@ type function VisitUnquote(const Node: IUnquoteNode): TDataValue; override; function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; function VisitRecurNode(const Node: IRecurNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; @@ -301,19 +303,46 @@ begin Result := TDataValue.Void; end; -function TJsonAstConverter.JsonToQuasiquoteNode(const AObj: TJSONObject): IQuasiquoteNode; +function TJsonAstConverter.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; +var + obj, exprObj: TJSONObject; begin - Result := TAst.Quasiquote(JsonToNode(AObj.GetValue('Expression'))); + 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.JsonToUnquoteNode(const AObj: TJSONObject): IUnquoteNode; +function TJsonAstConverter.VisitUnquote(const Node: IUnquoteNode): TDataValue; +var + obj, exprObj: TJSONObject; begin - Result := TAst.Unquote(JsonToNode(AObj.GetValue('Expression'))); + 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.JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode; +function TJsonAstConverter.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; +var + obj, exprObj: TJSONObject; begin - Result := TAst.UnquoteSplicing(JsonToNode(AObj.GetValue('Expression'))); + 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.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; @@ -346,6 +375,45 @@ begin Result := TDataValue.Void; end; +function TJsonAstConverter.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +var + obj, calleeObj, bodyObj: TJSONObject; + argsArray: TJSONArray; + tempArgs: TArray; + arg: IAstNode; + i: Integer; +begin + // Serialize all children first: Callee, Arguments, and the new ExpandedBody + Node.Callee.Accept(Self); + for arg in Node.Arguments do + arg.Accept(Self); + Node.ExpandedBody.Accept(Self); + + // Pop children's JSON from stack in reverse order of visitation + bodyObj := FJsonObjectStack.Pop; + + SetLength(tempArgs, Length(Node.Arguments)); + for i := High(tempArgs) downto 0 do + tempArgs[i] := FJsonObjectStack.Pop; + + calleeObj := FJsonObjectStack.Pop; + + // Build JSON array for arguments + argsArray := TJSONArray.Create; + for var argObj in tempArgs do + argsArray.Add(argObj); + + // Create the final JSON object for this node + obj := TJSONObject.Create; + obj.AddPair('NodeType', TJSONString.Create('MacroExpansion')); + obj.AddPair('Callee', calleeObj); + obj.AddPair('Arguments', argsArray); + obj.AddPair('ExpandedBody', bodyObj); + + FJsonObjectStack.Push(obj); + Result := TDataValue.Void; +end; + function TJsonAstConverter.VisitRecurNode(const Node: IRecurNode): TDataValue; var obj: TJSONObject; @@ -667,46 +735,42 @@ begin Result := TAst.MacroDef(name, params, body); end; -function TJsonAstConverter.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; +function TJsonAstConverter.JsonToMacroExpansionNode(const AObj: TJSONObject): IMacroExpansionNode; var - obj, exprObj: TJSONObject; + callee, expandedBody: IAstNode; + args: TArray; + argsArray: TJSONArray; + i: Integer; + tempCallNode: IFunctionCallNode; begin - Node.Expression.Accept(Self); - exprObj := FJsonObjectStack.Pop; + // Recursively deserialize all parts of the macro expansion node + callee := JsonToNode(AObj.GetValue('Callee')); + expandedBody := JsonToNode(AObj.GetValue('ExpandedBody')); + argsArray := AObj.GetValue('Arguments'); + SetLength(args, argsArray.Count); + for i := 0 to argsArray.Count - 1 do + args[i] := JsonToNode(argsArray.Items[i]); - obj := TJSONObject.Create; - obj.AddPair('NodeType', TJSONString.Create('Quasiquote')); - obj.AddPair('Expression', exprObj); - FJsonObjectStack.Push(obj); - Result := TDataValue.Void; + // Create a temporary IFunctionCallNode to pass to the factory + tempCallNode := TAst.FunctionCall(callee, args); + + // Use the new global factory function from the TAst record + Result := TAst.MacroExpansionNode(tempCallNode, expandedBody); end; -function TJsonAstConverter.VisitUnquote(const Node: IUnquoteNode): TDataValue; -var - obj, exprObj: TJSONObject; +function TJsonAstConverter.JsonToQuasiquoteNode(const AObj: TJSONObject): IQuasiquoteNode; 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; + Result := TAst.Quasiquote(JsonToNode(AObj.GetValue('Expression'))); end; -function TJsonAstConverter.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; -var - obj, exprObj: TJSONObject; +function TJsonAstConverter.JsonToUnquoteNode(const AObj: TJSONObject): IUnquoteNode; begin - Node.Expression.Accept(Self); - exprObj := FJsonObjectStack.Pop; + Result := TAst.Unquote(JsonToNode(AObj.GetValue('Expression'))); +end; - obj := TJSONObject.Create; - obj.AddPair('NodeType', TJSONString.Create('UnquoteSplicing')); - obj.AddPair('Expression', exprObj); - FJsonObjectStack.Push(obj); - Result := TDataValue.Void; +function TJsonAstConverter.JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode; +begin + Result := TAst.UnquoteSplicing(JsonToNode(AObj.GetValue('Expression'))); end; function TJsonAstConverter.JsonToFunctionCallNode(const AObj: TJSONObject): IFunctionCallNode; @@ -837,6 +901,8 @@ begin Result := JsonToLambdaExprNode(obj) else if nodeType = 'MacroDef' then Result := JsonToMacroDefNode(obj) + else if nodeType = 'MacroExpansion' then + Result := JsonToMacroExpansionNode(obj) else if nodeType = 'Quasiquote' then Result := JsonToQuasiquoteNode(obj) else if nodeType = 'Unquote' then diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 38faa60..6ea109f 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -20,6 +20,7 @@ type ITernaryExpressionNode = interface; ILambdaExpressionNode = interface; IFunctionCallNode = interface; + IMacroExpansionNode = interface; IBlockExpressionNode = interface; IVariableDeclarationNode = interface; IAssignmentNode = interface; @@ -58,6 +59,7 @@ type function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; function VisitAssignment(const Node: IAssignmentNode): TDataValue; @@ -152,6 +154,15 @@ type property Arguments: TArray read GetArguments; end; + // A node representing a macro call. + IMacroExpansionNode = interface(IFunctionCallNode) + {$region 'private'} + function GetExpandedBody: IAstNode; + {$endregion} + // The AST fragment that resulted from the macro expansion. + property ExpandedBody: IAstNode read GetExpandedBody; + end; + // A node representing a tail-recursive call. IRecurNode = interface(IAstNode) {$region 'private'} diff --git a/Src/AST/Myc.Ast.Script.pas b/Src/AST/Myc.Ast.Script.pas index db7ab02..58cb2fb 100644 --- a/Src/AST/Myc.Ast.Script.pas +++ b/Src/AST/Myc.Ast.Script.pas @@ -4,7 +4,8 @@ interface uses System.SysUtils, - Myc.Ast.Nodes; + Myc.Ast.Nodes, + Myc.Ast.Visitor; type // Provides a high-level facade for parsing and printing the AST. @@ -90,7 +91,7 @@ type // --- Internal Printer Implementation --- - TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor) + TPrettyPrintVisitor = class(TAstVisitor) private FBuilder: TStringBuilder; FIndentLevel: Integer; @@ -104,27 +105,28 @@ type function GetResult: string; // IAstVisitor function Execute(const RootNode: IAstNode): TDataValue; - function VisitConstant(const Node: IConstantNode): TDataValue; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; - function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; - function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; - function VisitUnquote(const Node: IUnquoteNode): TDataValue; - function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; - function VisitIndexer(const Node: IIndexerNode): TDataValue; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; - function VisitRecurNode(const Node: IRecurNode): TDataValue; + 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 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 VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; + function VisitAssignment(const Node: IAssignmentNode): 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; end; { TLexer } @@ -763,6 +765,13 @@ begin Result := TDataValue.Void; end; +function TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +begin + // For pretty-printing, show the original macro call, not the expanded body. + // Delegate to the regular VisitFunctionCall to print it as such. + Result := VisitFunctionCall(Node); +end; + function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; var arg: IAstNode; diff --git a/Src/AST/Myc.Ast.Visitor.pas b/Src/AST/Myc.Ast.Visitor.pas index 312dbd9..83ad920 100644 --- a/Src/AST/Myc.Ast.Visitor.pas +++ b/Src/AST/Myc.Ast.Visitor.pas @@ -21,6 +21,7 @@ type function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual; abstract; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual; abstract; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual; abstract; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; virtual; abstract; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual; abstract; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual; abstract; function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual; abstract; @@ -56,6 +57,7 @@ type function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; @@ -189,6 +191,31 @@ begin Result := TDataValue.FromIntf(TAst.FunctionCall(callee, args)); end; +function TAstTransformer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; +var + callee: IAstNode; + args: TArray; + expandedBody: IAstNode; +begin + // Transform all children of the node + callee := Accept(Node.Callee).AsIntf; + args := TransformNodes(Node.Arguments); + expandedBody := Accept(Node.ExpandedBody).AsIntf; + + if (callee = Node.Callee) and (args = Node.Arguments) and (expandedBody = Node.ExpandedBody) then + begin + // Nothing changed, return the original node. + Result := TDataValue.FromIntf(Node); + end + else + begin + // Children have changed, but the base transformer doesn't know how to + // create a new TBoundMacroExpansionNode. Derived classes must handle this. + raise ENotSupportedException.Create( + 'Rebuilding an IMacroExpansionNode is not supported by the base TAstTransformer. Descendant classes must provide their own implementation.'); + end; +end; + function TAstTransformer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; var expressions: TArray; diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index a74549c..6d75bdd 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -45,6 +45,10 @@ type class function Unquote(const AExpression: IAstNode): IUnquoteNode; static; class function UnquoteSplicing(const AExpression: IAstNode): IUnquoteSplicingNode; static; class function FunctionCall(const ACallee: IAstNode; const AArguments: TArray): IFunctionCallNode; static; + class function MacroExpansionNode( + const AOriginalCallNode: IFunctionCallNode; + const AExpandedBody: IAstNode + ): IMacroExpansionNode; static; class function Recur(const AArguments: array of IAstNode): IRecurNode; static; class function Block(const AExpressions: array of IAstNode): IBlockExpressionNode; static; class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode = nil): IVariableDeclarationNode; static; @@ -161,6 +165,7 @@ type public constructor Create(const AName: IIdentifierNode; const AParameters: TArray; const ABody: IAstNode); function Accept(const Visitor: IAstVisitor): TDataValue; override; + property Name: IIdentifierNode read GetName; end; TQuasiquoteNode = class(TAstNode, IQuasiquoteNode) @@ -202,6 +207,15 @@ type function Accept(const Visitor: IAstVisitor): TDataValue; override; end; + TMacroExpansionNode = class(TFunctionCallNode, IMacroExpansionNode) + private + FExpandedBody: IAstNode; + function GetExpandedBody: IAstNode; + public + constructor Create(const AOriginalCallNode: IFunctionCallNode; const AExpandedBody: IAstNode); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + end; + TRecurNode = class(TAstNode, IRecurNode) private FArguments: TArray; @@ -585,6 +599,24 @@ begin Result := FCallee; end; +{ TMacroExpansionNode } + +constructor TMacroExpansionNode.Create(const AOriginalCallNode: IFunctionCallNode; const AExpandedBody: IAstNode); +begin + inherited Create(AOriginalCallNode.Callee, AOriginalCallNode.Arguments); + FExpandedBody := AExpandedBody; +end; + +function TMacroExpansionNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitMacroExpansionNode(Self); +end; + +function TMacroExpansionNode.GetExpandedBody: IAstNode; +begin + Result := FExpandedBody; +end; + { TRecurNode } constructor TRecurNode.Create(const AArguments: TArray); @@ -860,6 +892,11 @@ begin Result := TFunctionCallNode.Create(ACallee, AArguments); end; +class function TAst.MacroExpansionNode(const AOriginalCallNode: IFunctionCallNode; const AExpandedBody: IAstNode): IMacroExpansionNode; +begin + Result := TMacroExpansionNode.Create(AOriginalCallNode, AExpandedBody); +end; + class function TAst.Identifier(AName: string): IIdentifierNode; begin Result := TIdentifierNode.Create(AName);