Files
MycLib/ASTPlayground/Myc.Fmx.AstEditor.pas
T
Michael Schimmel 81dd69bf49 RECUR keyword added
2025-09-20 12:06:51 +02:00

1204 lines
45 KiB
ObjectPascal

unit Myc.Fmx.AstEditor;
interface
uses
System.SysUtils,
System.Classes,
System.UITypes,
System.Types,
System.Math.Vectors,
System.Generics.Collections,
System.Generics.Defaults,
FMX.Types,
FMX.Controls,
FMX.Objects,
FMX.Graphics,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace;
const
// Pin Visuals
cPinSize = 10;
cDataPinColor = TAlphaColors.Dodgerblue;
cExecPinColor = TAlphaColors.Lightgreen;
type
TPinShape = (psCircle, psTriangle);
TPinAlignment = (paLeft, paRight);
TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor)
public
type
TAuraNodeResult = record
LayoutNode: TAuraNode;
OutputPin: TControl;
end;
TAuraNodeResultList = TList<TAuraNodeResult>;
TChildVisitorProc = reference to procedure(const Visitor: IAstVisitor);
TCreateParentNodeProc = reference to function(const InputNodes: TAuraNodeResultList): TAuraNodeResult;
TVerticalAlignment = (vaCenter, vaTop);
private
const
cHorizontalPadding = 25;
cPinOffsetY = 18;
cVerticalPadding = 10;
cDefaultNodeHeight = 25;
cIfNodeHeight = 40;
private
FWorkspace: TAuraWorkspace;
FParentControl: TControl;
FCurrentPos: TPointF;
FSpacing: TPointF;
FLastResult: TAuraNodeResult;
FConnections: TList<TPinConnection>;
FCurrentExec: TList<TControl>;
FMode: TVisualizationMode;
FSlotCache: TArray<TAuraNodeResult>;
FParentVisitor: TAstToAuraNodeVisitor;
FCurrentLambda: ILambdaExpressionNode;
procedure FinalizeNodeLayout(const Node: TAuraNode);
function FindNodeForAddress(const Address: TResolvedAddress; out NodeResult: TAuraNodeResult): Boolean;
function VisitOperatorNode(
const InputExpressions: TArray<IAstNode>;
const CreateParentProc: TCreateParentNodeProc;
Alignment: TVerticalAlignment = vaCenter
): TAuraNode;
function BuildNodeControl(const Title, Details: string): TAuraNode;
function CreateNodeControl(const Title, Details: string): TAuraNode;
function CreatePin(
ParentNode: TAuraNode;
Shape: TPinShape;
Alignment: TPinAlignment;
Color: TAlphaColor;
const Tag: string
): TShape;
function CreateInput(ParentNode: TAuraNode; const Caption: string): TControl;
function CreateOutput(ParentNode: TAuraNode): TControl;
function CreateEntry(ParentNode: TAuraNode; connect: Boolean = true): TControl;
function CreateExit(ParentNode: TAuraNode; const Caption: string): TControl;
function TryGetDescr(const Node: IAstNode; out Text: String): Boolean;
public
constructor Create(
AWorkspace: TAuraWorkspace;
AParentControl: TControl;
const AStartPosition: TPointF;
AConnections: TList<TPinConnection>;
const ACurrentExec: TArray<TControl>;
AMode: TVisualizationMode;
AParent: TAstToAuraNodeVisitor;
ACurrentLambda: ILambdaExpressionNode;
ADescriptor: IScopeDescriptor
);
destructor Destroy; override;
property Connections: TList<TPinConnection> read FConnections;
{ IAstVisitor }
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
function VisitAssignment(const Node: IAssignmentNode): TDataValue;
function VisitIndexer(const Node: IIndexerNode): TDataValue;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function VisitRecurNode(const Node: IRecurNode): TDataValue;
end;
implementation
uses
System.Math,
System.StrUtils,
FMX.Platform,
Myc.Data.Scalar,
Myc.Fmx.AstEditor.Text;
{ TAstToAuraNodeVisitor }
constructor TAstToAuraNodeVisitor.Create(
AWorkspace: TAuraWorkspace;
AParentControl: TControl;
const AStartPosition: TPointF;
AConnections: TList<TPinConnection>;
const ACurrentExec: TArray<TControl>;
AMode: TVisualizationMode;
AParent: TAstToAuraNodeVisitor;
ACurrentLambda: ILambdaExpressionNode;
ADescriptor: IScopeDescriptor
);
begin
inherited Create;
FWorkspace := AWorkspace;
FParentControl := AParentControl;
FCurrentPos := AStartPosition;
FSpacing := TPointF.Create(20, 10);
FConnections := AConnections;
FCurrentExec := TList<TControl>.Create(ACurrentExec);
FLastResult.LayoutNode := nil;
FLastResult.OutputPin := nil;
FMode := AMode;
FParentVisitor := AParent;
FCurrentLambda := ACurrentLambda;
// Size the array based on the number of slots in the scope descriptor.
if Assigned(ADescriptor) then
SetLength(FSlotCache, ADescriptor.SlotCount);
end;
destructor TAstToAuraNodeVisitor.Destroy;
begin
FCurrentExec.Free;
inherited;
end;
procedure TAstToAuraNodeVisitor.FinalizeNodeLayout(const Node: TAuraNode);
var
control: TControl;
leftPins, rightPins: TList<TControl>;
numLeftPins, numRightPins, maxPins: Integer;
reqHeight: Single;
i: Integer;
totalHeight, startY: Single;
begin
leftPins := TList<TControl>.Create;
rightPins := TList<TControl>.Create;
try
for control in Node.Controls do
begin
if (Pos('exec.', control.TagString) = 1) or (Pos('data.', control.TagString) = 1) then
begin
if Pos('.in', control.TagString) > 0 then
begin
leftPins.Add(control);
control.Position.X := 0;
end
else
begin
rightPins.Add(control);
control.Position.X := Node.Width - cPinSize;
end;
end;
end;
numLeftPins := leftPins.Count;
numRightPins := rightPins.Count;
maxPins := Max(numLeftPins, numRightPins);
if maxPins = 0 then
exit;
reqHeight := cVerticalPadding + (maxPins - 1) * cPinOffsetY + cVerticalPadding;
Node.Height := Max(Node.Height, reqHeight);
Node.Height := Max(cDefaultNodeHeight, Node.Height);
if numLeftPins > 0 then
begin
totalHeight := (numLeftPins - 1) * cPinOffsetY;
startY := (Node.Height / 2) - (totalHeight / 2.0);
for i := 0 to numLeftPins - 1 do
leftPins[i].Position.Y := startY + i * cPinOffsetY - (cPinSize / 2);
end;
if numRightPins > 0 then
begin
totalHeight := (numRightPins - 1) * cPinOffsetY;
startY := (Node.Height / 2) - (totalHeight / 2.0);
for i := 0 to numRightPins - 1 do
rightPins[i].Position.Y := startY + i * cPinOffsetY - (cPinSize / 2);
end;
finally
leftPins.Free;
rightPins.Free;
end;
end;
function TAstToAuraNodeVisitor.BuildNodeControl(const Title, Details: string): TAuraNode;
var
fullTitle: string;
textWidth: Single;
newWidth: Single;
measureCanvas: TCanvas;
begin
Result := TAuraNode.Create(FParentControl);
Result.Parent := FParentControl;
fullTitle := Title;
if not Details.IsEmpty then
fullTitle := fullTitle + ': ' + Details;
Result.Title := fullTitle;
measureCanvas := TCanvasManager.MeasureCanvas;
if Assigned(measureCanvas) then
begin
measureCanvas.Font.Assign(Result.TitleFont);
textWidth := measureCanvas.TextWidth(Result.Title);
newWidth := textWidth + (2 * cHorizontalPadding);
Result.Width := Max(Result.Width, newWidth);
end;
end;
function TAstToAuraNodeVisitor.CreateInput(ParentNode: TAuraNode; const Caption: string): TControl;
begin
var cap := Caption;
if cap <> '' then
cap := '.' + cap;
Result := CreatePin(ParentNode, psCircle, paLeft, cDataPinColor, 'data.in' + cap);
Result.Hint := Caption;
Result.ShowHint := Caption <> '';
end;
function TAstToAuraNodeVisitor.CreateNodeControl(const Title, Details: string): TAuraNode;
begin
Result := BuildNodeControl(Title, Details);
Result.Position.Point := FCurrentPos;
FCurrentPos.Y := FCurrentPos.Y + Result.Height + FSpacing.Y;
FLastResult.LayoutNode := Result;
FLastResult.OutputPin := nil;
end;
function TAstToAuraNodeVisitor.CreateOutput(ParentNode: TAuraNode): TControl;
begin
Result := CreatePin(ParentNode, psCircle, paRight, cDataPinColor, 'data.out');
end;
function TAstToAuraNodeVisitor.CreateEntry(ParentNode: TAuraNode; connect: Boolean = true): TControl;
begin
Result := CreatePin(ParentNode, psTriangle, paLeft, cExecPinColor, 'exec.in');
if connect then
begin
for var curr in FCurrentExec do
FConnections.Add(TPinConnection.Create(curr, Result));
FCurrentExec.Clear;
end;
end;
function TAstToAuraNodeVisitor.CreateExit(ParentNode: TAuraNode; const Caption: string): TControl;
begin
var cap := Caption;
if cap <> '' then
cap := '.' + cap;
Result := CreatePin(ParentNode, psTriangle, paRight, cExecPinColor, 'exec.out' + cap);
FCurrentExec.Add(Result);
end;
function TAstToAuraNodeVisitor.CreatePin(
ParentNode: TAuraNode;
Shape: TPinShape;
Alignment: TPinAlignment;
Color: TAlphaColor;
const Tag: string
): TShape;
var
posX, posY: Single;
begin
posY := 0;
if Alignment = paLeft then
posX := 0
else // paRight
posX := ParentNode.Width - cPinSize;
case Shape of
psCircle:
begin
var circle := TEllipse.Create(ParentNode);
circle.Fill.Color := Color;
circle.Stroke.Kind := TBrushKind.None;
Result := circle;
end;
psTriangle:
begin
var triangle := TPath.Create(ParentNode);
triangle.Data.Data := Format('M 0 0 L %d %d L 0 %d Z', [cPinSize, cPinSize div 2, cPinSize]);
triangle.Fill.Color := Color;
triangle.Stroke.Kind := TBrushKind.None;
Result := triangle;
end;
else
Result := nil;
exit;
end;
Result.Parent := ParentNode;
Result.SetBounds(posX, posY, cPinSize, cPinSize);
Result.HitTest := true;
Result.TagString := Tag;
end;
function TAstToAuraNodeVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
end;
function TAstToAuraNodeVisitor.TryGetDescr(const Node: IAstNode; out Text: String): Boolean;
begin
if FMode <> vmControlFlow then
exit(false);
var textVisitor: IAstVisitor := TAstToTextVisitor.Create;
Text := Node.Accept(textVisitor).AsText;
Result := Pos('{', Text) = 0;
end;
function TAstToAuraNodeVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
details: string;
inputs: TArray<IAstNode>;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
var addNode := CreateNodeControl('Add to Series', details);
CreateEntry(addNode);
CreateExit(addNode, '');
FinalizeNodeLayout(addNode);
end
else
begin
if Assigned(Node.Lookback) then
inputs := [Node.Series, Node.Value, Node.Lookback]
else
inputs := [Node.Series, Node.Value];
VisitOperatorNode(
inputs,
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
addNode: TAuraNode;
seriesPin, valuePin, lookbackPin: TControl;
begin
addNode := BuildNodeControl('Add to Series', '');
CreateEntry(addNode);
seriesPin := CreateInput(addNode, 'Series');
valuePin := CreateInput(addNode, 'Value');
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, seriesPin));
if Assigned(InputResults[1].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[1].OutputPin, valuePin));
if InputResults.Count > 2 then
begin
lookbackPin := CreateInput(addNode, 'Lookback');
if Assigned(InputResults[2].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[2].OutputPin, lookbackPin));
end;
CreateExit(addNode, '');
FinalizeNodeLayout(addNode);
Result.LayoutNode := addNode;
Result.OutputPin := nil;
end,
vaTop
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
var exprStr: String;
if (FMode = vmControlFlow) and TryGetDescr(Node, exprStr) then
begin
var exprNode := CreateNodeControl('Expression', exprStr);
FLastResult.OutputPin := CreateOutput(exprNode);
FinalizeNodeLayout(exprNode);
end
else
begin
VisitOperatorNode(
[Node.Left, Node.Right],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
binaryExprNode: TAuraNode;
inputPin1, inputPin2: TControl;
leftResult, rightResult: TAuraNodeResult;
outPin: TControl;
begin
leftResult := InputResults[0];
rightResult := InputResults[1];
binaryExprNode := BuildNodeControl(Node.Operator.ToString, '');
binaryExprNode.TitleFont.Size := 20;
inputPin1 := CreateInput(binaryExprNode, '');
inputPin2 := CreateInput(binaryExprNode, '');
outPin := CreateOutput(binaryExprNode);
if Assigned(leftResult.OutputPin) then
FConnections.Add(TPinConnection.Create(leftResult.OutputPin, inputPin1));
if Assigned(rightResult.OutputPin) then
FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin2));
FinalizeNodeLayout(binaryExprNode);
Result.LayoutNode := binaryExprNode;
Result.OutputPin := outPin;
end
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
blockNode: TAuraNode;
oldParentControl: TControl;
oldPos: TPointF;
lastResult: TAuraNodeResult;
begin
// Create a visual container for the block, but do NOT create a new scope/visitor.
blockNode := BuildNodeControl('', '');
blockNode.Frameless := True;
blockNode.Position.Point := FCurrentPos;
// Temporarily retarget the visitor to build nodes inside the block container.
oldParentControl := FParentControl;
oldPos := FCurrentPos;
try
FParentControl := blockNode;
FCurrentPos := TPointF.Create(FSpacing.X, FSpacing.Y);
Result := TDataValue.Void;
for var expression in Node.Expressions do
begin
Result := expression.Accept(Self);
// The result of the block is the result of the last expression.
// We need to capture the last FLastResult before it's overwritten.
lastResult := FLastResult;
end;
var maxRight: Single := 0;
var maxBottom: Single := 0;
for var control in blockNode.Controls do
begin
if control is TAuraNode then
begin
maxRight := Max(maxRight, control.Position.X + control.Width);
maxBottom := Max(maxBottom, control.Position.Y + control.Height);
end;
end;
blockNode.Width := Max(blockNode.Width, maxRight + FSpacing.X);
blockNode.Height := Max(blockNode.Height, maxBottom + FSpacing.Y);
finally
// Restore the visitor's state.
FParentControl := oldParentControl;
FCurrentPos := oldPos;
FCurrentPos.Y := blockNode.Position.Y + blockNode.Height + FSpacing.Y;
end;
FLastResult.LayoutNode := blockNode;
// The output pin of a block is the output pin of its last expression.
FLastResult.OutputPin := lastResult.OutputPin;
end;
function TAstToAuraNodeVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
var
constantNode: TAuraNode;
begin
constantNode := CreateNodeControl('Constant', Node.Value.ToString);
FLastResult.OutputPin := CreateOutput(constantNode);
FinalizeNodeLayout(constantNode);
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
var
seriesNode: TAuraNode;
begin
seriesNode := CreateNodeControl('Create Series', Node.Definition);
FLastResult.OutputPin := CreateOutput(seriesNode);
FinalizeNodeLayout(seriesNode);
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
inputExpressions: TArray<IAstNode>;
begin
var details: String;
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
var funcCallNode := CreateNodeControl('FunctionCall', details);
CreateEntry(funcCallNode);
FLastResult.OutputPin := CreateOutput(funcCallNode);
CreateExit(funcCallNode, '');
FinalizeNodeLayout(funcCallNode);
end
else
begin
SetLength(inputExpressions, 1 + Length(Node.Arguments));
inputExpressions[0] := Node.Callee;
for var i := 0 to High(Node.Arguments) do
inputExpressions[i + 1] := Node.Arguments[i];
VisitOperatorNode(
inputExpressions,
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
funcCallNode: TAuraNode;
calleePin: TControl;
argPin: array of TControl;
i: Integer;
outPin: TControl;
begin
funcCallNode := BuildNodeControl('FunctionCall', '');
CreateEntry(funcCallNode);
calleePin := CreateInput(funcCallNode, 'Callee');
SetLength(argPin, Length(Node.Arguments));
for i := 0 to High(argPin) do
argPin[i] := CreateInput(funcCallNode, 'Arg' + i.ToString);
CreateExit(funcCallNode, '');
outPin := CreateOutput(funcCallNode);
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, calleePin));
for i := 0 to High(Node.Arguments) do
if Assigned(InputResults[i + 1].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[i + 1].OutputPin, argPin[i]));
FinalizeNodeLayout(funcCallNode);
Result.LayoutNode := funcCallNode;
Result.OutputPin := outPin;
end
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
details: string;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
var recurNode := CreateNodeControl('Recur', details);
CreateEntry(recurNode);
CreateExit(recurNode, '');
FinalizeNodeLayout(recurNode);
FLastResult.OutputPin := nil;
end
else
begin
VisitOperatorNode(
Node.Arguments,
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
recurNode: TAuraNode;
argPin: array of TControl;
i: Integer;
begin
recurNode := BuildNodeControl('Recur', '');
CreateEntry(recurNode);
SetLength(argPin, Length(Node.Arguments));
for i := 0 to High(argPin) do
argPin[i] := CreateInput(recurNode, 'Arg' + i.ToString);
CreateExit(recurNode, '');
for i := 0 to High(Node.Arguments) do
if Assigned(InputResults[i].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[i].OutputPin, argPin[i]));
FinalizeNodeLayout(recurNode);
Result.LayoutNode := recurNode;
Result.OutputPin := nil;
end
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
existingResult: TAuraNodeResult;
identifierNode: TAuraNode;
begin
if Node.Address.Kind <> akUnresolved then
begin
// FindNodeForAddress now handles all cases: local cache, on-demand parameter creation, and recursive parent/upvalue lookup.
if FindNodeForAddress(Node.Address, existingResult) then
begin
FLastResult := existingResult;
end
else
begin
// If the lookup still fails, it's a genuine unresolved variable.
identifierNode := CreateNodeControl('Identifier (unresolved!)', Node.Name);
identifierNode.BorderColor := TAlphaColors.Red;
FLastResult.LayoutNode := identifierNode;
FLastResult.OutputPin := CreateOutput(identifierNode);
FinalizeNodeLayout(identifierNode);
end;
end
else
begin
identifierNode := CreateNodeControl('Identifier', Node.Name);
FLastResult.LayoutNode := identifierNode;
FLastResult.OutputPin := CreateOutput(identifierNode);
FinalizeNodeLayout(identifierNode);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
startPosition: TPointF;
ifNode: TAuraNode;
conditionEndY: Single;
branchStartX: Single;
execPathes: TList<TControl>;
thenEndY, elseEndY: Single;
begin
startPosition := FCurrentPos;
var condStr: String;
if (FMode = vmControlFlow) and TryGetDescr(Node, condStr) then
begin
ifNode := CreateNodeControl('If', condStr);
ifNode.Height := cIfNodeHeight;
end
else
begin
ifNode :=
VisitOperatorNode(
[Node.Condition],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
conditionInputPin: TControl;
condResult: TAuraNodeResult;
ifNode: TAuraNode;
begin
condResult := InputResults[0];
ifNode := BuildNodeControl('If', '');
conditionInputPin := CreateInput(ifNode, 'Condition');
if Assigned(condResult.OutputPin) then
FConnections.Add(TPinConnection.Create(condResult.OutputPin, conditionInputPin));
Result.LayoutNode := ifNode;
Result.OutputPin := nil;
end
);
end;
CreateEntry(ifNode);
conditionEndY := FCurrentPos.Y;
branchStartX := ifNode.Position.X + ifNode.Width + FSpacing.X;
execPathes := TList<TControl>.Create;
try
FCurrentExec.Clear;
CreateExit(ifNode, 'Then');
FCurrentPos.X := branchStartX;
FCurrentPos.Y := startPosition.Y;
Node.ThenBranch.Accept(Self);
thenEndY := FCurrentPos.Y;
FLastResult.LayoutNode := ifNode;
execPathes.AddRange(FCurrentExec);
elseEndY := thenEndY;
FCurrentExec.Clear;
CreateExit(ifNode, 'Else');
if Assigned(Node.ElseBranch) then
begin
FCurrentPos.X := branchStartX;
FCurrentPos.Y := thenEndY;
Node.ElseBranch.Accept(Self);
elseEndY := FCurrentPos.Y;
end;
execPathes.AddRange(FCurrentExec);
FinalizeNodeLayout(ifNode);
FCurrentPos.X := startPosition.X;
FCurrentPos.Y := Max(conditionEndY, elseEndY);
FLastResult.LayoutNode := ifNode;
FLastResult.OutputPin := nil;
FCurrentExec.Clear;
FCurrentExec.AddRange(execPathes);
finally
execPathes.Free;
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
details: String;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
var indexerNode := CreateNodeControl('Expression', details);
FLastResult.OutputPin := CreateOutput(indexerNode);
FinalizeNodeLayout(indexerNode);
end
else
begin
VisitOperatorNode(
[Node.Base, Node.Index],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
indexerNode: TAuraNode;
basePin, indexPin, outPin: TControl;
begin
indexerNode := BuildNodeControl('[]', '');
indexerNode.TitleFont.Size := 20;
basePin := CreateInput(indexerNode, 'Base');
indexPin := CreateInput(indexerNode, 'Index');
outPin := CreateOutput(indexerNode);
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, basePin));
if Assigned(InputResults[1].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[1].OutputPin, indexPin));
FinalizeNodeLayout(indexerNode);
Result.LayoutNode := indexerNode;
Result.OutputPin := outPin;
end
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.FindNodeForAddress(const Address: TResolvedAddress; out NodeResult: TAuraNodeResult): Boolean;
var
originalAddress: TResolvedAddress;
targetVisitor: TAstToAuraNodeVisitor;
i: Integer;
begin
if (Address.Kind = akUpvalue) and Assigned(FCurrentLambda) then
begin
if Address.SlotIndex < Length(FCurrentLambda.Upvalues) then
begin
originalAddress := FCurrentLambda.Upvalues[Address.SlotIndex];
if Assigned(FParentVisitor) then
exit(FParentVisitor.FindNodeForAddress(originalAddress, NodeResult));
end;
exit(False);
end;
if (Address.Kind = akLocalOrParent) then
begin
targetVisitor := Self;
for i := 1 to Address.ScopeDepth do
begin
if not Assigned(targetVisitor) then
exit(False);
targetVisitor := targetVisitor.FParentVisitor;
end;
if Assigned(targetVisitor) and (Address.SlotIndex < Length(targetVisitor.FSlotCache)) then
begin
NodeResult := targetVisitor.FSlotCache[Address.SlotIndex];
// An entry is valid if a layout node has been created for it.
exit(Assigned(NodeResult.LayoutNode));
end;
end;
Result := False;
end;
function TAstToAuraNodeVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
paramStr: String;
lambdaNode: TAuraNode;
i: Integer;
childVisitor: TAstToAuraNodeVisitor;
childStartPos: TPointF;
maxRight, maxBottom: Single;
control: TControl;
childLastResult: TAuraNodeResult;
entryNode, exitNode: TAuraNode;
begin
// Parameter string for the title
paramStr := '(';
if Length(Node.Parameters) > 0 then
begin
paramStr := paramStr + Node.Parameters[0].Name;
for i := 1 to High(Node.Parameters) do
paramStr := paramStr + ', ' + Node.Parameters[i].Name;
end;
paramStr := paramStr + ')';
// --- Inlined logic from former VisitContainerNode ---
// 1. Create container node for the lambda.
lambdaNode := BuildNodeControl(#$03BB, paramStr);
lambdaNode.Position.Point := FCurrentPos;
// 2. Create internal 'call' entry point.
const pinNodeHeight = cPinSize + cVerticalPadding;
entryNode := BuildNodeControl('call', '');
entryNode.Parent := lambdaNode;
entryNode.Position.Point := TPointF.Create(0, 0);
entryNode.Height := pinNodeHeight;
// A lambda expression is a value, it doesn't connect to the parent execution flow.
// Its internal flow starts with the exit of the 'call' node.
var internalExec: TArray<TControl> := [CreateExit(entryNode, '')];
FinalizeNodeLayout(entryNode);
// 3. Create child visitor for the new scope.
childStartPos := TPointF.Create(FSpacing.X, FSpacing.Y + pinNodeHeight);
childVisitor :=
TAstToAuraNodeVisitor
.Create(FWorkspace, lambdaNode, childStartPos, FConnections, internalExec, FMode, Self, Node, Node.ScopeDescriptor);
FCurrentExec.Clear;
// 4. Let the child visitor create parameter nodes and visit the lambda body.
for var param in Node.Parameters do
begin
if param.Address.Kind <> akUnresolved then
begin
var paramNode := childVisitor.CreateNodeControl('Parameter', param.Name);
var paramResult: TAuraNodeResult;
paramResult.LayoutNode := paramNode;
paramResult.OutputPin := childVisitor.CreateOutput(paramNode);
childVisitor.FinalizeNodeLayout(paramNode);
childVisitor.FSlotCache[param.Address.SlotIndex] := paramResult;
end;
end;
Node.Body.Accept(childVisitor);
childLastResult := childVisitor.FLastResult;
// 5. Resize container to fit all internally generated nodes.
maxRight := 0;
maxBottom := 0;
for control in lambdaNode.Controls do
begin
if control is TAuraNode then
begin
maxRight := Max(maxRight, control.Position.X + control.Width);
maxBottom := Max(maxBottom, control.Position.Y + control.Height);
end;
end;
lambdaNode.Width := Max(lambdaNode.Width, maxRight + FSpacing.X);
lambdaNode.Height := Max(lambdaNode.Height, maxBottom + FSpacing.Y);
// 6. Create internal 'return' exit point.
exitNode := BuildNodeControl('return', '');
exitNode.Parent := lambdaNode;
exitNode.Height := pinNodeHeight;
// Connect the execution flow from the lambda body to the 'return' node's entry.
childVisitor.CreateEntry(exitNode, true);
// Connect the data flow (the result of the last expression) to the 'return' node.
if Assigned(childLastResult.OutputPin) then
begin
var dataResultPin := childVisitor.CreateInput(exitNode, 'Result');
FConnections.Add(TPinConnection.Create(childLastResult.OutputPin, dataResultPin));
end;
childVisitor.FinalizeNodeLayout(exitNode);
lambdaNode.Height := Max(lambdaNode.Height, maxBottom + FSpacing.Y + exitNode.Height);
exitNode.Position.Point := TPointF.Create(lambdaNode.Width - exitNode.Width, lambdaNode.Height - exitNode.Height);
// 7. Finalize the main visitor state.
FCurrentPos.Y := lambdaNode.Position.Y + lambdaNode.Height + FSpacing.Y;
FLastResult.LayoutNode := lambdaNode;
FLastResult.OutputPin := CreateOutput(lambdaNode); // The lambda itself is an expression that yields a value.
FinalizeNodeLayout(lambdaNode);
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
var
details: String;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
var memberNode := CreateNodeControl('Expression', details);
FLastResult.OutputPin := CreateOutput(memberNode);
FinalizeNodeLayout(memberNode);
end
else
begin
VisitOperatorNode(
[Node.Base],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
memberAccessNode: TAuraNode;
basePin, outPin: TControl;
begin
memberAccessNode := BuildNodeControl('Get ' + Node.Member.Name, '');
basePin := CreateInput(memberAccessNode, 'Base');
outPin := CreateOutput(memberAccessNode);
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, basePin));
FinalizeNodeLayout(memberAccessNode);
Result.LayoutNode := memberAccessNode;
Result.OutputPin := outPin;
end
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitOperatorNode(
const InputExpressions: TArray<IAstNode>;
const CreateParentProc: TCreateParentNodeProc;
Alignment: TVerticalAlignment
): TAuraNode;
var
inputResults: TAuraNodeResultList;
inputNode: IAstNode;
startPosition: TPointF;
endY, maxChildWidth: Single;
parentNode: TAuraNode;
createResult: TAuraNodeResult;
begin
startPosition := FCurrentPos;
inputResults := TAuraNodeResultList.Create;
try
for inputNode in InputExpressions do
begin
inputNode.Accept(Self);
inputResults.Add(FLastResult);
end;
endY := FCurrentPos.Y;
maxChildWidth := 0;
for var res in inputResults do
if Assigned(res.LayoutNode) then
maxChildWidth := Max(maxChildWidth, res.LayoutNode.Position.X + res.LayoutNode.Width);
createResult := CreateParentProc(inputResults);
parentNode := createResult.LayoutNode;
Result := parentNode;
var parentY: Single;
if Alignment = vaCenter then
begin
var totalInputHeight := endY - startPosition.Y;
var nodeCenterY := startPosition.Y + (totalInputHeight / 2);
parentY := nodeCenterY - (parentNode.Height / 2);
end
else // vaTop
begin
parentY := startPosition.Y;
end;
parentNode.Position.Point := TPointF.Create(maxChildWidth + FSpacing.X, parentY);
FCurrentPos.Y := Max(endY, parentNode.Position.Y + parentNode.Height + FSpacing.Y);
FLastResult.LayoutNode := parentNode;
FLastResult.OutputPin := createResult.OutputPin;
finally
inputResults.Free;
end;
end;
function TAstToAuraNodeVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
VisitOperatorNode(
[Node.Series],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
lengthNode: TAuraNode;
seriesPin, outPin: TControl;
begin
lengthNode := BuildNodeControl('Series Length', '');
seriesPin := CreateInput(lengthNode, 'Series');
outPin := CreateOutput(lengthNode);
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, seriesPin));
FinalizeNodeLayout(lengthNode);
Result.LayoutNode := lengthNode;
Result.OutputPin := outPin;
end
);
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
var exprStr: String;
if (FMode = vmControlFlow) and TryGetDescr(Node, exprStr) then
begin
var ternaryNode := CreateNodeControl('Expression', exprStr);
FLastResult.OutputPin := CreateOutput(ternaryNode);
FinalizeNodeLayout(ternaryNode);
end
else
begin
VisitOperatorNode(
[Node.Condition, Node.ThenBranch, Node.ElseBranch],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
ternaryNode: TAuraNode;
condPin, thenPin, elsePin, outPin: TControl;
begin
ternaryNode := BuildNodeControl('?', '');
ternaryNode.TitleFont.Size := 20;
condPin := CreateInput(ternaryNode, 'Condition');
thenPin := CreateInput(ternaryNode, 'Then');
elsePin := CreateInput(ternaryNode, 'Else');
outPin := CreateOutput(ternaryNode);
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, condPin));
if Assigned(InputResults[1].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[1].OutputPin, thenPin));
if Assigned(InputResults[2].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[2].OutputPin, elsePin));
FinalizeNodeLayout(ternaryNode);
Result.LayoutNode := ternaryNode;
Result.OutputPin := outPin;
end
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
var exprStr: String;
if (FMode = vmControlFlow) and TryGetDescr(Node, exprStr) then
begin
var exprNode := CreateNodeControl('Expression', exprStr);
FLastResult.OutputPin := CreateOutput(exprNode);
FinalizeNodeLayout(exprNode);
end
else
begin
VisitOperatorNode(
[Node.Right],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
unaryExprNode: TAuraNode;
inputPin: TControl;
rightResult: TAuraNodeResult;
outPin: TControl;
begin
rightResult := InputResults[0];
unaryExprNode := BuildNodeControl(Node.Operator.ToString, '');
unaryExprNode.TitleFont.Size := 20;
inputPin := CreateInput(unaryExprNode, '');
outPin := CreateOutput(unaryExprNode);
if Assigned(rightResult.OutputPin) then
FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin));
FinalizeNodeLayout(unaryExprNode);
Result.LayoutNode := unaryExprNode;
Result.OutputPin := outPin;
end
);
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
var
details: string;
assignmentNode: TAuraNode;
oldParentControl: TControl;
oldPos: TPointF;
control: TControl;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
assignmentNode := CreateNodeControl('Assignment', details);
CreateEntry(assignmentNode);
CreateExit(assignmentNode, '');
FinalizeNodeLayout(assignmentNode);
end
else
begin
// 1. Container-Knoten erstellen.
assignmentNode := BuildNodeControl('Assignment', Node.Identifier.Name);
assignmentNode.Position.Point := FCurrentPos;
// 2. Visitor temporr auf den Container als Parent umleiten.
oldParentControl := FParentControl;
oldPos := FCurrentPos;
try
FParentControl := assignmentNode;
FCurrentPos := TPointF.Create(FSpacing.X, assignmentNode.TitleFont.Size * 1.8 + FSpacing.Y);
// 3. Den Zuweisungswert mit dem *aktuellen* Visitor (Self) verarbeiten. Es wird kein neuer Scope erzeugt.
Node.Value.Accept(Self);
// 4. Container-Gre an den Inhalt anpassen.
var maxRight: Single := 0;
var maxBottom: Single := 0;
for control in assignmentNode.Controls do
begin
if control is TAuraNode then
begin
maxRight := Max(maxRight, control.Position.X + control.Width);
maxBottom := Max(maxBottom, control.Position.Y + control.Height);
end;
end;
assignmentNode.Width := Max(assignmentNode.Width, maxRight + FSpacing.X);
assignmentNode.Height := Max(assignmentNode.Height, maxBottom + FSpacing.Y);
finally
// 5. Visitor-Zustand wiederherstellen.
FParentControl := oldParentControl;
FCurrentPos := oldPos;
end;
// 6. Pins anbringen und Layout finalisieren.
CreateEntry(assignmentNode);
CreateExit(assignmentNode, '');
FLastResult.OutputPin := CreateOutput(assignmentNode);
FinalizeNodeLayout(assignmentNode);
// 7. FCurrentPos fr den nchsten Knoten korrekt setzen.
FCurrentPos.Y := assignmentNode.Position.Y + assignmentNode.Height + FSpacing.Y;
end;
Result := TDataValue.Void;
end;
function TAstToAuraNodeVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
var
details: string;
varDeclNode: TAuraNode;
oldParentControl: TControl;
oldPos: TPointF;
control: TControl;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
varDeclNode := CreateNodeControl('VarDecl', details);
CreateEntry(varDeclNode);
CreateExit(varDeclNode, '');
FinalizeNodeLayout(varDeclNode);
end
else
begin
// 1. Container-Knoten erstellen.
varDeclNode := BuildNodeControl('VarDecl', Node.Identifier.Name);
varDeclNode.Position.Point := FCurrentPos;
if Assigned(Node.Initializer) then
begin
// 2. Visitor temporr auf den Container als Parent umleiten.
oldParentControl := FParentControl;
oldPos := FCurrentPos;
try
FParentControl := varDeclNode;
FCurrentPos := TPointF.Create(FSpacing.X, varDeclNode.TitleFont.Size * 1.8 + FSpacing.Y);
// 3. Den Initialisierungsausdruck mit dem *aktuellen* Visitor (Self) verarbeiten.
Node.Initializer.Accept(Self);
// 4. Container-Gre an den Inhalt anpassen.
var maxRight: Single := 0;
var maxBottom: Single := 0;
for control in varDeclNode.Controls do
begin
if control is TAuraNode then
begin
maxRight := Max(maxRight, control.Position.X + control.Width);
maxBottom := Max(maxBottom, control.Position.Y + control.Height);
end;
end;
varDeclNode.Width := Max(varDeclNode.Width, maxRight + FSpacing.X);
varDeclNode.Height := Max(varDeclNode.Height, maxBottom + FSpacing.Y);
finally
// 5. Visitor-Zustand wiederherstellen.
FParentControl := oldParentControl;
FCurrentPos := oldPos;
end;
end;
// 6. Pins anbringen und Layout finalisieren.
CreateEntry(varDeclNode);
CreateExit(varDeclNode, '');
FLastResult.OutputPin := CreateOutput(varDeclNode);
FinalizeNodeLayout(varDeclNode);
// 7. FCurrentPos fr den nchsten Knoten korrekt setzen.
FCurrentPos.Y := varDeclNode.Position.Y + varDeclNode.Height + FSpacing.Y;
// 8. Die neue Variable im Cache des aktuellen Scopes registrieren.
if Node.Identifier.Address.Kind <> akUnresolved then
FSlotCache[Node.Identifier.Address.SlotIndex] := FLastResult;
end;
Result := TDataValue.Void;
end;
end.