AST-Playground
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,16 @@
|
||||
program ASTPlayground;
|
||||
|
||||
uses
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
MainForm in 'MainForm.pas' {Form1},
|
||||
Myc.Ast.Evaluator in '..\Src\AST\Myc.Ast.Evaluator.pas',
|
||||
Myc.Ast.Printer in '..\Src\AST\Myc.Ast.Printer.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,88 @@
|
||||
object Form1: TForm1
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 638
|
||||
ClientWidth = 925
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
DesignerMasterStyle = 0
|
||||
object Panel1: TPanel
|
||||
Align = Left
|
||||
Size.Width = 137.000000000000000000
|
||||
Size.Height = 638.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 1
|
||||
object Test1Button: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 32.000000000000000000
|
||||
TabOrder = 1
|
||||
Text = 'Test 1'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = Test1ButtonClick
|
||||
end
|
||||
object Test2Button: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 62.000000000000000000
|
||||
TabOrder = 2
|
||||
Text = 'Test 2'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = Test2ButtonClick
|
||||
end
|
||||
object PrettyPrintButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 168.000000000000000000
|
||||
TabOrder = 3
|
||||
Text = 'Print'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = PrettyPrintButtonClick
|
||||
end
|
||||
object DebugButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 198.000000000000000000
|
||||
TabOrder = 4
|
||||
Text = 'Debug'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = DebugButtonClick
|
||||
end
|
||||
object RecursionButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 92.000000000000000000
|
||||
Size.Width = 80.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 5
|
||||
Text = 'Recursion'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = RecursionButtonClick
|
||||
end
|
||||
object ShowScopeBox: TCheckBox
|
||||
Position.X = 32.000000000000000000
|
||||
Position.Y = 224.000000000000000000
|
||||
TabOrder = 6
|
||||
Text = 'Scope'
|
||||
end
|
||||
object FibonacciButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 122.000000000000000000
|
||||
TabOrder = 8
|
||||
Text = 'Fibonacci'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = FibonacciButtonClick
|
||||
end
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
StyledSettings = [Size, Style, FontColor]
|
||||
TextSettings.Font.Family = 'Consolas'
|
||||
Align = Client
|
||||
Size.Width = 788.000000000000000000
|
||||
Size.Height = 638.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 2
|
||||
Viewport.Width = 784.000000000000000000
|
||||
Viewport.Height = 634.000000000000000000
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,340 @@
|
||||
unit MainForm;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Types,
|
||||
System.UITypes,
|
||||
System.Classes,
|
||||
System.Variants,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.Forms,
|
||||
FMX.Graphics,
|
||||
FMX.Dialogs,
|
||||
FMX.Memo.Types,
|
||||
FMX.StdCtrls,
|
||||
FMX.ScrollBox,
|
||||
FMX.Memo,
|
||||
FMX.Controls.Presentation,
|
||||
Myc.Data.Types,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Evaluator,
|
||||
Myc.Ast.Printer;
|
||||
|
||||
type
|
||||
TForm1 = class(TForm)
|
||||
Panel1: TPanel;
|
||||
Memo1: TMemo;
|
||||
Test1Button: TButton;
|
||||
Test2Button: TButton;
|
||||
PrettyPrintButton: TButton;
|
||||
DebugButton: TButton;
|
||||
RecursionButton: TButton;
|
||||
ShowScopeBox: TCheckBox;
|
||||
FibonacciButton: TButton;
|
||||
procedure DebugButtonClick(Sender: TObject);
|
||||
procedure FibonacciButtonClick(Sender: TObject);
|
||||
procedure PrettyPrintButtonClick(Sender: TObject);
|
||||
procedure RecursionButtonClick(Sender: TObject);
|
||||
procedure Test1ButtonClick(Sender: TObject);
|
||||
procedure Test2ButtonClick(Sender: TObject);
|
||||
private
|
||||
// Stores the last AST generated by Test1 or Test2 button clicks.
|
||||
FLastAst: IAstNode;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
procedure TForm1.DebugButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
result: IDataValue;
|
||||
begin
|
||||
if not Assigned(FLastAst) then
|
||||
begin
|
||||
Memo1.Lines.Add('No AST has been generated yet.');
|
||||
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
scope := TExecutionScope.Create(nil);
|
||||
try
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('--- Debug Evaluator Trace ---');
|
||||
|
||||
// Create the DEBUG visitor, passing the Memo's Lines as the log output
|
||||
visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0);
|
||||
|
||||
result := FLastAst.Accept(visitor);
|
||||
|
||||
Memo1.Lines.Add('-----------------------------');
|
||||
Memo1.Lines.Add('Final script result: ' + result.AsString);
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FibonacciButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
root: IExpressionNode;
|
||||
result: IDataValue;
|
||||
begin
|
||||
// This test defines and calls a deeply recursive fibonacci function.
|
||||
// var fib = func(n) {
|
||||
// if (n < 2) then n else fib(n - 1) + fib(n - 2)
|
||||
// };
|
||||
// fib(10);
|
||||
root :=
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('fib'),
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('n')],
|
||||
TAst.IfExpr(
|
||||
// Condition: n < 2
|
||||
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TDataType.Ordinal.CreateValue(2))),
|
||||
// Then branch: n
|
||||
TAst.Identifier('n'),
|
||||
// Else branch: fib(n - 1) + fib(n - 2)
|
||||
TAst.BinaryExpr(
|
||||
// fib(n - 1)
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('fib'),
|
||||
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(1)))]
|
||||
),
|
||||
boAdd,
|
||||
// fib(n - 2)
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('fib'),
|
||||
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(2)))]
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
// Call the function
|
||||
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TDataType.Ordinal.CreateValue(10))])
|
||||
]
|
||||
);
|
||||
|
||||
FLastAst := root;
|
||||
|
||||
scope := TExecutionScope.Create(nil);
|
||||
try
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('--- Recursive fib(10) ---');
|
||||
visitor := TEvaluatorVisitor.Create(scope);
|
||||
result := root.Accept(visitor);
|
||||
Memo1.Lines.Add('Result: ' + result.AsString); // Should be 55
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
|
||||
var
|
||||
visitor: TPrettyPrintVisitor;
|
||||
begin
|
||||
// This button now prints the AST that was stored in FLastAst.
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('--- AST Pretty Print ---');
|
||||
|
||||
if not Assigned(FLastAst) then
|
||||
begin
|
||||
Memo1.Lines.Add('No AST has been generated yet.');
|
||||
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
visitor := TPrettyPrintVisitor.Create;
|
||||
try
|
||||
FLastAst.Accept(visitor);
|
||||
Memo1.Lines.Add(visitor.GetResult);
|
||||
finally
|
||||
// Visitor is an interfaced object and managed automatically.
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.RecursionButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
root: IExpressionNode;
|
||||
result: IDataValue;
|
||||
begin
|
||||
// This test defines and calls a recursive factorial function.
|
||||
// var factorial = func(n) {
|
||||
// if (n < 2) then 1 else n * factorial(n - 1)
|
||||
// };
|
||||
// factorial(5);
|
||||
root :=
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('factorial'),
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('n')],
|
||||
TAst.IfExpr(
|
||||
// Condition: n < 2
|
||||
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TDataType.Ordinal.CreateValue(2))),
|
||||
// Then branch: 1
|
||||
TAst.Constant(TDataType.Ordinal.CreateValue(1)),
|
||||
// Else branch: n * factorial(n - 1)
|
||||
TAst.BinaryExpr(
|
||||
TAst.Identifier('n'),
|
||||
boMultiply,
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('factorial'), // Recursive call
|
||||
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(1)))]
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
// Call the function
|
||||
TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TDataType.Ordinal.CreateValue(6))])
|
||||
]
|
||||
);
|
||||
|
||||
FLastAst := root;
|
||||
|
||||
scope := TExecutionScope.Create(nil);
|
||||
try
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('--- Recursive factorial(6) ---');
|
||||
visitor := TEvaluatorVisitor.Create(scope);
|
||||
result := root.Accept(visitor);
|
||||
Memo1.Lines.Add('Result: ' + result.AsString);
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.Test1ButtonClick(Sender: TObject);
|
||||
var
|
||||
root: IAstNode;
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
result: IDataValue;
|
||||
begin
|
||||
// With the new expression-oriented AST, the entire logic can be
|
||||
// represented as a single block expression. The block itself
|
||||
// evaluates to the value of its last expression.
|
||||
root :=
|
||||
TAst.Block(
|
||||
[
|
||||
// var a := 10; (this expression returns void)
|
||||
TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TDataType.Ordinal.CreateValue(10))),
|
||||
// var b := a * 2; (this expression also returns void)
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('b'),
|
||||
TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TDataType.Ordinal.CreateValue(2)))
|
||||
),
|
||||
// a + b; (this is the last expression, its value becomes the block's value)
|
||||
TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b'))
|
||||
]
|
||||
);
|
||||
|
||||
// Store the generated AST for the pretty printer.
|
||||
FLastAst := root;
|
||||
|
||||
// Evaluate the entire AST with a single call
|
||||
scope := TExecutionScope.Create(nil);
|
||||
try
|
||||
visitor := TEvaluatorVisitor.Create(scope);
|
||||
result := root.Accept(visitor);
|
||||
|
||||
// Display the result
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('AST execution result:');
|
||||
if Assigned(result) then
|
||||
Memo1.Lines.Add(result.AsString)
|
||||
else
|
||||
Memo1.Lines.Add('<no result>');
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.Test2ButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
root: IExpressionNode;
|
||||
result: IDataValue;
|
||||
begin
|
||||
// The entire logic is now encapsulated in a single AST.
|
||||
// This script defines a factory function, then calls it twice.
|
||||
root :=
|
||||
TAst.Block(
|
||||
[
|
||||
// 1. Define the factory and assign it to a variable 'createStrategyInstance'
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('createStrategyInstance'),
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('offset')], // The factory parameter
|
||||
TAst.Block(
|
||||
[
|
||||
// The body of the factory defines the strategy logic
|
||||
TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TDataType.Ordinal.CreateValue(100))),
|
||||
TAst.BinaryExpr(TAst.Identifier('baseValue'), boAdd, TAst.Identifier('offset'))
|
||||
]
|
||||
)
|
||||
)
|
||||
),
|
||||
// 2. Call the factory with the first parameter set.
|
||||
// The result of this expression (120) is calculated but discarded by the block.
|
||||
TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TDataType.Ordinal.CreateValue(20))]),
|
||||
// 3. Call the factory with the second parameter set.
|
||||
// As this is the last expression, its result (155) becomes the result of the entire block.
|
||||
TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TDataType.Ordinal.CreateValue(55))])
|
||||
]
|
||||
);
|
||||
|
||||
// Store the complete AST for the pretty printer.
|
||||
FLastAst := root;
|
||||
|
||||
// Evaluate the AST.
|
||||
scope := TExecutionScope.Create(nil);
|
||||
try
|
||||
visitor := TEvaluatorVisitor.Create(scope);
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('Factory Pattern Demo (Single AST):');
|
||||
|
||||
result := root.Accept(visitor);
|
||||
|
||||
Memo1.Lines.Add('The entire script has been executed.');
|
||||
Memo1.Lines.Add('Result of the final expression: ' + result.AsString);
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user