Static specialization WIP
This commit is contained in:
Michael Schimmel
+84
-66
@@ -117,12 +117,12 @@ type
|
||||
FTriggerTest: TAstEnvironment;
|
||||
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
|
||||
function CreateEnvironment: TAstEnvironment;
|
||||
// Helper function to encapsulate the Compile -> Evaluate pattern
|
||||
function ExecuteAst(const ANode: IAstNode): TDataValue;
|
||||
procedure UpdateScript;
|
||||
procedure ShowVizualization(X, Y: Single);
|
||||
procedure PrintScript(const Node: IAstNode);
|
||||
function CompileAstStage: IAstNode;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
@@ -175,7 +175,11 @@ begin
|
||||
[],
|
||||
TAst.Assign(
|
||||
TAst.Identifier('x'),
|
||||
TAst.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, TAst.Constant(5))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('+'),
|
||||
[TAst.Identifier('x'), TAst.Constant(5)]
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
@@ -206,19 +210,30 @@ begin
|
||||
FWorkspace.Repaint;
|
||||
end;
|
||||
|
||||
function TForm1.CompileAstStage: IAstNode;
|
||||
begin
|
||||
Result := FCurrUnboundAst;
|
||||
|
||||
if CompilerStageBox.ItemIndex > 0 then
|
||||
begin
|
||||
Result := FEnvironment.Environment.ExpandMacros(Result);
|
||||
|
||||
if CompilerStageBox.ItemIndex > 1 then
|
||||
begin
|
||||
var desc: IScopeDescriptor;
|
||||
Result := FEnvironment.Environment.Bind(Result, desc);
|
||||
|
||||
if CompilerStageBox.ItemIndex > 2 then
|
||||
Result := FEnvironment.Environment.Specialize(Result, desc);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.CompilerStageBoxChange(Sender: TObject);
|
||||
begin
|
||||
ShowVizualization(14, 14);
|
||||
end;
|
||||
|
||||
function TForm1.CreateEnvironment: TAstEnvironment;
|
||||
begin
|
||||
if DebugBox.IsChecked then
|
||||
Result.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
|
||||
else
|
||||
Result.SetStandardMode;
|
||||
end;
|
||||
|
||||
// Simplified ExecuteAst using TEnvironment
|
||||
function TForm1.ExecuteAst(const ANode: IAstNode): TDataValue;
|
||||
begin
|
||||
@@ -232,7 +247,8 @@ begin
|
||||
FEnvironment.SetStandardMode;
|
||||
|
||||
try
|
||||
FCurrExec := FEnvironment.Compile(ANode);
|
||||
var funcDef := TAst.LambdaExpr([], ANode);
|
||||
FCurrExec := FEnvironment.Compile(funcDef).Func;
|
||||
Result := FCurrExec([]);
|
||||
|
||||
except
|
||||
@@ -247,7 +263,7 @@ end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FEnvironment := CreateEnvironment;
|
||||
FEnvironment := TAstEnvironment.Construct(TAst.CreateScope(nil));
|
||||
|
||||
FWorkspace := TAuraWorkspace.Create(Panel2);
|
||||
FWorkspace.Parent := Panel2;
|
||||
@@ -255,8 +271,6 @@ begin
|
||||
FWorkspace.ClipChildren := true;
|
||||
FWorkspace.OnMouseDown := WorkspaceMouseDown;
|
||||
|
||||
RegisterRtlFunctions(FEnvironment.RootScope);
|
||||
|
||||
// Register the SMA factory into the environment
|
||||
var RegFunc :=
|
||||
procedure(const Scope: IExecutionScope)
|
||||
@@ -276,36 +290,45 @@ begin
|
||||
[
|
||||
TAst.Assign(
|
||||
TAst.Identifier('sum'),
|
||||
TAst.BinaryExpr(TAst.Identifier('sum'), TScalar.TBinaryOp.Add, TAst.Identifier('val'))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('sum'), TAst.Identifier('val')])
|
||||
),
|
||||
TAst.Assign(
|
||||
TAst.Identifier('count'),
|
||||
TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Add, TAst.Constant(1))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('count'), TAst.Constant(1)])
|
||||
),
|
||||
TAst.Assign(
|
||||
TAst.Identifier('sum'),
|
||||
TAst.TernaryExpr(
|
||||
TAst.BinaryExpr(
|
||||
TAst.Identifier('count'),
|
||||
TScalar.TBinaryOp.Greater,
|
||||
TAst.Identifier('len')
|
||||
),
|
||||
TAst.BinaryExpr(
|
||||
TAst.Identifier('sum'),
|
||||
TScalar.TBinaryOp.Subtract,
|
||||
TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('>'), [TAst.Identifier('count'), TAst.Identifier('len')]),
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('-'),
|
||||
[
|
||||
TAst.Identifier('sum'),
|
||||
TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
|
||||
]
|
||||
),
|
||||
TAst.Identifier('sum')
|
||||
)
|
||||
),
|
||||
TAst.BinaryExpr(
|
||||
TAst.Identifier('sum'),
|
||||
TScalar.TBinaryOp.Divide,
|
||||
TAst.TernaryExpr(
|
||||
TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Less, TAst.Identifier('len')),
|
||||
TAst.Identifier('count'),
|
||||
TAst.Identifier('len')
|
||||
)
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('/'),
|
||||
[
|
||||
TAst.Identifier('sum'),
|
||||
TAst.TernaryExpr(
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('<'),
|
||||
[TAst.Identifier('count'), TAst.Identifier('len')]
|
||||
),
|
||||
TAst.Identifier('count'),
|
||||
TAst.Identifier('len')
|
||||
)
|
||||
]
|
||||
)
|
||||
]
|
||||
)
|
||||
@@ -590,10 +613,10 @@ begin
|
||||
raise EJSONParseException.Create('Invalid JSON format.');
|
||||
|
||||
try
|
||||
var unboundAst := converter.Deserialize(jsonObj);
|
||||
FCurrUnboundAst := converter.Deserialize(jsonObj);
|
||||
|
||||
// Run the full pipeline
|
||||
FCurrExec := FEnvironment.Compile(unboundAst);
|
||||
FCurrExec := FEnvironment.Compile(FCurrUnboundAst).Func;
|
||||
|
||||
Memo1.Lines.Add('AST deserialized and bound successfully from JSON.');
|
||||
Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.');
|
||||
@@ -658,7 +681,7 @@ begin
|
||||
end;
|
||||
|
||||
// Dump the compiled AST from the executable
|
||||
TAstDumper.Dump(FCurrUnboundAst, Memo1.Lines);
|
||||
TAstDumper.Dump(CompileAstStage, Memo1.Lines);
|
||||
end;
|
||||
|
||||
procedure TForm1.FibonacciButtonClick(Sender: TObject);
|
||||
@@ -676,8 +699,8 @@ begin
|
||||
(def fib)
|
||||
(assign fib (fn [n]
|
||||
(? (< n 2)
|
||||
n
|
||||
(+ (fib (- n 1)) (fib (- n 2)))
|
||||
n
|
||||
(+ (fib (- n 1)) (fib (- n 2)))
|
||||
)
|
||||
))
|
||||
)
|
||||
@@ -690,7 +713,7 @@ begin
|
||||
|
||||
Memo1.Lines.Add('--- Naive recursive fib with AST---');
|
||||
|
||||
var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]));
|
||||
var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])).Func;
|
||||
|
||||
sw := TStopwatch.StartNew;
|
||||
result := fibExec([]);
|
||||
@@ -705,7 +728,7 @@ begin
|
||||
|
||||
memoizeTest.Define('fib', TAstScript.Parse('(Memoize fib)'));
|
||||
|
||||
var memoizeExec := memoizeTest.Compile(TAstScript.Parse('(fib 25)'));
|
||||
var memoizeExec := memoizeTest.Compile(TAstScript.Parse('(fib 25)')).Func;
|
||||
|
||||
sw := TStopwatch.StartNew;
|
||||
result := memoizeExec([]);
|
||||
@@ -738,12 +761,15 @@ begin
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('n'), TAst.Identifier('acc')],
|
||||
TAst.TernaryExpr(
|
||||
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.LessOrEqual, TAst.Constant(1)),
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('<='), [TAst.Identifier('n'), TAst.Constant(1)]),
|
||||
TAst.Identifier('acc'), // Base case: return the accumulator
|
||||
TAst.Recur( // Tail-recursive step
|
||||
[
|
||||
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1)),
|
||||
TAst.BinaryExpr(TAst.Identifier('acc'), TScalar.TBinaryOp.Multiply, TAst.Identifier('n'))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('-'), [TAst.Identifier('n'), TAst.Constant(1)]),
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('*'), [TAst.Identifier('acc'), TAst.Identifier('n')])
|
||||
]
|
||||
)
|
||||
)
|
||||
@@ -834,7 +860,7 @@ begin
|
||||
'''
|
||||
);
|
||||
|
||||
var fn := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]);
|
||||
var fn := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]).Func;
|
||||
|
||||
fn(['Hello World']);
|
||||
|
||||
@@ -865,7 +891,8 @@ begin
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(100)),
|
||||
TAst.BinaryExpr(TAst.Identifier('baseValue'), TScalar.TBinaryOp.Add, TAst.Identifier('offset'))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('baseValue'), TAst.Identifier('offset')])
|
||||
]
|
||||
)
|
||||
)
|
||||
@@ -932,7 +959,7 @@ begin
|
||||
|
||||
var seriesAddress := env.RootScope.Define('current_series', TDataValue.Void);
|
||||
|
||||
var callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]));
|
||||
var callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')])).Func;
|
||||
|
||||
// Simulation Loop
|
||||
Memo1.Lines.Clear;
|
||||
@@ -1007,8 +1034,10 @@ begin
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('n')],
|
||||
TAst.IfExpr(
|
||||
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Greater, TAst.Constant(0)),
|
||||
TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]),
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('>'), [TAst.Identifier('n'), TAst.Constant(0)]),
|
||||
// --- Ersetzt ---
|
||||
TAst.Recur([TAst.FunctionCall(TAst.Identifier('-'), [TAst.Identifier('n'), TAst.Constant(1)])]),
|
||||
TAst.Constant(0)
|
||||
)
|
||||
)
|
||||
@@ -1041,7 +1070,8 @@ begin
|
||||
[TAst.Identifier('summand')],
|
||||
TAst.Assign(
|
||||
TAst.Identifier('X'),
|
||||
TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, TAst.Identifier('summand'))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('X'), TAst.Identifier('summand')])
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -1055,7 +1085,8 @@ begin
|
||||
'tickHandler',
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('summand')],
|
||||
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, TAst.Identifier('summand')))
|
||||
// --- Ersetzt ---
|
||||
TAst.Assign(TAst.Identifier('X'), TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('X'), TAst.Identifier('summand')]))
|
||||
)
|
||||
);
|
||||
|
||||
@@ -1142,7 +1173,8 @@ begin
|
||||
[], // Inner closure that is returned
|
||||
TAst.Assign(
|
||||
TAst.Identifier('a'),
|
||||
TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Constant(5))
|
||||
// --- Ersetzt ---
|
||||
TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('a'), TAst.Constant(5)])
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -1285,21 +1317,7 @@ begin
|
||||
if FCurrUnboundAst = nil then
|
||||
exit;
|
||||
|
||||
var ast := FCurrUnboundAst;
|
||||
|
||||
if CompilerStageBox.ItemIndex > 0 then
|
||||
ast := FEnvironment.Environment.ExpandMacros(ast);
|
||||
|
||||
if CompilerStageBox.ItemIndex > 1 then
|
||||
begin
|
||||
var desc: IScopeDescriptor;
|
||||
ast := FEnvironment.Environment.Bind(ast, desc);
|
||||
end;
|
||||
|
||||
if CompilerStageBox.ItemIndex > 2 then
|
||||
ast := FEnvironment.Environment.Lower(ast);
|
||||
|
||||
FWorkspace.Build(ast, TPointF.Create(X, Y));
|
||||
FWorkspace.Build(CompileAstStage, TPointF.Create(X, Y));
|
||||
//
|
||||
// if FCurrExec <> nil then
|
||||
// begin
|
||||
|
||||
Reference in New Issue
Block a user