From 375e64411bdd0207dd2426a9e7689c264ecc2734 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 1 Sep 2025 19:24:22 +0200 Subject: [PATCH] AST development --- ASTPlayground/MainForm.fmx | 7 + ASTPlayground/MainForm.pas | 114 +++- ASTPlayground/Myc.Ast.Visualizer.pas | 827 +++++++++++++++++++-------- Src/AST/Myc.Ast.Evaluator.pas | 42 +- Src/AST/Myc.Ast.Nodes.pas | 66 ++- Src/AST/Myc.Ast.Printer.pas | 21 + Src/AST/Myc.Ast.Scope.pas | 24 +- Src/AST/Myc.Ast.pas | 60 ++ 8 files changed, 864 insertions(+), 297 deletions(-) diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index 52d4dea..5dc8b52 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -106,6 +106,13 @@ object Form1: TForm1 TextSettings.Trimming = None OnClick = ClearButtonClick end + object FlowOnlyBox: TCheckBox + Position.X = 24.000000000000000000 + Position.Y = 8.000000000000000000 + TabOrder = 12 + Text = 'Flow only' + OnChange = ClearButtonClick + end end object Panel2: TPanel Align = Client diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 5ede722..0b382ac 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -45,6 +45,7 @@ type DoTrigger2Button: TButton; Panel2: TPanel; ClearButton: TButton; + FlowOnlyBox: TCheckBox; procedure ClearButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CrerateTriggerExampleButtonClick(Sender: TObject); @@ -92,7 +93,7 @@ begin FWorkspace.OnMouseDown := WorkspaceMouseDown; - FGScope := T_ExecutionScope.Create(nil); + FGScope := TExecutionScope.Create(nil); end; procedure TForm1.DebugButtonClick(Sender: TObject); @@ -109,7 +110,7 @@ begin exit; end; - scope := T_ExecutionScope.Create(FGScope); + scope := TExecutionScope.Create(FGScope); Memo1.Lines.Clear; Memo1.Lines.Add('--- Debug Evaluator Trace ---'); @@ -193,8 +194,8 @@ begin [TAst.Identifier('n')], TAst.IfExpr( TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), - TAst.VarDecl(TAst.Identifier('Result'), TAst.Identifier('n')), - TAst.VarDecl( + TAst.Assign(TAst.Identifier('Result'), TAst.Identifier('n')), + TAst.Assign( TAst.Identifier('Result'), TAst.BinaryExpr( TAst.FunctionCall( @@ -215,8 +216,39 @@ begin ] ); + root := + TAst.Block( + [ + TAst.VarDecl( + TAst.Identifier('fib'), + TAst.LambdaExpr( + [TAst.Identifier('n')], + // The body is now a single ternary expression that returns a value. + TAst.TernaryExpr( + TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), + // The value if true. + TAst.Identifier('n'), + // The value if false. + TAst.BinaryExpr( + TAst.FunctionCall( + TAst.Identifier('fib'), + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] + ), + boAdd, + TAst.FunctionCall( + TAst.Identifier('fib'), + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(2)))] + ) + ) + ) + ) + ), + TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(30))]) + ] + ); + FLastAst := root; - scope := T_ExecutionScope.Create(nil); + scope := TExecutionScope.Create(nil); visitor := TEvaluatorVisitor.Create(scope); result := root.Accept(visitor); @@ -270,6 +302,7 @@ begin Memo1.Lines.Add('--- Recursive factorial(20) ---'); sw.Start; + { root := TAst.Block( [ @@ -279,7 +312,6 @@ begin [TAst.Identifier('n')], TAst.Block( [ - TAst.VarDecl(TAst.Identifier('Result'), TAst.Constant(TScalar.FromDouble(0))), TAst.IfExpr( TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), TAst.Assign(TAst.Identifier('Result'), TAst.Constant(TScalar.FromInt64(1))), @@ -302,9 +334,41 @@ begin TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TScalar.FromInt64(20))]) ] ); +} + root := + TAst.Block( + [ + TAst.VarDecl( + TAst.Identifier('factorial'), + TAst.LambdaExpr( + [TAst.Identifier('n')], + TAst.Block( + [ + TAst.Assign( + TAst.Identifier('Result'), + TAst.TernaryExpr( + TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), + TAst.Constant(TScalar.FromInt64(1)), + TAst.BinaryExpr( + TAst.Identifier('n'), + boMultiply, + TAst.FunctionCall( + TAst.Identifier('factorial'), + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] + ) + ) + ) + ) + ] + ) + ) + ), + TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TScalar.FromInt64(20))]) + ] + ); FLastAst := root; - scope := T_ExecutionScope.Create(nil); + scope := TExecutionScope.Create(nil); visitor := TEvaluatorVisitor.Create(scope); result := root.Accept(visitor); @@ -317,7 +381,6 @@ end; procedure TForm1.Test1ButtonClick(Sender: TObject); var - root: IAstNode; scope: IExecutionScope; visitor: IAstVisitor; result: TAstValue; @@ -330,20 +393,26 @@ begin Memo1.Lines.Add('--- Simple AST Execution ---'); sw.Start; - root := - TAst.Block( - [ - TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))), - TAst.VarDecl(TAst.Identifier('b'), TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TScalar.FromInt64(2)))), - TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b')) - ] + var main := + TAst.LambdaExpr( + [], + TAst.Block( + [ + TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))), + TAst.VarDecl( + TAst.Identifier('b'), + TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TScalar.FromInt64(2))) + ), + TAst.AssignResult(TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b'))) + ] + ) ); - FLastAst := root; - scope := T_ExecutionScope.Create(FGScope); + FLastAst := main; + scope := TExecutionScope.Create(FGScope); visitor := TEvaluatorVisitor.Create(scope); - result := root.Accept(visitor); + result := TAst.FunctionCall(main, []).Accept(visitor); sw.Stop; if not result.IsVoid then @@ -395,7 +464,7 @@ begin FLastAst := root; - scope := T_ExecutionScope.Create(FGScope); + scope := TExecutionScope.Create(FGScope); visitor := TEvaluatorVisitor.Create(scope); result := root.Accept(visitor); @@ -520,7 +589,12 @@ begin exit; if FLastAst <> nil then - FWorkspace.BuildTree(FLastAst, TPointF.Create(X, Y)); + begin + var visu := TVisualizationMode.vmDetailed; + if FlowOnlyBox.IsChecked then + visu := TVisualizationMode.vmControlFlow; + FWorkspace.BuildTree(FLastAst, TPointF.Create(X, Y), visu); + end; end; end. diff --git a/ASTPlayground/Myc.Ast.Visualizer.pas b/ASTPlayground/Myc.Ast.Visualizer.pas index 0e5552b..4e73ca0 100644 --- a/ASTPlayground/Myc.Ast.Visualizer.pas +++ b/ASTPlayground/Myc.Ast.Visualizer.pas @@ -25,6 +25,9 @@ type TPinShape = (psCircle, psTriangle); TPinAlignment = (paLeft, paRight); + // New enum to select the visualization style. + TVisualizationMode = (vmDetailed, vmControlFlow); + TAuraWorkspace = class; TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor) @@ -51,11 +54,11 @@ type // Node Layout cHorizontalPadding = 25; // Padding inside the node title bar cPinOffsetY = 18; // Vertical distance between pins - cVerticalPadding = 20; // General vertical padding inside container nodes + cVerticalPadding = 10; // General vertical padding inside container nodes // Specific Node Heights - cDefaultNodeHeight = 45; // Default height for simple nodes like BinaryExpr - cIfNodeHeight = 60; // Taller height for If nodes with more pins + cDefaultNodeHeight = 25; // Default height for simple nodes like BinaryExpr + cIfNodeHeight = 40; // Taller height for If nodes with more pins private FWorkspace: TAuraWorkspace; @@ -65,6 +68,9 @@ type FLastResult: TAuraNodeResult; FConnections: TList; FCurrentExec: TList; + FMode: TVisualizationMode; + + procedure FinalizeNodeLayout(const Node: TAuraNode); function VisitContainerNode( const Title, Details: string; @@ -85,14 +91,15 @@ type Shape: TPinShape; Alignment: TPinAlignment; Color: TAlphaColor; - const Tag: string; - OffsetY: Single = 0 + const Tag: string ): TShape; - function CreateInput(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl; - function CreateOutput(ParentNode: TAuraNode; OffsetY: Single = 0): TControl; - function CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0; connect: Boolean = true): TControl; - function CreateExit(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl; + function CreateInput(ParentNode: TAuraNode; const Caption: string): TControl; + function CreateOutput(ParentNode: TAuraNode): TControl; + function CreateEntry(ParentNode: TAuraNode; connect: Boolean = true): TControl; + function CreateExit(ParentNode: TAuraNode; const Caption: string): TControl; + + function TryGetDescr(const Node: IAstNode; out Text: String): Boolean; public constructor Create( @@ -100,7 +107,8 @@ type AParentControl: TControl; const AStartPosition: TPointF; AConnections: TList; - const ACurrentExec: TArray + const ACurrentExec: TArray; + AMode: TVisualizationMode ); destructor Destroy; override; @@ -113,6 +121,7 @@ type function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; @@ -127,7 +136,7 @@ type procedure Paint; override; procedure DoDeleteChildren; override; public - procedure BuildTree(const Root: IAstNode; const Position: TPointF); + procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode); published // Standard control properties @@ -169,7 +178,140 @@ type implementation uses - System.Math; + System.Math, + System.StrUtils; + +type + // This visitor converts an AST expression subtree into a single string. + TAstToTextVisitor = class(TInterfacedObject, IAstVisitor) + public + constructor Create; + { IAstVisitor } + function VisitConstant(const Node: IConstantNode): TAstValue; + function VisitIdentifier(const Node: IIdentifierNode): TAstValue; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; + function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; + function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; + function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; + function VisitAssignment(const Node: IAssignmentNode): TAstValue; + end; + +constructor TAstToTextVisitor.Create; +begin + inherited Create; +end; + +{ TAstToTextVisitor } + +function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; +begin + Result := TAstValue.FromText(Node.Identifier.Name + ' := ' + Node.Value.Accept(Self).AsText); +end; + +function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; +begin + var leftStr := Node.Left.Accept(Self).AsText; + var rightStr := Node.Right.Accept(Self).AsText; + Result := TAstValue.FromText('(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')'); +end; + +function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; +begin + Result := TAstValue.FromText('{...}'); +end; + +function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): TAstValue; +begin + Result := TAstValue.FromText(Node.Value.ToString); +end; + +function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; +var + i: Integer; + sb: TStringBuilder; + calleeStr: string; +begin + calleeStr := Node.Callee.Accept(Self).AsText; + + sb := TStringBuilder.Create; + try + sb.Append(calleeStr); + sb.Append('('); + for i := 0 to Node.Arguments.Count - 1 do + begin + sb.Append(Node.Arguments[i].Accept(Self).AsText); + if i < Node.Arguments.Count - 1 then + sb.Append(', '); + end; + sb.Append(')'); + Result := TAstValue.FromText(sb.ToString); + finally + sb.Free; + end; +end; + +function TAstToTextVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; +begin + Result := TAstValue.FromText(Node.Name); +end; + +function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; +begin + Result := TAstValue.FromText(Node.Condition.Accept(Self).AsText); +end; + +function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; +var + i: Integer; + sb: TStringBuilder; +begin + sb := TStringBuilder.Create; + try + sb.Append('('); + if Length(Node.Parameters) > 0 then + begin + for i := 0 to High(Node.Parameters) do + begin + // Correctly append the parameter name from the node. + sb.Append(Node.Parameters[i].Name); + if i < High(Node.Parameters) then + sb.Append(', '); + end; + end; + sb.Append(') => {...}'); + Result := TAstValue.FromText(sb.ToString); + finally + sb.Free; + end; +end; + +function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; +begin + var condStr := Node.Condition.Accept(Self).AsText; + var thenStr := Node.ThenBranch.Accept(Self).AsText; + var elseStr := Node.ElseBranch.Accept(Self).AsText; + Result := TAstValue.FromText(Format('(%s ? %s : %s)', [condStr, thenStr, elseStr])); +end; + +function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; +begin + Result := TAstValue.FromText(Node.Operator.ToString + ' ' + Node.Right.Accept(Self).AsText); +end; + +function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; +var + initStr: string; +begin + if Assigned(Node.Initializer) then + initStr := ' := ' + Node.Initializer.Accept(Self).AsText + else + initStr := ''; + Result := TAstValue.FromText('var ' + Node.Identifier.Name + initStr); +end; { TPinConnection } @@ -186,7 +328,8 @@ constructor TAstToAuraNodeVisitor.Create( AParentControl: TControl; const AStartPosition: TPointF; AConnections: TList; - const ACurrentExec: TArray + const ACurrentExec: TArray; + AMode: TVisualizationMode ); begin inherited Create; @@ -198,6 +341,7 @@ begin FCurrentExec := TList.Create(ACurrentExec); FLastResult.LayoutNode := nil; FLastResult.OutputPin := nil; + FMode := AMode; end; destructor TAstToAuraNodeVisitor.Destroy; @@ -206,6 +350,68 @@ begin inherited; end; +procedure TAstToAuraNodeVisitor.FinalizeNodeLayout(const Node: TAuraNode); +var + control: TControl; + leftPins, rightPins: TList; + numLeftPins, numRightPins, maxPins: Integer; + reqHeight: Single; + i: Integer; + totalHeight, startY: Single; +begin + leftPins := TList.Create; + rightPins := TList.Create; + try + // 1. Collect all pins and sort them by alignment + for control in Node.Controls do + begin + if (Pos('exec.', control.TagString) = 1) or (Pos('data.', control.TagString) = 1) then + begin + // Use the pin's X position to determine if it's on the left or right side. + if control.Position.X < (Node.Width / 2) then + leftPins.Add(control) + else + rightPins.Add(control); + end; + end; + + numLeftPins := leftPins.Count; + numRightPins := rightPins.Count; + maxPins := Max(numLeftPins, numRightPins); + + if maxPins = 0 then + exit; + + // 2. Calculate and set new node height. + // It must accommodate the pins plus vertical padding. + reqHeight := cVerticalPadding + (maxPins - 1) * cPinOffsetY + cVerticalPadding; + Node.Height := Max(Node.Height, reqHeight); + Node.Height := Max(cDefaultNodeHeight, Node.Height); // Ensure minimum height + + // 3. Position left pins. They are arranged centered on the node. + if numLeftPins > 0 then + begin + totalHeight := (numLeftPins - 1) * cPinOffsetY; + startY := (Node.Height / 2) - (totalHeight / 2.0); + for i := 0 to numLeftPins - 1 do + leftPins[i].Position.Y := startY + i * cPinOffsetY - (cPinSize / 2); + end; + + // 4. Position right pins. + if numRightPins > 0 then + begin + totalHeight := (numRightPins - 1) * cPinOffsetY; + startY := (Node.Height / 2) - (totalHeight / 2.0); + for i := 0 to numRightPins - 1 do + rightPins[i].Position.Y := startY + i * cPinOffsetY - (cPinSize / 2); + end; + + finally + leftPins.Free; + rightPins.Free; + end; +end; + function TAstToAuraNodeVisitor.BuildNodeControl(const Title, Details: string): TAuraNode; var fullTitle: string; @@ -234,12 +440,12 @@ begin end; end; -function TAstToAuraNodeVisitor.CreateInput(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl; +function TAstToAuraNodeVisitor.CreateInput(ParentNode: TAuraNode; const Caption: string): TControl; begin var cap := Caption; if cap <> '' then cap := '.' + cap; - Result := CreatePin(ParentNode, psCircle, paLeft, cDataPinColor, 'data.in' + cap, OffsetY); + Result := CreatePin(ParentNode, psCircle, paLeft, cDataPinColor, 'data.in' + cap); Result.Hint := Caption; Result.ShowHint := Caption <> ''; end; @@ -256,14 +462,14 @@ begin FLastResult.OutputPin := nil; // Default: a new node has no specific data output pin end; -function TAstToAuraNodeVisitor.CreateOutput(ParentNode: TAuraNode; OffsetY: Single = 0): TControl; +function TAstToAuraNodeVisitor.CreateOutput(ParentNode: TAuraNode): TControl; begin - Result := CreatePin(ParentNode, psCircle, paRight, cDataPinColor, 'data.out', OffsetY); + Result := CreatePin(ParentNode, psCircle, paRight, cDataPinColor, 'data.out'); end; -function TAstToAuraNodeVisitor.CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0; connect: Boolean = true): TControl; +function TAstToAuraNodeVisitor.CreateEntry(ParentNode: TAuraNode; connect: Boolean = true): TControl; begin - Result := CreatePin(ParentNode, psTriangle, paLeft, cExecPinColor, 'exec.in', OffsetY); + Result := CreatePin(ParentNode, psTriangle, paLeft, cExecPinColor, 'exec.in'); if connect then begin // Connect all open exits to this new entry @@ -273,12 +479,12 @@ begin end; end; -function TAstToAuraNodeVisitor.CreateExit(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl; +function TAstToAuraNodeVisitor.CreateExit(ParentNode: TAuraNode; const Caption: string): TControl; begin var cap := Caption; if cap <> '' then cap := '.' + cap; - Result := CreatePin(ParentNode, psTriangle, paRight, cExecPinColor, 'exec.out' + cap, OffsetY); + Result := CreatePin(ParentNode, psTriangle, paRight, cExecPinColor, 'exec.out' + cap); FCurrentExec.Add(Result); end; @@ -288,14 +494,14 @@ function TAstToAuraNodeVisitor.CreatePin( Shape: TPinShape; Alignment: TPinAlignment; Color: TAlphaColor; - const Tag: string; - OffsetY: Single = 0 + const Tag: string ): TShape; var posX, posY: Single; begin - // Calculate vertical position (centered + offset) - posY := (ParentNode.Height / 2) - (cPinSize / 2) + OffsetY; + // Vertical position is now set later by FinalizeNodeLayout. + // Set a temporary Y position. + posY := 0; // Calculate horizontal position if Alignment = paLeft then @@ -334,64 +540,103 @@ begin Result.TagString := Tag; end; +function TAstToAuraNodeVisitor.TryGetDescr(const Node: IAstNode; out Text: String): Boolean; +begin + if FMode <> vmControlFlow then + exit(false); + + var textVisitor: IAstVisitor := TAstToTextVisitor.Create; + Text := Node.Accept(textVisitor).AsText; + Result := Pos('{', Text) = 0; +end; + function TAstToAuraNodeVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; begin - VisitOperatorNode( - [Node.Value], - function(const InputResults: TAuraNodeResultList): TAuraNodeResult - var - assignmentNode: TAuraNode; - inputPin: TControl; - valueResult: TAuraNodeResult; - begin - valueResult := InputResults[0]; - assignmentNode := BuildNodeControl('Assignment', Node.Identifier.Name); + var details: String; + if (FMode = vmControlFlow) and TryGetDescr(Node, details) then + begin + var assignmentNode := CreateNodeControl('Assignment', details); + CreateEntry(assignmentNode); + CreateExit(assignmentNode, ''); + FinalizeNodeLayout(assignmentNode); + end + else + begin + VisitOperatorNode( + [Node.Value], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + assignmentNode: TAuraNode; + inputPin: TControl; + valueResult: TAuraNodeResult; + outPin: TControl; // variable for the output pin + begin + valueResult := InputResults[0]; + assignmentNode := BuildNodeControl('Assignment', Node.Identifier.Name); - CreateEntry(assignmentNode, -8); - CreateExit(assignmentNode, '', 0); - inputPin := CreateInput(assignmentNode, Node.Identifier.Name, 8); + CreateEntry(assignmentNode); + inputPin := CreateInput(assignmentNode, Node.Identifier.Name); + CreateExit(assignmentNode, ''); - if Assigned(valueResult.OutputPin) then - FConnections.Add(TPinConnection.Create(valueResult.OutputPin, inputPin)); + // Create the output pin before finalizing the layout. + outPin := CreateOutput(assignmentNode); - Result.LayoutNode := assignmentNode; - Result.OutputPin := nil; // An assignment has no data output - end, - vaTop - ); + if Assigned(valueResult.OutputPin) then + FConnections.Add(TPinConnection.Create(valueResult.OutputPin, inputPin)); + + // Now finalize, all pins are present. + FinalizeNodeLayout(assignmentNode); + + Result.LayoutNode := assignmentNode; + Result.OutputPin := outPin; + end, + vaTop + ); + end; Result := TAstValue.Void; end; function TAstToAuraNodeVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; begin - VisitOperatorNode( - [Node.Left, Node.Right], - function(const InputResults: TAuraNodeResultList): TAuraNodeResult - var - binaryExprNode: TAuraNode; - inputPin1, inputPin2: TControl; - leftResult, rightResult: TAuraNodeResult; - outPin: TControl; - begin - leftResult := InputResults[0]; - rightResult := InputResults[1]; + var exprStr: String; + if (FMode = vmControlFlow) and TryGetDescr(Node, exprStr) then + begin + var exprNode := CreateNodeControl('Expression', exprStr); + FLastResult.OutputPin := CreateOutput(exprNode); // Provide an output for potential connection + FinalizeNodeLayout(exprNode); + end + else + begin + VisitOperatorNode( + [Node.Left, Node.Right], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + binaryExprNode: TAuraNode; + inputPin1, inputPin2: TControl; + leftResult, rightResult: TAuraNodeResult; + outPin: TControl; + begin + leftResult := InputResults[0]; + rightResult := InputResults[1]; - binaryExprNode := BuildNodeControl(Node.Operator.ToString, ''); - binaryExprNode.TitleFont.Size := 20; + binaryExprNode := BuildNodeControl(Node.Operator.ToString, ''); + binaryExprNode.TitleFont.Size := 20; - inputPin1 := CreateInput(binaryExprNode, '', -8); // Caption is in Hint - inputPin2 := CreateInput(binaryExprNode, '', 8); - outPin := CreateOutput(binaryExprNode, 0); + inputPin1 := CreateInput(binaryExprNode, ''); // Caption is in Hint + inputPin2 := CreateInput(binaryExprNode, ''); + outPin := CreateOutput(binaryExprNode); - if Assigned(leftResult.OutputPin) then - FConnections.Add(TPinConnection.Create(leftResult.OutputPin, inputPin1)); - if Assigned(rightResult.OutputPin) then - FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin2)); + if Assigned(leftResult.OutputPin) then + FConnections.Add(TPinConnection.Create(leftResult.OutputPin, inputPin1)); + if Assigned(rightResult.OutputPin) then + FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin2)); - Result.LayoutNode := binaryExprNode; - Result.OutputPin := outPin; - end - ); + FinalizeNodeLayout(binaryExprNode); + Result.LayoutNode := binaryExprNode; + Result.OutputPin := outPin; + end + ); + end; Result := TAstValue.Void; end; @@ -438,8 +683,10 @@ function TAstToAuraNodeVisitor.VisitConstant(const Node: IConstantNode): TAstVal var constantNode: TAuraNode; begin + // In both modes, a constant is a simple node with an output. constantNode := CreateNodeControl('Constant', Node.Value.ToString); - FLastResult.OutputPin := CreateOutput(constantNode, 0); + FLastResult.OutputPin := CreateOutput(constantNode); + FinalizeNodeLayout(constantNode); Result := TAstValue.Void; end; @@ -478,20 +725,22 @@ begin if IsExec then begin - var entryPin := CreateEntry(containerNode, 0); - var entryExitPin := CreateExit(entryNode, '', 0); + var entryPin := CreateEntry(containerNode); + var entryExitPin := CreateExit(entryNode, ''); + FinalizeNodeLayout(entryNode); entryPin.Position.Y := containerNode.AbsoluteToLocal(entryNode.LocalToAbsolute(entryExitPin.Position.Point)).Y; end else begin FCurrentExec.Clear; - CreateExit(entryNode, '', 0); + CreateExit(entryNode, ''); + FinalizeNodeLayout(entryNode); end; end; // Step 2: Create child visitor and run the closure. // The child visitor starts its execution flow from the entry node's exit pin. - childVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, containerNode, childStartPos, FConnections, FCurrentExec.ToArray); + childVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, containerNode, childStartPos, FConnections, FCurrentExec.ToArray, FMode); ChildVisitorProc(childVisitor); FCurrentExec.Clear; @@ -517,9 +766,11 @@ begin begin var exitNode := BuildNodeControl(OutPin, ''); exitNode.Parent := containerNode; - exitNode.Position.Point := TPointF.Create(containerNode.Width - exitNode.Width, containerNode.Height - pinNodeHeight); exitNode.Height := pinNodeHeight; - var exitPin := CreateEntry(exitNode, 0); + var exitPin := CreateEntry(exitNode); + FinalizeNodeLayout(exitNode); + + exitNode.Position.Point := TPointF.Create(containerNode.Width - exitNode.Width, containerNode.Height - exitNode.Height); if not IsExec then begin @@ -527,144 +778,167 @@ begin FCurrentExec.AddRange(currExec); end else - CreateExit(containerNode, '', 0).Position.Y := - containerNode.AbsoluteToLocal(exitNode.LocalToAbsolute(exitPin.Position.Point)).Y; - end + CreateExit(containerNode, '').Position.Y := containerNode.AbsoluteToLocal(exitNode.LocalToAbsolute(exitPin.Position.Point)).Y; + end; + + FinalizeNodeLayout(containerNode); end; function TAstToAuraNodeVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; var inputExpressions: TArray; begin - SetLength(inputExpressions, 1 + Node.Arguments.Count); - inputExpressions[0] := Node.Callee; - for var i := 0 to Node.Arguments.Count - 1 do - inputExpressions[i + 1] := Node.Arguments[i]; + var details: String; + if (FMode = vmControlFlow) and TryGetDescr(Node, details) then + begin + var funcCallNode := CreateNodeControl('FunctionCall', details); + CreateEntry(funcCallNode); + FLastResult.OutputPin := CreateOutput(funcCallNode); // Function calls can return values + CreateExit(funcCallNode, ''); + FinalizeNodeLayout(funcCallNode); + end + else + begin + SetLength(inputExpressions, 1 + Node.Arguments.Count); + inputExpressions[0] := Node.Callee; + for var i := 0 to Node.Arguments.Count - 1 do + inputExpressions[i + 1] := Node.Arguments[i]; - VisitOperatorNode( - inputExpressions, - function(const InputResults: TAuraNodeResultList): TAuraNodeResult - var - funcCallNode: TAuraNode; - calleePin: TControl; - argPin: array of TControl; - currentInputOffsetY, currentOutputOffsetY: Single; - i: Integer; - outPin: TControl; - begin - funcCallNode := BuildNodeControl('FunctionCall', ''); - - var numInputPins := 2 + Node.Arguments.Count; - var numOutputPins := 2; - var maxPins := Max(numInputPins, numOutputPins); - funcCallNode.Height := cVerticalPadding * 2 + (maxPins - 1) * cPinOffsetY; - - currentInputOffsetY := -(numInputPins - 1) / 2.0 * cPinOffsetY; - CreateEntry(funcCallNode, currentInputOffsetY); - currentInputOffsetY := currentInputOffsetY + cPinOffsetY; - calleePin := CreateInput(funcCallNode, 'Callee', currentInputOffsetY); - currentInputOffsetY := currentInputOffsetY + cPinOffsetY; - SetLength(argPin, Node.Arguments.Count); - for i := 0 to Node.Arguments.Count - 1 do + VisitOperatorNode( + inputExpressions, + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + funcCallNode: TAuraNode; + calleePin: TControl; + argPin: array of TControl; + i: Integer; + outPin: TControl; begin - argPin[i] := CreateInput(funcCallNode, 'Arg' + i.ToString, currentInputOffsetY); - currentInputOffsetY := currentInputOffsetY + cPinOffsetY; - end; + funcCallNode := BuildNodeControl('FunctionCall', ''); - currentOutputOffsetY := -(numOutputPins - 1) / 2.0 * cPinOffsetY; - CreateExit(funcCallNode, '', currentOutputOffsetY); - currentOutputOffsetY := currentOutputOffsetY + cPinOffsetY; - outPin := CreateOutput(funcCallNode, currentOutputOffsetY); + CreateEntry(funcCallNode); + calleePin := CreateInput(funcCallNode, 'Callee'); - if Assigned(InputResults[0].OutputPin) then - FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, calleePin)); - for i := 0 to Node.Arguments.Count - 1 do - if Assigned(InputResults[i + 1].OutputPin) then - FConnections.Add(TPinConnection.Create(InputResults[i + 1].OutputPin, argPin[i])); + SetLength(argPin, Node.Arguments.Count); + for i := 0 to Node.Arguments.Count - 1 do + argPin[i] := CreateInput(funcCallNode, 'Arg' + i.ToString); - Result.LayoutNode := funcCallNode; - Result.OutputPin := outPin; - end - ); + CreateExit(funcCallNode, ''); + outPin := CreateOutput(funcCallNode); + if Assigned(InputResults[0].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, calleePin)); + for i := 0 to Node.Arguments.Count - 1 do + if Assigned(InputResults[i + 1].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[i + 1].OutputPin, argPin[i])); + + FinalizeNodeLayout(funcCallNode); + Result.LayoutNode := funcCallNode; + Result.OutputPin := outPin; + end + ); + end; Result := TAstValue.Void; end; function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; begin var identifierNode := CreateNodeControl('Identifier', Node.Name); - FLastResult.OutputPin := CreateOutput(identifierNode, 0); + FLastResult.OutputPin := CreateOutput(identifierNode); + FinalizeNodeLayout(identifierNode); Result := TAstValue.Void; end; function TAstToAuraNodeVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; +var + startPosition: TPointF; + ifNode: TAuraNode; + conditionEndY: Single; + branchStartX: Single; + execPathes: TList; + thenEndY, elseEndY: Single; begin - var startPosition := FCurrentPos; + startPosition := FCurrentPos; - // Use helper for the condition part - var ifNode := - VisitOperatorNode( - [Node.Condition], - function(const InputResults: TAuraNodeResultList): TAuraNodeResult - var - conditionInputPin: TControl; - condResult: TAuraNodeResult; - ifNode: TAuraNode; - begin - condResult := InputResults[0]; - ifNode := BuildNodeControl('If', ''); - ifNode.Height := cIfNodeHeight; - CreateEntry(ifNode, -12); + var condStr: String; + if (FMode = vmControlFlow) and TryGetDescr(Node, condStr) then + begin + ifNode := CreateNodeControl('If', condStr); + ifNode.Height := cIfNodeHeight; + end + else + begin + // Use helper for the condition part + ifNode := + VisitOperatorNode( + [Node.Condition], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + conditionInputPin: TControl; + condResult: TAuraNodeResult; + ifNode: TAuraNode; + begin + condResult := InputResults[0]; + ifNode := BuildNodeControl('If', ''); - conditionInputPin := CreateInput(ifNode, 'Condition', 12); + conditionInputPin := CreateInput(ifNode, 'Condition'); - if Assigned(condResult.OutputPin) then - FConnections.Add(TPinConnection.Create(condResult.OutputPin, conditionInputPin)); + if Assigned(condResult.OutputPin) then + FConnections.Add(TPinConnection.Create(condResult.OutputPin, conditionInputPin)); - Result.LayoutNode := ifNode; - Result.OutputPin := nil; - end - ); - var conditionEndY := FCurrentPos.Y; + // Do not finalize here, more pins will be added. + Result.LayoutNode := ifNode; + Result.OutputPin := nil; + end + ); + end; + CreateEntry(ifNode); + conditionEndY := FCurrentPos.Y; // Visit the 'Then' and 'Else' execution branches, placing them to the right of the 'If' node. - var branchStartX := ifNode.Position.X + ifNode.Width + FSpacing.X; - - var execPathes := TList.Create; - - // Then branch - FCurrentExec.Clear; - CreateExit(ifNode, 'Then', -12); - FCurrentPos.X := branchStartX; - FCurrentPos.Y := startPosition.Y; - Node.ThenBranch.Accept(Self); - var thenEndY := FCurrentPos.Y; - FLastResult.LayoutNode := ifNode; - execPathes.AddRange(FCurrentExec); - - // Else branch (if it exists) - var elseEndY := thenEndY; - if Assigned(Node.ElseBranch) then - begin + branchStartX := ifNode.Position.X + ifNode.Width + FSpacing.X; + execPathes := TList.Create; + try + // Then branch FCurrentExec.Clear; - CreateExit(ifNode, 'Else', 12); + CreateExit(ifNode, 'Then'); FCurrentPos.X := branchStartX; - FCurrentPos.Y := thenEndY; - Node.ElseBranch.Accept(Self); - elseEndY := FCurrentPos.Y; + FCurrentPos.Y := startPosition.Y; + Node.ThenBranch.Accept(Self); + thenEndY := FCurrentPos.Y; + FLastResult.LayoutNode := ifNode; execPathes.AddRange(FCurrentExec); + + // Else branch (if it exists) + elseEndY := thenEndY; + if Assigned(Node.ElseBranch) then + begin + FCurrentExec.Clear; + CreateExit(ifNode, 'Else'); + FCurrentPos.X := branchStartX; + FCurrentPos.Y := thenEndY; + Node.ElseBranch.Accept(Self); + elseEndY := FCurrentPos.Y; + execPathes.AddRange(FCurrentExec); + end; + + // Finalize layout now that all pins are added. + FinalizeNodeLayout(ifNode); + + // Finalize visitor state. + FCurrentPos.X := startPosition.X; + FCurrentPos.Y := Max(conditionEndY, elseEndY); + FLastResult.LayoutNode := ifNode; + // This node is for control-flow only and never produces a data output. + FLastResult.OutputPin := nil; + + // After a branch, the execution flow has diverged. + FCurrentExec.Clear; + FCurrentExec.AddRange(execPathes); + finally + execPathes.Free; end; - // Finalize visitor state. - FCurrentPos.X := startPosition.X; - FCurrentPos.Y := Max(conditionEndY, elseEndY); - FLastResult.LayoutNode := ifNode; - FLastResult.OutputPin := nil; // An if-expression has no data output itself - - // After a branch, the execution flow has diverged. - FCurrentExec.Clear; - FCurrentExec.AddRange(execPathes); - Result := TAstValue.Void; end; @@ -699,7 +973,10 @@ begin FCurrentPos.Y := lambdaNode.Position.Y + lambdaNode.Height + FSpacing.Y; FLastResult.LayoutNode := lambdaNode; - FLastResult.OutputPin := CreateOutput(lambdaNode, 0); + FLastResult.OutputPin := CreateOutput(lambdaNode); + + // Re-finalize layout after adding the data output pin. + FinalizeNodeLayout(lambdaNode); Result := TAstValue.Void; end; @@ -734,7 +1011,7 @@ begin if Assigned(res.LayoutNode) then maxChildWidth := Max(maxChildWidth, res.LayoutNode.Position.X + res.LayoutNode.Width); - // 3. Let the closure create the parent node (without positioning). + // 3. Let the closure create the parent node (which also finalizes its layout). createResult := CreateParentProc(inputResults); parentNode := createResult.LayoutNode; Result := parentNode; @@ -762,78 +1039,158 @@ begin end; end; +function TAstToAuraNodeVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; +begin + var exprStr: String; + if (FMode = vmControlFlow) and TryGetDescr(Node, exprStr) then + begin + var ternaryNode := CreateNodeControl('Expression', exprStr); + FLastResult.OutputPin := CreateOutput(ternaryNode); + FinalizeNodeLayout(ternaryNode); + end + else + begin + VisitOperatorNode( + [Node.Condition, Node.ThenBranch, Node.ElseBranch], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + ternaryNode: TAuraNode; + condPin, thenPin, elsePin, outPin: TControl; + begin + ternaryNode := BuildNodeControl('?', ''); + ternaryNode.TitleFont.Size := 20; + + condPin := CreateInput(ternaryNode, 'Condition'); + thenPin := CreateInput(ternaryNode, 'Then'); + elsePin := CreateInput(ternaryNode, 'Else'); + outPin := CreateOutput(ternaryNode); + + if Assigned(InputResults[0].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, condPin)); + if Assigned(InputResults[1].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[1].OutputPin, thenPin)); + if Assigned(InputResults[2].OutputPin) then + FConnections.Add(TPinConnection.Create(InputResults[2].OutputPin, elsePin)); + + FinalizeNodeLayout(ternaryNode); + Result.LayoutNode := ternaryNode; + Result.OutputPin := outPin; + end + ); + end; + Result := TAstValue.Void; +end; + function TAstToAuraNodeVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; begin - VisitOperatorNode( - [Node.Right], - function(const InputResults: TAuraNodeResultList): TAuraNodeResult - var - unaryExprNode: TAuraNode; - inputPin: TControl; - rightResult: TAuraNodeResult; - outPin: TControl; - begin - rightResult := InputResults[0]; - unaryExprNode := BuildNodeControl(Node.Operator.ToString, ''); - unaryExprNode.TitleFont.Size := 20; + var exprStr: String; + if (FMode = vmControlFlow) and TryGetDescr(Node, exprStr) then + begin + var exprNode := CreateNodeControl('Expression', exprStr); + FLastResult.OutputPin := CreateOutput(exprNode); + FinalizeNodeLayout(exprNode); + end + else + begin + VisitOperatorNode( + [Node.Right], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + unaryExprNode: TAuraNode; + inputPin: TControl; + rightResult: TAuraNodeResult; + outPin: TControl; + begin + rightResult := InputResults[0]; + unaryExprNode := BuildNodeControl(Node.Operator.ToString, ''); + unaryExprNode.TitleFont.Size := 20; - inputPin := CreateInput(unaryExprNode, '', 0); - outPin := CreateOutput(unaryExprNode, 0); + inputPin := CreateInput(unaryExprNode, ''); + outPin := CreateOutput(unaryExprNode); - if Assigned(rightResult.OutputPin) then - FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin)); + if Assigned(rightResult.OutputPin) then + FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin)); - Result.LayoutNode := unaryExprNode; - Result.OutputPin := outPin; - end - ); + FinalizeNodeLayout(unaryExprNode); + Result.LayoutNode := unaryExprNode; + Result.OutputPin := outPin; + end + ); + end; Result := TAstValue.Void; end; function TAstToAuraNodeVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; +var + varDeclNode: TAuraNode; + outPin: TControl; begin - if Assigned(Node.Initializer) then + var details: String; + if (FMode = vmControlFlow) and TryGetDescr(Node, details) then begin - VisitOperatorNode( - [Node.Initializer], - function(const InputResults: TAuraNodeResultList): TAuraNodeResult - var - varDeclNode: TAuraNode; - inputPin: TControl; - initializerResult: TAuraNodeResult; - begin - initializerResult := InputResults[0]; - varDeclNode := BuildNodeControl('VarDecl', Node.Identifier.Name); - - CreateEntry(varDeclNode, -8); - CreateExit(varDeclNode, '', -8); - inputPin := CreateInput(varDeclNode, 'Value', 8); - - if Assigned(initializerResult.OutputPin) then - FConnections.Add(TPinConnection.Create(initializerResult.OutputPin, inputPin)); - - Result.LayoutNode := varDeclNode; - Result.OutputPin := nil; - end - ); + varDeclNode := CreateNodeControl('VarDecl', details); + CreateEntry(varDeclNode); + CreateExit(varDeclNode, ''); + FinalizeNodeLayout(varDeclNode); end else begin - // Case without initializer is a simple sequential node. - var varDeclNode := CreateNodeControl('VarDecl', Node.Identifier.Name); - CreateEntry(varDeclNode, 0); - CreateExit(varDeclNode, '', 0); + if Assigned(Node.Initializer) then + begin + varDeclNode := + VisitOperatorNode( + [Node.Initializer], + function(const InputResults: TAuraNodeResultList): TAuraNodeResult + var + varDeclNode: TAuraNode; + inputPin: TControl; + initializerResult: TAuraNodeResult; + outPin: TControl; // variable for the output pin + begin + initializerResult := InputResults[0]; + varDeclNode := BuildNodeControl('VarDecl', Node.Identifier.Name); + + CreateEntry(varDeclNode); + inputPin := CreateInput(varDeclNode, 'Value'); + CreateExit(varDeclNode, ''); + + // Create the output pin before finalizing the layout. + outPin := CreateOutput(varDeclNode); + + if Assigned(initializerResult.OutputPin) then + FConnections.Add(TPinConnection.Create(initializerResult.OutputPin, inputPin)); + + // Now finalize, all pins are present. + FinalizeNodeLayout(varDeclNode); + Result.LayoutNode := varDeclNode; + Result.OutputPin := outPin; + end + ); + end + else + begin + // Case without initializer is a simple sequential node. + varDeclNode := CreateNodeControl('VarDecl', Node.Identifier.Name); + CreateEntry(varDeclNode); + CreateExit(varDeclNode, ''); + // Create the output pin before finalizing the layout. + outPin := CreateOutput(varDeclNode); + FLastResult.OutputPin := outPin; + // Now finalize, all pins are present. + FinalizeNodeLayout(varDeclNode); + end; end; + Result := TAstValue.Void; end; { TAuraWorkspace } -procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF); +procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode); begin var connections := TList.Create; try - Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil)); + Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode)); FConnections := FConnections + connections.ToArray; finally connections.Free; @@ -852,24 +1209,24 @@ var startPoint, endPoint, pinCenter: TPointF; path: TPathData; controlPoint1, controlPoint2: TPointF; - deltaX, controlOffset: Single; + controlOffset: Single; begin inherited; Canvas.Stroke.Kind := TBrushKind.Solid; Canvas.Stroke.Thickness := 2; - // Gehe durch alle gespeicherten Verbindungen und zeichne sie + // Go through all stored connections and draw them for connection in FConnections do begin - // Hole die absoluten Koordinaten der Pin-Mittelpunkte + // Get the absolute coordinates of the pin centers pinCenter := TPointF.Create(connection.OutputPin.Width / 2, connection.OutputPin.Height / 2); var absoluteStart := connection.OutputPin.LocalToAbsolute(pinCenter); pinCenter := TPointF.Create(connection.InputPin.Width / 2, connection.InputPin.Height / 2); var absoluteEnd := connection.InputPin.LocalToAbsolute(pinCenter); - // Rechne sie in die lokalen Koordinaten der PaintBox um + // Convert them to the local coordinates of the workspace startPoint := AbsoluteToLocal(absoluteStart); endPoint := AbsoluteToLocal(absoluteEnd); diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 1ea3340..3a25f9a 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -25,6 +25,7 @@ type function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; virtual; function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; virtual; function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; virtual; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; virtual; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; virtual; function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; virtual; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; virtual; @@ -52,6 +53,7 @@ type function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; override; function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; override; function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; override; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override; @@ -170,15 +172,13 @@ end; function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; var varName: string; - initValue: TAstValue; begin varName := Node.Identifier.Name; if Assigned(Node.Initializer) then - initValue := Node.Initializer.Accept(Self) + Result := Node.Initializer.Accept(Self) else - initValue := TAstValue.Void; - FScope.SetValue(varName, initValue); - Result := TAstValue.Void; + Result := TAstValue.Void; + FScope.SetValue(varName, Result); end; function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; @@ -210,7 +210,7 @@ begin if (arguments.Count <> Length(closure.Parameters)) then raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), arguments.Count]); - callScope := T_ExecutionScope.Create(closure.ClosureScope); + callScope := TExecutionScope.Create(closure.ClosureScope); for i := 0 to arguments.Count - 1 do begin @@ -219,6 +219,13 @@ begin end; innerVisitor := Self.CreateVisitorForScope(callScope); + + // Introduce 'Result' variable for imperative-style assignments within the closure. + callScope.SetValue('Result', TAstValue.Void); + + // The return value of the function is the value of its body expression. + // This supports both functional-style returns (direct value) and + // imperative-style returns (via an assignment, which also returns the value). Result := closure.Body.Accept(innerVisitor); end; @@ -314,6 +321,17 @@ begin Result := Node.ElseBranch.Accept(Self); end; +function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; +var + conditionValue: TAstValue; +begin + conditionValue := Node.Condition.Accept(Self); + if IsTruthy(conditionValue) then + Result := Node.ThenBranch.Accept(Self) + else + Result := Node.ElseBranch.Accept(Self); +end; + function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; var expression: IExpressionNode; @@ -457,6 +475,18 @@ begin AppendLine(Format('} -> %s', [Result.ToString])); end; +function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; +begin + AppendLine('TernaryExpr{'); + Indent; + try + Result := inherited VisitTernaryExpression(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.ToString])); +end; + function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; begin AppendLine('LambdaExpr{'); diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 9de58c1..026b907 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -33,6 +33,8 @@ type IBinaryExpressionNode = interface; IUnaryExpressionNode = interface; IIfExpressionNode = interface; + // Added forward declaration for the new ternary expression node. + ITernaryExpressionNode = interface; ILambdaExpressionNode = interface; IFunctionCallNode = interface; IBlockExpressionNode = interface; @@ -55,9 +57,25 @@ type TAstValue = record private - FKind: TAstValueKind; - FScalar: TScalar; - FInterface: IInterface; + type + IVal = interface + ['{70210CAF-0857-4BF1-8254-B8239A155A02}'] + function GetValue: T; + property Value: T read GetValue; + end; + + TVal = class(TInterfacedObject, IVal) + private + FValue: T; + function GetValue: T; + public + constructor Create(const AValue: T); + end; + + var + FKind: TAstValueKind; + FScalar: TScalar; + FInterface: IInterface; function GetKind: TAstValueKind; inline; function GetIsVoid: Boolean; inline; public @@ -93,6 +111,8 @@ type function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; + // Added visitor method for the new ternary expression node. + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; @@ -141,6 +161,7 @@ type property Right: IExpressionNode read GetRight; end; + // Represents an if-statement for control flow. IIfExpressionNode = interface(IExpressionNode) {$region 'private'} function GetCondition: IExpressionNode; @@ -152,6 +173,18 @@ type property ElseBranch: IExpressionNode read GetElseBranch; end; + // Represents a ternary expression (e.g., condition ? true_expr : false_expr) for value selection. + ITernaryExpressionNode = interface(IExpressionNode) + {$region 'private'} + function GetCondition: IExpressionNode; + function GetThenBranch: IExpressionNode; + function GetElseBranch: IExpressionNode; + {$endregion} + property Condition: IExpressionNode read GetCondition; + property ThenBranch: IExpressionNode read GetThenBranch; + property ElseBranch: IExpressionNode read GetElseBranch; + end; + ILambdaExpressionNode = interface(IExpressionNode) {$region 'private'} function GetParameters: TArray; @@ -200,31 +233,15 @@ implementation uses System.Classes; -type - // Private interface to encapsulate a non scalar value for reference counting. - IAstValue = interface - function GetValue: string; - property Value: string read GetValue; - end; - - // Implementation of the text value interface. - TAstValue = class(TInterfacedObject, IAstValue) - private - FValue: string; - function GetValue: string; - public - constructor Create(const AValue: string); - end; - { TAstValue } -constructor TAstValue.Create(const AValue: string); +constructor TAstValue.TVal.Create(const AValue: T); begin inherited Create; FValue := AValue; end; -function TAstValue.GetValue: string; +function TAstValue.TVal.GetValue: T; begin Result := FValue; end; @@ -255,7 +272,8 @@ function TAstValue.AsText: String; begin if (FKind <> avkText) then raise EInvalidCast.Create('Cannot read value as Text.'); - Result := IAstValue(FInterface).Value; + + Result := (FInterface as IVal).Value; end; class function TAstValue.FromClosure(const AValue: IEvaluatorClosure): TAstValue; @@ -275,7 +293,7 @@ end; class function TAstValue.FromText(const AValue: String): TAstValue; begin Result.FKind := avkText; - Result.FInterface := TAstValue.Create(AValue); + Result.FInterface := TVal.Create(AValue); Result.FScalar := Default(TScalar); end; @@ -313,7 +331,7 @@ begin case Self of boAdd: Result := '+'; boSubtract: Result := '-'; - boMultiply: Result := #$2A2F; + boMultiply: Result := '*'; boDivide: Result := '/'; boEqual: Result := '=='; boNotEqual: Result := '!='; diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index 89c5c6c..6fa6f32 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -27,6 +27,7 @@ type function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; @@ -128,6 +129,26 @@ begin Result := TAstValue.Void; end; +function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; +begin + AppendLine('TernaryExpr'); + Indent; + AppendLine('Condition:'); + Indent; + Node.Condition.Accept(Self); + Unindent; + AppendLine('Then:'); + Indent; + Node.ThenBranch.Accept(Self); + Unindent; + AppendLine('Else:'); + Indent; + Node.ElseBranch.Accept(Self); + Unindent; + Unindent; + Result := TAstValue.Void; +end; + function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; var param: IIdentifierNode; diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index 3eacf36..71423bb 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -9,7 +9,7 @@ uses Myc.Ast.Nodes; type - T_ExecutionScope = class(TInterfacedObject, IExecutionScope) + TExecutionScope = class(TInterfacedObject, IExecutionScope) private FParent: IExecutionScope; FVariables: TDictionary; @@ -29,27 +29,27 @@ type implementation -{ T_ExecutionScope } +{ TExecutionScope } -constructor T_ExecutionScope.Create(AParent: IExecutionScope); +constructor TExecutionScope.Create(AParent: IExecutionScope); begin inherited Create; FParent := AParent; FVariables := TDictionary.Create; end; -destructor T_ExecutionScope.Destroy; +destructor TExecutionScope.Destroy; begin FVariables.Free; inherited Destroy; end; -function T_ExecutionScope.GetParent: IExecutionScope; +function TExecutionScope.GetParent: IExecutionScope; begin Result := FParent; end; -procedure T_ExecutionScope.AssignValue(const Name: string; const Value: TAstValue); +procedure TExecutionScope.AssignValue(const Name: string; const Value: TAstValue); begin if FVariables.ContainsKey(Name) then FVariables.AddOrSetValue(Name, Value) @@ -59,14 +59,14 @@ begin raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]); end; -procedure T_ExecutionScope.Clear; +procedure TExecutionScope.Clear; begin FVariables.Clear; if Assigned(FParent) then FParent.Clear; end; -procedure T_ExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); +procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); var pair: TPair; indentStr: string; @@ -88,11 +88,11 @@ begin // As FParent is now an interface, we must cast it back to the class to call the private DumpScope. // This indicates that DumpScope should perhaps be part of the interface or handled differently. // For now, we use a cast to keep the functionality. - (FParent as T_ExecutionScope).DumpScope(ABuilder, AIndent + 2); + (FParent as TExecutionScope).DumpScope(ABuilder, AIndent + 2); end; end; -function T_ExecutionScope.Dump: string; +function TExecutionScope.Dump: string; var builder: TStringBuilder; begin @@ -106,7 +106,7 @@ begin end; end; -function T_ExecutionScope.FindValue(const Name: string; out Value: TAstValue): Boolean; +function TExecutionScope.FindValue(const Name: string; out Value: TAstValue): Boolean; begin Result := FVariables.TryGetValue(Name, Value); if not Result and Assigned(FParent) then @@ -115,7 +115,7 @@ begin end; end; -procedure T_ExecutionScope.SetValue(const Name: string; const Value: TAstValue); +procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue); begin FVariables.AddOrSetValue(Name, Value); end; diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 6424c35..689e38e 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -22,11 +22,17 @@ type const ACondition: IExpressionNode; const AThenBranch, AElseBranch: IExpressionNode ): IIfExpressionNode; static; + // Added factory function for the new ternary expression node. + class function TernaryExpr( + const ACondition: IExpressionNode; + const AThenBranch, AElseBranch: IExpressionNode + ): ITernaryExpressionNode; static; class function LambdaExpr(const AParameters: TArray; const ABody: IExpressionNode): ILambdaExpressionNode; static; class function FunctionCall(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode): IFunctionCallNode; static; class function Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode; static; class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode; static; class function Assign(const AIdentifier: IIdentifierNode; const AValue: IExpressionNode): IAssignmentNode; static; + class function AssignResult(const AValue: IExpressionNode): IAssignmentNode; static; end; implementation @@ -103,6 +109,20 @@ type function Accept(const Visitor: IAstVisitor): TAstValue; override; end; + { TTernaryExpressionNode } + TTernaryExpressionNode = class(TAstNode, ITernaryExpressionNode) + private + FCondition: IExpressionNode; + FThenBranch: IExpressionNode; + FElseBranch: IExpressionNode; + function GetCondition: IExpressionNode; + function GetThenBranch: IExpressionNode; + function GetElseBranch: IExpressionNode; + public + constructor Create(const ACondition, AThenBranch, AElseBranch: IExpressionNode); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + { TLambdaExpressionNode } TLambdaExpressionNode = class(TAstNode, ILambdaExpressionNode) private @@ -283,6 +303,36 @@ begin Result := FThenBranch; end; +{ TTernaryExpressionNode } + +constructor TTernaryExpressionNode.Create(const ACondition, AThenBranch, AElseBranch: IExpressionNode); +begin + inherited Create; + FCondition := ACondition; + FThenBranch := AThenBranch; + FElseBranch := AElseBranch; +end; + +function TTernaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; +begin + Result := Visitor.VisitTernaryExpression(Self); +end; + +function TTernaryExpressionNode.GetCondition: IExpressionNode; +begin + Result := FCondition; +end; + +function TTernaryExpressionNode.GetElseBranch: IExpressionNode; +begin + Result := FElseBranch; +end; + +function TTernaryExpressionNode.GetThenBranch: IExpressionNode; +begin + Result := FThenBranch; +end; + { TLambdaExpressionNode } constructor TLambdaExpressionNode.Create(const AParameters: TArray; const ABody: IExpressionNode); @@ -424,6 +474,11 @@ begin Result := TAssignmentNode.Create(AIdentifier, AValue); end; +class function TAst.AssignResult(const AValue: IExpressionNode): IAssignmentNode; +begin + Result := Assign(TAst.Identifier('Result'), AValue); +end; + class function TAst.Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode; begin Result := TBlockExpressionNode.Create(AExpressions); @@ -454,6 +509,11 @@ begin Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch); end; +class function TAst.TernaryExpr(const ACondition, AThenBranch, AElseBranch: IExpressionNode): ITernaryExpressionNode; +begin + Result := TTernaryExpressionNode.Create(ACondition, AThenBranch, AElseBranch); +end; + class function TAst.LambdaExpr(const AParameters: TArray; const ABody: IExpressionNode): ILambdaExpressionNode; begin Result := TLambdaExpressionNode.Create(AParameters, ABody);