diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index ef8ced3..650a013 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Release + Debug Win32 ASTPlayground 3 diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index ac48db6..2aae761 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -7,6 +7,8 @@ object Form1: TForm1 FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] + OnCreate = FormCreate + OnDestroy = FormDestroy DesignerMasterStyle = 0 object Panel1: TPanel Align = Left @@ -71,6 +73,29 @@ object Form1: TForm1 TextSettings.Trimming = None OnClick = FibonacciButtonClick end + object CrerateTriggerExampleButton: TButton + Position.X = 24.000000000000000000 + Position.Y = 320.000000000000000000 + TabOrder = 9 + Text = 'TriggerTest' + TextSettings.Trimming = None + OnClick = CrerateTriggerExampleButtonClick + end + object DoTriggerButton: TButton + Position.X = 24.000000000000000000 + Position.Y = 350.000000000000000000 + TabOrder = 10 + Text = 'Trigger!' + TextSettings.Trimming = None + OnClick = DoTriggerButtonClick + object DoTrigger2Button: TButton + Position.Y = 30.000000000000000000 + TabOrder = 8 + Text = 'Trigger2' + TextSettings.Trimming = None + OnClick = DoTrigger2ButtonClick + end + end end object Memo1: TMemo Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 7d3c968..0fefc3b 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -34,7 +34,15 @@ type RecursionButton: TButton; ShowScopeBox: TCheckBox; FibonacciButton: TButton; + CrerateTriggerExampleButton: TButton; + DoTriggerButton: TButton; + DoTrigger2Button: TButton; + procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure CrerateTriggerExampleButtonClick(Sender: TObject); procedure DebugButtonClick(Sender: TObject); + procedure DoTrigger2ButtonClick(Sender: TObject); + procedure DoTriggerButtonClick(Sender: TObject); procedure FibonacciButtonClick(Sender: TObject); procedure PrettyPrintButtonClick(Sender: TObject); procedure RecursionButtonClick(Sender: TObject); @@ -43,6 +51,7 @@ type private // Stores the last AST generated by Test1 or Test2 button clicks. FLastAst: IAstNode; + FGScope: TExecutionScope; public { Public declarations } end; @@ -57,6 +66,16 @@ uses {$R *.fmx} +procedure TForm1.FormDestroy(Sender: TObject); +begin + FGScope.Free; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + FGScope := TExecutionScope.Create(nil); +end; + procedure TForm1.DebugButtonClick(Sender: TObject); var scope: TExecutionScope; @@ -71,7 +90,7 @@ begin exit; end; - scope := TExecutionScope.Create(nil); + scope := TExecutionScope.Create(FGScope); try Memo1.Lines.Clear; Memo1.Lines.Add('--- Debug Evaluator Trace ---'); @@ -113,6 +132,8 @@ var result20, result30, result40: Int64; time20, time30, time40: Int64; begin + FGScope.Clear; + Memo1.Lines.Clear; Memo1.Lines.Add('--- Native Delphi Fibonacci Performance ---'); Memo1.Lines.Add('Calculating fib(30) and fib(40)...'); @@ -227,6 +248,8 @@ var result: TAstValue; sw: TStopwatch; begin + FGScope.Clear; + sw := TStopwatch.Create; Memo1.Lines.Clear; Memo1.Lines.Add('--- Recursive factorial(20) ---'); @@ -280,6 +303,8 @@ var result: TAstValue; sw: TStopwatch; begin + FGScope.Clear; + sw := TStopwatch.Create; Memo1.Lines.Clear; Memo1.Lines.Add('--- Simple AST Execution ---'); @@ -320,6 +345,8 @@ var result: TAstValue; sw: TStopwatch; begin + FGScope.Clear; + sw := TStopwatch.Create; Memo1.Lines.Clear; Memo1.Lines.Add('--- Factory Pattern Demo ---'); @@ -361,4 +388,105 @@ begin end; end; +procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject); +var + lambdaAst: ILambdaExpressionNode; + visitor: IAstVisitor; + closureValue: TAstValue; +begin + FGScope.Clear; + + // Create an AST that gets a "tick" in DoTriggerButtonClick. + // This simulates a simple Blueprint-like event system. + // It maintains state via a persistent execution scope. + + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Creating Trigger Blueprint ---'); + + // 1. Initialize the variable 'X' to 0 directly in the scope. + FGScope.SetValue('X', TAstValue.FromScalar(TScalar.FromInt64(0))); + + // 2. Create a lambda that takes the summand as an argument. + // AST for: (summand) => { X = X + summand; } + // Using the new Assignment node to modify 'X' in its parent scope. + lambdaAst := + TAst.LambdaExpr( + [TAst.Identifier('summand')], + TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand'))) + ); + + // 3. Evaluate the lambda to create a closure and store it in the scope. + // The closure captures the scope where 'X' is defined. + visitor := TEvaluatorVisitor.Create(FGScope); + closureValue := lambdaAst.Accept(visitor); + FGScope.SetValue('tickHandler', closureValue); + + // FLastAst is not used for this parameterized example. + FLastAst := lambdaAst; + + Memo1.Lines.Add('Variable "X" initialized to 0 in persistent scope.'); + Memo1.Lines.Add('Blueprint function "tickHandler(summand)" created.'); + Memo1.Lines.Add('Click "Do Trigger" or "Do Trigger 2" to execute.'); +end; + +procedure TForm1.DoTriggerButtonClick(Sender: TObject); +var + visitor: IAstVisitor; + currentValue: TAstValue; + callAst: IFunctionCallNode; +begin + // A "tick" executes the stored AST using the persistent scope. + + // Create an AST to call the stored handler with argument 1. + // AST for: tickHandler(1) + callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]); + + // Execute the call AST. + visitor := TEvaluatorVisitor.Create(FGScope); + callAst.Accept(visitor); + + FLastAst := callAst; + + // Get the updated value of 'X' from the scope and display it. + if FGScope.FindValue('X', currentValue) then + begin + Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [currentValue.ToString])); + end + else + begin + // This should not happen if setup was correct. + Memo1.Lines.Add('Error: Variable "X" not found in scope.'); + end; +end; + +procedure TForm1.DoTrigger2ButtonClick(Sender: TObject); +var + visitor: IAstVisitor; + currentValue: TAstValue; + callAst: IFunctionCallNode; +begin + // A "tick" that adds 2, using the same blueprint function. + + // Create an AST to call the stored handler with argument 2. + // AST for: tickHandler(2) + callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]); + + FLastAst := callAst; + + // Execute the call AST. + visitor := TEvaluatorVisitor.Create(FGScope); + callAst.Accept(visitor); + + // Get the updated value of 'X' from the scope and display it. + if FGScope.FindValue('X', currentValue) then + begin + Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [currentValue.ToString])); + end + else + begin + // This should not happen if setup was correct. + Memo1.Lines.Add('Error: Variable "X" not found in scope.'); + end; +end; + end. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index d644680..06876a4 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -12,8 +12,9 @@ uses type // TEvaluatorVisitor is the base implementation for evaluating an AST. TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) - protected + private FScope: TExecutionScope; + protected function IsTruthy(const AValue: TAstValue): Boolean; function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; virtual; public @@ -27,6 +28,7 @@ type function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; virtual; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; virtual; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; virtual; + function VisitAssignment(const Node: IAssignmentNode): TAstValue; virtual; end; // TDebugEvaluatorVisitor now overrides all visit methods for full tracing @@ -53,6 +55,7 @@ type function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override; + function VisitAssignment(const Node: IAssignmentNode): TAstValue; override; end; implementation @@ -66,22 +69,22 @@ type TClosureValue = class(TInterfacedObject, IEvaluatorClosure) private FBody: IExpressionNode; - FParameters: TList; + FParameters: TArray; FClosureScope: TExecutionScope; function GetBody: IExpressionNode; - function GetParameters: TList; + function GetParameters: TArray; function GetClosureScope: TExecutionScope; public - constructor Create(ABody: IExpressionNode; AParameters: TList; AClosureScope: TExecutionScope); + constructor Create(ABody: IExpressionNode; const AParameters: TArray; AClosureScope: TExecutionScope); end; { TClosureValue } -constructor TClosureValue.Create(ABody: IExpressionNode; AParameters: TList; AClosureScope: TExecutionScope); +constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray; AClosureScope: TExecutionScope); begin inherited Create; FBody := ABody; - FParameters := AParameters; // Taking ownership of the list reference + FParameters := AParameters; FClosureScope := AClosureScope; end; @@ -95,7 +98,7 @@ begin Result := FClosureScope; end; -function TClosureValue.GetParameters: TList; +function TClosureValue.GetParameters: TArray; begin Result := FParameters; end; @@ -131,6 +134,22 @@ begin end; end; +function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; +var + varName: string; + value: TAstValue; +begin + // Evaluate the right-hand side of the assignment. + value := Node.Value.Accept(Self); + varName := Node.Identifier.Name; + + // Assign the value to the variable in the scope chain. + FScope.AssignValue(varName, value); + + // Assignment expressions return the assigned value. + Result := value; +end; + function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin Result := TAstValue.FromScalar(Node.Value); @@ -152,7 +171,6 @@ var initValue: TAstValue; begin varName := Node.Identifier.Name; - FScope.SetValue(varName, TAstValue.Undefined); if Assigned(Node.Initializer) then initValue := Node.Initializer.Accept(Self) else @@ -188,9 +206,9 @@ begin end; closure := calleeValue.AsClosure; - if (arguments.Count <> closure.Parameters.Count) then + if (arguments.Count <> Length(closure.Parameters)) then begin - raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [closure.Parameters.Count, arguments.Count]); + raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), arguments.Count]); end; callScope := TExecutionScope.Create(closure.ClosureScope); @@ -321,6 +339,7 @@ begin FLog := ALog; FIndentLevel := AInitialIndent; FShowScope := AShowScope; + ShowScope; end; function TDebugEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; @@ -380,6 +399,18 @@ begin end; end; +function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; +begin + AppendLine(Format('Assignment %s := {', [Node.Identifier.Name])); + Indent; + try + Result := inherited VisitAssignment(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.ToString])); +end; + function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin AppendLine(Format('Constant (%s)', [Node.Value.ToString])); @@ -450,7 +481,6 @@ begin AppendLine('FunctionCall{'); Indent; try - ShowScope; Result := inherited VisitFunctionCall(Node); finally Unindent; diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index f203862..525d15f 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -30,6 +30,7 @@ type 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; implementation @@ -192,4 +193,14 @@ begin Result := TAstValue.Undefined; end; +function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; +begin + // Print the assignment node. + AppendLine(Format('Assignment (%s)', [Node.Identifier.Name])); + Indent; + Node.Value.Accept(Self); + Unindent; + Result := TAstValue.Undefined; +end; + end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 6bf2cd9..745d1f1 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -42,6 +42,7 @@ type IFunctionCallNode = interface; IBlockExpressionNode = interface; IVariableDeclarationNode = interface; + IAssignmentNode = interface; // Represents an assignment to an existing variable. IEvaluatorClosure = interface; TExecutionScope = class; @@ -51,11 +52,11 @@ type IEvaluatorClosure = interface(IInterface) {$region 'private'} function GetBody: IExpressionNode; - function GetParameters: TList; + function GetParameters: TArray; function GetClosureScope: TExecutionScope; {$endregion} property Body: IExpressionNode read GetBody; - property Parameters: TList read GetParameters; + property Parameters: TArray read GetParameters; property ClosureScope: TExecutionScope read GetClosureScope; end; @@ -103,6 +104,7 @@ type 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; // --- AST Node Interfaces (now using TAstValue) --- @@ -163,10 +165,10 @@ type ILambdaExpressionNode = interface(IExpressionNode) {$region 'private'} - function GetParameters: TList; + function GetParameters: TArray; function GetBody: IExpressionNode; {$endregion} - property Parameters: TList read GetParameters; + property Parameters: TArray read GetParameters; property Body: IExpressionNode read GetBody; end; @@ -197,6 +199,16 @@ type property Initializer: IExpressionNode read GetInitializer; end; + // An assignment expression that returns the assigned value. + IAssignmentNode = interface(IExpressionNode) + {$region 'private'} + function GetIdentifier: IIdentifierNode; + function GetValue: IExpressionNode; + {$endregion} + property Identifier: IIdentifierNode read GetIdentifier; + property Value: IExpressionNode read GetValue; + end; + // Record acting as a namespace for the factory functions. TAst = record class function Constant(AValue: TScalar): IConstantNode; static; @@ -211,10 +223,11 @@ type const ACondition: IExpressionNode; const AThenBranch, AElseBranch: IExpressionNode ): IIfExpressionNode; static; - class function LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode): ILambdaExpressionNode; 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; end; // Manages the scope of execution, holding variables and their values. @@ -226,8 +239,12 @@ type public constructor Create(AParent: TExecutionScope = nil); destructor Destroy; override; + procedure Clear; function FindValue(const Name: string; out Value: TAstValue): Boolean; + // Sets or updates a value in the current scope. Used for declarations. procedure SetValue(const Name: string; const Value: TAstValue); + // Finds an existing variable in the scope chain and updates its value. Used for assignments. + procedure AssignValue(const Name: string; const Value: TAstValue); function Dump: string; end; @@ -304,13 +321,12 @@ type { TLambdaExpressionNode } TLambdaExpressionNode = class(TAstNode, ILambdaExpressionNode) private - FParameters: TList; + FParameters: TArray; FBody: IExpressionNode; - function GetParameters: TList; + function GetParameters: TArray; function GetBody: IExpressionNode; public - constructor Create(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode); - destructor Destroy; override; + constructor Create(const AParameters: TArray; const ABody: IExpressionNode); function Accept(const Visitor: IAstVisitor): TAstValue; override; end; @@ -350,6 +366,18 @@ type function Accept(const Visitor: IAstVisitor): TAstValue; override; end; + { TAssignmentNode } + TAssignmentNode = class(TAstNode, IAssignmentNode) + private + FIdentifier: IIdentifierNode; + FValue: IExpressionNode; + function GetIdentifier: IIdentifierNode; + function GetValue: IExpressionNode; + public + constructor Create(const AIdentifier: IIdentifierNode; const AValue: IExpressionNode); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + { TAstValue } class operator TAstValue.Initialize(out Dest: TAstValue); @@ -577,21 +605,11 @@ end; { TLambdaExpressionNode } -constructor TLambdaExpressionNode.Create(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode); -var - param: IIdentifierNode; +constructor TLambdaExpressionNode.Create(const AParameters: TArray; const ABody: IExpressionNode); begin inherited Create; FBody := ABody; - FParameters := TList.Create; - for param in AParameters do - FParameters.Add(param); -end; - -destructor TLambdaExpressionNode.Destroy; -begin - FParameters.Free; - inherited; + FParameters := AParameters; end; function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; @@ -604,7 +622,7 @@ begin Result := FBody; end; -function TLambdaExpressionNode.GetParameters: TList; +function TLambdaExpressionNode.GetParameters: TArray; begin Result := FParameters; end; @@ -695,8 +713,37 @@ begin Result := FInitializer; end; +{ TAssignmentNode } + +constructor TAssignmentNode.Create(const AIdentifier: IIdentifierNode; const AValue: IExpressionNode); +begin + inherited Create; + FIdentifier := AIdentifier; + FValue := AValue; +end; + +function TAssignmentNode.Accept(const Visitor: IAstVisitor): TAstValue; +begin + Result := Visitor.VisitAssignment(Self); +end; + +function TAssignmentNode.GetIdentifier: IIdentifierNode; +begin + Result := FIdentifier; +end; + +function TAssignmentNode.GetValue: IExpressionNode; +begin + Result := FValue; +end; + { TAst } +class function TAst.Assign(const AIdentifier: IIdentifierNode; const AValue: IExpressionNode): IAssignmentNode; +begin + Result := TAssignmentNode.Create(AIdentifier, AValue); +end; + class function TAst.Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode; begin Result := TBlockExpressionNode.Create(AExpressions); @@ -727,7 +774,7 @@ begin Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch); end; -class function TAst.LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode): ILambdaExpressionNode; +class function TAst.LambdaExpr(const AParameters: TArray; const ABody: IExpressionNode): ILambdaExpressionNode; begin Result := TLambdaExpressionNode.Create(AParameters, ABody); end; @@ -757,6 +804,23 @@ begin inherited Destroy; end; +procedure TExecutionScope.AssignValue(const Name: string; const Value: TAstValue); +begin + if FVariables.ContainsKey(Name) then + FVariables.AddOrSetValue(Name, Value) + else if Assigned(FParent) then + FParent.AssignValue(Name, Value) + else + raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]); +end; + +procedure TExecutionScope.Clear; +begin + FVariables.Clear; + if Assigned(FParent) then + FParent.Clear; +end; + procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); var pair: TPair;