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

AST development

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-01 11:11:38 +02:00
parent 7c531c1207
commit d5f2763aa2
2 changed files with 184 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+39 -25
View File
@@ -193,16 +193,19 @@ begin
[TAst.Identifier('n')],
TAst.IfExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.Identifier('n'),
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.VarDecl(TAst.Identifier('Result'), TAst.Identifier('n')),
TAst.VarDecl(
TAst.Identifier('Result'),
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)))]
)
)
)
)
@@ -274,17 +277,25 @@ begin
TAst.Identifier('factorial'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
TAst.IfExpr(
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.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))),
TAst.Assign(
TAst.Identifier('Result'),
TAst.BinaryExpr(
TAst.Identifier('n'),
boMultiply,
TAst.FunctionCall(
TAst.Identifier('factorial'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
)
)
)
)
]
)
)
),
@@ -365,11 +376,14 @@ begin
TAst.Identifier('createStrategyInstance'),
TAst.LambdaExpr(
[TAst.Identifier('offset')],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TScalar.FromInt64(100))),
TAst.BinaryExpr(TAst.Identifier('baseValue'), boAdd, TAst.Identifier('offset'))
]
Tast.VarDecl(
TAst.Identifier('Result'),
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TScalar.FromInt64(100))),
TAst.BinaryExpr(TAst.Identifier('baseValue'), boAdd, TAst.Identifier('offset'))
]
)
)
)
),
ASTPlayground/Myc.Ast.Visualizer.pas
+145 -50
View File
@@ -16,7 +16,6 @@ uses
DraggablePanel;
type
// ... TPinConnection, TPinShape, TPinAlignment, TAuraWorkspace ...
TPinConnection = record
OutputPin: TControl;
InputPin: TControl;
@@ -35,6 +34,7 @@ type
TAuraNodeList = TList<TAuraNode>;
TCreateParentNodeProc = reference to function(const InputNodes: TAuraNodeList): TAuraNode;
TVerticalAlignment = (vaCenter, vaTop);
private
const
// Pin Visuals
@@ -50,6 +50,7 @@ type
// Specific Node Heights
cDefaultNodeHeight = 45; // Default height for simple nodes like BinaryExpr
cIfNodeHeight = 60; // Taller height for If nodes with more pins
private
FWorkspace: TAuraWorkspace;
FParentControl: TControl;
@@ -57,9 +58,14 @@ type
FSpacing: TPointF;
FLastNode: TAuraNode;
FConnections: TList<TPinConnection>;
FCurrentExec: TControl;
FCurrentExec: TList<TControl>;
function VisitContainerNode(const Title, Details: string; const ChildVisitorProc: TChildVisitorProc): TAuraNode;
function VisitContainerNode(
const Title, Details: string;
const InPin, OutPin: String;
IsExec: Boolean;
const ChildVisitorProc: TChildVisitorProc
): TAuraNode;
function VisitOperatorNode(
const InputExpressions: TArray<IExpressionNode>;
const CreateParentProc: TCreateParentNodeProc;
@@ -79,7 +85,7 @@ type
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): TControl;
function CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0; connect: Boolean = true): TControl;
function CreateExit(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
function FindPinByTag(ParentNode: TAuraNode; const Tag: string): TControl;
@@ -89,8 +95,11 @@ type
AWorkspace: TAuraWorkspace;
AParentControl: TControl;
const AStartPosition: TPointF;
AConnections: TList<TPinConnection>
AConnections: TList<TPinConnection>;
const ACurrentExec: TArray<TControl>
);
destructor Destroy; override;
// Public access to the collected connections
property Connections: TList<TPinConnection> read FConnections;
@@ -172,7 +181,8 @@ constructor TAstToAuraNodeVisitor.Create(
AWorkspace: TAuraWorkspace;
AParentControl: TControl;
const AStartPosition: TPointF;
AConnections: TList<TPinConnection>
AConnections: TList<TPinConnection>;
const ACurrentExec: TArray<TControl>
);
begin
inherited Create;
@@ -181,6 +191,13 @@ begin
FCurrentPos := AStartPosition;
FSpacing := TPointF.Create(20, 10); // Horizontal indent, Vertical spacing
FConnections := AConnections;
FCurrentExec := TList<TControl>.Create(ACurrentExec);
end;
destructor TAstToAuraNodeVisitor.Destroy;
begin
FCurrentExec.Free;
inherited;
end;
function TAstToAuraNodeVisitor.BuildNodeControl(const Title, Details: string): TAuraNode;
@@ -244,11 +261,16 @@ begin
Result := CreatePin(ParentNode, psCircle, paRight, cDataPinColor, 'data.out', OffsetY);
end;
function TAstToAuraNodeVisitor.CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0): TControl;
function TAstToAuraNodeVisitor.CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0; connect: Boolean = true): TControl;
begin
Result := CreatePin(ParentNode, psTriangle, paLeft, cExecPinColor, 'exec.in', OffsetY);
if FCurrentExec <> nil then
FConnections.Add(TPinConnection.Create(FCurrentExec, Result));
if connect then
begin
// Connect all open exits to this new entry
for var curr in FCurrentExec do
FConnections.Add(TPinConnection.Create(curr, Result));
FCurrentExec.Clear;
end;
end;
function TAstToAuraNodeVisitor.CreateExit(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
@@ -258,7 +280,7 @@ begin
cap := '.' + cap;
Result := CreatePin(ParentNode, psTriangle, paRight, cExecPinColor, 'exec.out' + cap, OffsetY);
FCurrentExec := Result;
FCurrentExec.Add(Result);
end;
function TAstToAuraNodeVisitor.CreatePin(
@@ -342,9 +364,9 @@ begin
valueNode := InputNodes[0];
assignmentNode := BuildNodeControl('Assignment', Node.Identifier.Name);
CreateEntry(assignmentNode, 0);
CreateEntry(assignmentNode, -8);
CreateExit(assignmentNode, '', 0);
inputPin := CreateInput(assignmentNode, Node.Identifier.Name, 0);
inputPin := CreateInput(assignmentNode, Node.Identifier.Name, 8);
ConnectData(inputPin, valueNode);
Result := assignmentNode;
@@ -387,10 +409,16 @@ var
blockNode: TAuraNode;
begin
// Use the helper to create and populate the container node.
// InPin and OutPin set: block acts as "virtual execution scope" with entry and exit-nodes
// InPin and OutPin empty: block acts as a simple container
blockNode :=
VisitContainerNode(
'Block',
'',
// 'enter', 'exit',
'',
'',
true,
procedure(const Visitor: IAstVisitor)
var
expression: IExpressionNode;
@@ -418,7 +446,12 @@ begin
Result := TAstValue.Void;
end;
function TAstToAuraNodeVisitor.VisitContainerNode(const Title, Details: string; const ChildVisitorProc: TChildVisitorProc): TAuraNode;
function TAstToAuraNodeVisitor.VisitContainerNode(
const Title, Details: string;
const InPin, OutPin: String;
IsExec: Boolean;
const ChildVisitorProc: TChildVisitorProc
): TAuraNode;
var
containerNode: TAuraNode;
childVisitor: IAstVisitor;
@@ -427,16 +460,46 @@ var
maxBottom: Single;
control: TControl;
begin
const pinNodeHeight = cPinSize + cVerticalPadding;
// Step 1: Create container node
containerNode := BuildNodeControl(Title, Details);
containerNode.Position.Point := FCurrentPos;
Result := containerNode; // Set result early
childStartPos :=
TPointF.Create(FSpacing.X, FSpacing.Y + max(IfThen(InPin <> '', pinNodeHeight, 0), IfThen(Title <> '', cVerticalPadding, 0)));
var currExec := FCurrentExec.ToArray;
if InPin <> '' then
begin
// Create a small entry node to define the start of the execution flow inside the container.
var entryNode := BuildNodeControl(InPin, '');
entryNode.Parent := containerNode;
entryNode.Position.Point := TPointF.Create(0, 0);
entryNode.Height := pinNodeHeight;
if IsExec then
begin
var entryPin := CreateEntry(containerNode, 0);
var entryExitPin := CreateExit(entryNode, '', 0);
entryPin.Position.Y := containerNode.AbsoluteToLocal(entryNode.LocalToAbsolute(entryExitPin.Position.Point)).Y;
end
else
begin
FCurrentExec.Clear;
CreateExit(entryNode, '', 0);
end;
end;
// Step 2: Create child visitor and run the closure.
childStartPos := TPointF.Create(FSpacing.X, FSpacing.Y + containerNode.TitleFont.Size * 1.8);
childVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, containerNode, childStartPos, FConnections);
// The child visitor starts its execution flow from the entry node's exit pin.
childVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, containerNode, childStartPos, FConnections, FCurrentExec.ToArray);
ChildVisitorProc(childVisitor);
FCurrentExec.Clear;
FCurrentExec.AddRange((childVisitor as TAstToAuraNodeVisitor).FCurrentExec);
// Step 3: Adjust the size of the container node to fit children.
maxRight := 0;
maxBottom := 0;
@@ -448,9 +511,28 @@ begin
maxBottom := Max(maxBottom, control.Position.Y + control.Height);
end;
end;
// The width must be at least the title width, and large enough for children.
containerNode.Width := Max(containerNode.Width, maxRight + FSpacing.X);
containerNode.Height := Max(containerNode.Height, maxBottom + FSpacing.Y);
containerNode.Height := Max(containerNode.Height, maxBottom + FSpacing.Y + IfThen(OutPin <> '', pinNodeHeight, 0));
if OutPin <> '' then
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);
if not IsExec then
begin
FCurrentExec.Clear;
FCurrentExec.AddRange(currExec);
end
else
CreateExit(containerNode, '', 0).Position.Y :=
containerNode.AbsoluteToLocal(exitNode.LocalToAbsolute(exitPin.Position.Point)).Y;
end
end;
function TAstToAuraNodeVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
@@ -509,63 +591,64 @@ end;
function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
begin
CreateNodeControl('Identifier', Node.Name);
var identifierNode := CreateNodeControl('Identifier', Node.Name);
// Add a data output pin on the right side.
CreateOutput(FLastNode, 0);
CreateOutput(identifierNode, 0);
Result := TAstValue.Void;
end;
function TAstToAuraNodeVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
var
ifNode: TAuraNode;
conditionInputPin, thenOutputPin, elseOutputPin: TControl;
startPosition: TPointF;
thenEndY, elseEndY: Single;
begin
startPosition := FCurrentPos;
var startPosition := FCurrentPos;
// Use helper for the condition part
VisitOperatorNode(
[Node.Condition],
function(const InputNodes: TAuraNodeList): TAuraNode
var
condNode: TAuraNode;
begin
condNode := InputNodes[0];
var ifNode :=
VisitOperatorNode(
[Node.Condition],
function(const InputNodes: TAuraNodeList): TAuraNode
var
condNode: TAuraNode;
conditionInputPin: TControl;
begin
condNode := InputNodes[0];
ifNode := BuildNodeControl('If', '');
ifNode.Height := cIfNodeHeight;
CreateEntry(ifNode, -12);
conditionInputPin := CreateInput(ifNode, 'Condition', 12);
thenOutputPin := CreateExit(ifNode, 'Then', -12);
if Assigned(Node.ElseBranch) then
elseOutputPin := CreateExit(ifNode, 'Else', 12)
else
elseOutputPin := nil;
Result := BuildNodeControl('If', '');
Result.Height := cIfNodeHeight;
CreateEntry(Result, -12);
ConnectData(conditionInputPin, condNode);
Result := ifNode;
end
);
conditionInputPin := CreateInput(Result, 'Condition', 12);
ConnectData(conditionInputPin, condNode);
end
);
var 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<TControl>.Create;
// Then branch
FCurrentExec.Clear;
CreateExit(ifNode, 'Then', -12);
FCurrentPos.X := branchStartX;
FCurrentPos.Y := startPosition.Y;
Node.ThenBranch.Accept(Self);
thenEndY := FCurrentPos.Y;
var thenEndY := FCurrentPos.Y;
FLastNode := ifNode;
execPathes.AddRange(FCurrentExec);
// Else branch (if it exists)
elseEndY := thenEndY;
var elseEndY := thenEndY;
if Assigned(Node.ElseBranch) then
begin
FCurrentExec.Clear;
CreateExit(ifNode, 'Else', 12);
FCurrentPos.X := branchStartX;
FCurrentPos.Y := thenEndY;
Node.ElseBranch.Accept(Self);
elseEndY := FCurrentPos.Y;
execPathes.AddRange(FCurrentExec);
end;
// Finalize visitor state.
@@ -573,6 +656,11 @@ begin
FCurrentPos.Y := Max(conditionEndY, elseEndY);
FLastNode := ifNode;
// After a branch, the execution flow has diverged. There is no single
// execution pin to continue from, so we set it to nil.
FCurrentExec.Clear;
FCurrentExec.AddRange(execPathes);
Result := TAstValue.Void;
end;
@@ -593,7 +681,15 @@ begin
paramStr := paramStr + ')';
// Use the helper to create and populate the container node.
lambdaNode := VisitContainerNode('Lambda', paramStr, procedure(const Visitor: IAstVisitor) begin Node.Body.Accept(Visitor); end);
lambdaNode :=
VisitContainerNode(
'Lambda',
paramStr,
'call',
'return',
false,
procedure(const Visitor: IAstVisitor) begin Node.Body.Accept(Visitor); end
);
CreateOutput(lambdaNode, 0);
@@ -710,7 +806,7 @@ procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF
begin
var connections := TList<TPinConnection>.Create;
try
Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections));
Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil));
FConnections := FConnections + connections.ToArray;
finally
connections.Free;
@@ -759,8 +855,7 @@ begin
// Draw a Bezier curve with horizontal tangents at start and end points.
path := TPathData.Create;
try
deltaX := endPoint.X - startPoint.X;
controlOffset := max(30, abs(deltaX) / 2);
controlOffset := max(25, 0.5 * endPoint.Distance(startPoint));
controlPoint1 := TPointF.Create(startPoint.X + controlOffset, startPoint.Y);
controlPoint2 := TPointF.Create(endPoint.X - controlOffset, endPoint.Y);