Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Static specialization WIP

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-19 14:38:40 +01:00
parent c129c1a3ae
commit 138e7ac454
26 changed files with 2349 additions and 1110 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.delphilsp.json
+1 -1
View File
File diff suppressed because one or more lines are too long
ASTPlayground/ASTPlayground.dpr
+2 -1
View File
@@ -26,7 +26,8 @@ uses
Myc.Ast.Compiler.Lowering in '..\Src\AST\Myc.Ast.Compiler.Lowering.pas',
Myc.Ast.Compiler.TypeChecker in '..\Src\AST\Myc.Ast.Compiler.TypeChecker.pas',
Myc.Ast.Compiler.Macros in '..\Src\AST\Myc.Ast.Compiler.Macros.pas',
Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas';
Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas',
Myc.Ast.Compiler.Specializer in '..\Src\AST\Myc.Ast.Compiler.Specializer.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+1
View File
@@ -157,6 +157,7 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Compiler.TypeChecker.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Compiler.Macros.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Environment.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Compiler.Specializer.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
ASTPlayground/MainForm.fmx
+1 -1
View File
@@ -196,7 +196,7 @@ object Form1: TForm1
'Unbound'
'Expanded'
'Bound'
'Lowered')
'Specialized')
ItemIndex = 0
Position.X = 672.000000000000000000
Position.Y = 576.000000000000000000
ASTPlayground/MainForm.pas
+84 -66
View File
@@ -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
ASTPlayground/Myc.Fmx.AstEditor.Node.pas
-117
View File
@@ -80,8 +80,6 @@ type
function VisitConstant(const Node: IConstantNode): TAuraNode; override;
function VisitIdentifier(const Node: IIdentifierNode): TAuraNode; override;
function VisitKeyword(const Node: IKeywordNode): TAuraNode; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode; override;
function VisitIfExpression(const Node: IIfExpressionNode): TAuraNode; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode; override;
@@ -279,19 +277,6 @@ type
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
end;
{ TAuraBinaryExpressionNode }
TBinaryExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
private
FNode: IBinaryExpressionNode;
FLeftNode: TAuraNode; // Stores the visual child
FRightNode: TAuraNode; // Stores the visual child
function GetAstNode: IAstNode;
public
constructor Create(const ANode: IBinaryExpressionNode);
procedure BuildUI(OwnerNode: TAuraNode);
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
end;
{ TAuraBlockExpressionNode }
TBlockExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
private
@@ -305,18 +290,6 @@ type
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
end;
{ TAuraUnaryExpressionNode }
TUnaryExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
private
FNode: IUnaryExpressionNode;
FChildNode: TAuraNode; // Stores the single child
function GetAstNode: IAstNode;
public
constructor Create(const ANode: IUnaryExpressionNode);
procedure BuildUI(OwnerNode: TAuraNode);
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
end;
{ TAuraIfExpressionNode }
TIfExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
private
@@ -648,14 +621,6 @@ begin
Result := TAuraNode.Create(Self, Handler);
end;
function TAstVisualizer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode;
var
Handler: IAuraNodeHandler;
begin
Handler := TBinaryExpressionNodeHandler.Create(Node);
Result := TAuraNode.Create(Self, Handler);
end;
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode;
var
Handler: IAuraNodeHandler;
@@ -664,14 +629,6 @@ begin
Result := TAuraNode.Create(Self, Handler);
end;
function TAstVisualizer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode;
var
Handler: IAuraNodeHandler;
begin
Handler := TUnaryExpressionNodeHandler.Create(Node);
Result := TAuraNode.Create(Self, Handler);
end;
function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TAuraNode;
var
Handler: IAuraNodeHandler;
@@ -1404,44 +1361,6 @@ begin
Result := FNode; // Keywords are literals
end;
{ TBinaryExpressionNodeHandler }
constructor TBinaryExpressionNodeHandler.Create(const ANode: IBinaryExpressionNode);
begin
inherited Create;
FNode := ANode;
end;
function TBinaryExpressionNodeHandler.GetAstNode: IAstNode;
begin
Result := FNode;
end;
procedure TBinaryExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode);
var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := true;
OwnerNode.Orientation := loHorizontal;
// Create and store visual children
FLeftNode := visu.CallAccept(FNode.Left);
OwnerNode.AddLabel(OwnerNode, FNode.Operator.ToString);
FRightNode := visu.CallAccept(FNode.Right);
finally
OwnerNode.EndUpdate;
end;
end;
function TBinaryExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
begin
// Use the stored visual children to reconstruct the AST
Result := TAst.BinaryExpr(FLeftNode.CreateAst, FNode.Operator, FRightNode.CreateAst);
end;
{ TBlockExpressionNodeHandler }
constructor TBlockExpressionNodeHandler.Create(const ANode: IBlockExpressionNode);
@@ -1521,42 +1440,6 @@ begin
Result := TAst.Block(exprs);
end;
{ TUnaryExpressionNodeHandler }
constructor TUnaryExpressionNodeHandler.Create(const ANode: IUnaryExpressionNode);
begin
inherited Create;
FNode := ANode;
end;
function TUnaryExpressionNodeHandler.GetAstNode: IAstNode;
begin
Result := FNode;
end;
procedure TUnaryExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Unary Op: ' + FNode.Operator.ToString);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
FChildNode := visu.CallAccept(FNode.Right);
finally
OwnerNode.EndUpdate;
end;
end;
function TUnaryExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
begin
Result := TAst.UnaryExpr(FNode.Operator, FChildNode.CreateAst);
end;
{ TIfExpressionNodeHandler }
constructor TIfExpressionNodeHandler.Create(const ANode: IIfExpressionNode);
ASTPlayground/Myc.Fmx.AstEditor.Text.pas
-14
View File
@@ -17,8 +17,6 @@ type
function VisitConstant(const Node: IConstantNode): string; override;
function VisitIdentifier(const Node: IIdentifierNode): string; override;
function VisitKeyword(const Node: IKeywordNode): string; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): string; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): string; override;
function VisitIfExpression(const Node: IIfExpressionNode): string; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): string; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): string; override;
@@ -65,13 +63,6 @@ begin
Result := Node.Identifier.Name + ' := ' + Accept(Node.Value);
end;
function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): string;
begin
var leftStr := Accept(Node.Left);
var rightStr := Accept(Node.Right);
Result := '(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')';
end;
function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): string;
begin
Result := '{...}';
@@ -260,11 +251,6 @@ begin
Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]);
end;
function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): string;
begin
Result := Node.Operator.ToString + ' ' + Accept(Node.Right);
end;
function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): string;
var
initStr: string;