Michael Schimmel
1322 lines
50 KiB
ObjectPascal
1322 lines
50 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.Ast.Visitor,
|
|
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(TAstVisitor)
|
|
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 }
|
|
procedure Execute(const RootNode: IAstNode);
|
|
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
|
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
|
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
|
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
|
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
|
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
|
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
|
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
|
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
|
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
|
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
|
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Math,
|
|
System.StrUtils,
|
|
FMX.Platform,
|
|
Myc.Data.Scalar,
|
|
Myc.Ast.Binding, // For TBound...Node classes
|
|
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;
|
|
|
|
procedure TAstToAuraNodeVisitor.Execute(const RootNode: IAstNode);
|
|
begin
|
|
RootNode.Accept(Self)
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.TryGetDescr(const Node: IAstNode; out Text: String): Boolean;
|
|
begin
|
|
if FMode <> vmControlFlow then
|
|
exit(false);
|
|
|
|
Text := Node.Accept(TAstToTextVisitor.Create).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;
|
|
boundNode: TBoundIdentifierNode;
|
|
begin
|
|
if Node is TBoundIdentifierNode then
|
|
begin
|
|
boundNode := Node as TBoundIdentifierNode;
|
|
// FindNodeForAddress handles all cases: local cache, on-demand parameter creation, and recursive parent/upvalue lookup.
|
|
if FindNodeForAddress(boundNode.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 (unbound)', 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;
|
|
boundLambda: TBoundLambdaExpressionNode;
|
|
begin
|
|
if (Address.Kind = akUpvalue) and Assigned(FCurrentLambda) and (FCurrentLambda is TBoundLambdaExpressionNode) then
|
|
begin
|
|
boundLambda := FCurrentLambda as TBoundLambdaExpressionNode;
|
|
if Address.SlotIndex < Length(boundLambda.Upvalues) then
|
|
begin
|
|
originalAddress := boundLambda.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;
|
|
boundNode: TBoundLambdaExpressionNode;
|
|
begin
|
|
// This visitor must operate on a bound AST.
|
|
if not (Node is TBoundLambdaExpressionNode) then
|
|
begin
|
|
lambdaNode := CreateNodeControl(#$03BB, '(unbound)');
|
|
FinalizeNodeLayout(lambdaNode);
|
|
FLastResult.LayoutNode := lambdaNode;
|
|
FLastResult.OutputPin := CreateOutput(lambdaNode);
|
|
exit(TDataValue.Void);
|
|
end;
|
|
boundNode := Node as TBoundLambdaExpressionNode;
|
|
|
|
// Parameter string for the title
|
|
paramStr := '(';
|
|
if Length(boundNode.Parameters) > 0 then
|
|
begin
|
|
paramStr := paramStr + boundNode.Parameters[0].Name;
|
|
for i := 1 to High(boundNode.Parameters) do
|
|
paramStr := paramStr + ', ' + boundNode.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;
|
|
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, boundNode.ScopeDescriptor);
|
|
|
|
FCurrentExec.Clear;
|
|
|
|
// 4. Let the child visitor create parameter nodes and visit the lambda body.
|
|
for var param in boundNode.Parameters do
|
|
begin
|
|
if param is TBoundIdentifierNode then
|
|
with (param as TBoundIdentifierNode) do
|
|
begin
|
|
var paramNode := childVisitor.CreateNodeControl('Parameter', Name);
|
|
var paramResult: TAuraNodeResult;
|
|
paramResult.LayoutNode := paramNode;
|
|
paramResult.OutputPin := childVisitor.CreateOutput(paramNode);
|
|
childVisitor.FinalizeNodeLayout(paramNode);
|
|
childVisitor.FSlotCache[Address.SlotIndex] := paramResult;
|
|
end;
|
|
end;
|
|
boundNode.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 tempor�r 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-Gr��e 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 f�r den n�chsten Knoten korrekt setzen.
|
|
FCurrentPos.Y := assignmentNode.Position.Y + assignmentNode.Height + FSpacing.Y;
|
|
end;
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
|
var
|
|
paramStr: String;
|
|
macroNode: TAuraNode;
|
|
i: Integer;
|
|
childVisitor: TAstToAuraNodeVisitor;
|
|
childStartPos: TPointF;
|
|
maxRight, maxBottom: Single;
|
|
control: TControl;
|
|
childLastResult: TAuraNodeResult;
|
|
entryNode, exitNode: TAuraNode;
|
|
paramDescriptor: IScopeDescriptor;
|
|
begin
|
|
// Create a string representation of the parameters for the node 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 + ')';
|
|
|
|
// 1. Create the main container node for the macro definition.
|
|
macroNode := BuildNodeControl('defmacro: ' + Node.Name.Name, paramStr);
|
|
macroNode.Position.Point := FCurrentPos;
|
|
|
|
// A macro definition is a statement, so it has execution pins.
|
|
CreateEntry(macroNode);
|
|
|
|
// 2. Create a temporary scope descriptor for the macro's parameters.
|
|
// This allows the child visitor to correctly visualize parameter nodes.
|
|
paramDescriptor := TScope.CreateDescriptor(nil);
|
|
for i := 0 to High(Node.Parameters) do
|
|
paramDescriptor.Define(Node.Parameters[i].Name);
|
|
|
|
// 3. Create a child visitor for the new scope within the macro's body.
|
|
const pinNodeHeight = cPinSize + cVerticalPadding;
|
|
childStartPos := TPointF.Create(FSpacing.X, FSpacing.Y + pinNodeHeight);
|
|
childVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, macroNode, childStartPos, FConnections, [], FMode, Self, nil, paramDescriptor);
|
|
|
|
// 4. Create the visual nodes for the parameters inside the macro's scope.
|
|
for i := 0 to High(Node.Parameters) do
|
|
begin
|
|
var param := Node.Parameters[i];
|
|
var paramNode := childVisitor.CreateNodeControl('Parameter', param.Name);
|
|
var paramResult: TAuraNodeResult;
|
|
paramResult.LayoutNode := paramNode;
|
|
paramResult.OutputPin := childVisitor.CreateOutput(paramNode);
|
|
childVisitor.FinalizeNodeLayout(paramNode);
|
|
// Cache the parameter node by its slot index for lookups within the body.
|
|
if i < Length(childVisitor.FSlotCache) then
|
|
childVisitor.FSlotCache[i] := paramResult;
|
|
end;
|
|
|
|
// 5. Let the child visitor render the macro's body.
|
|
Node.Body.Accept(childVisitor);
|
|
childLastResult := childVisitor.FLastResult;
|
|
|
|
// 6. Resize the container to fit all internally generated nodes.
|
|
maxRight := 0;
|
|
maxBottom := 0;
|
|
for control in macroNode.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;
|
|
macroNode.Width := Max(macroNode.Width, maxRight + FSpacing.X);
|
|
macroNode.Height := Max(macroNode.Height, maxBottom + FSpacing.Y);
|
|
|
|
// 7. Create an internal 'expansion' exit point, showing what the macro produces.
|
|
exitNode := BuildNodeControl('Expansion', '');
|
|
exitNode.Parent := macroNode;
|
|
exitNode.Height := pinNodeHeight;
|
|
// Connect the data flow (the result of the last expression in the body) to the expansion node.
|
|
if Assigned(childLastResult.OutputPin) then
|
|
begin
|
|
var dataResultPin := childVisitor.CreateInput(exitNode, 'AST');
|
|
FConnections.Add(TPinConnection.Create(childLastResult.OutputPin, dataResultPin));
|
|
end;
|
|
childVisitor.FinalizeNodeLayout(exitNode);
|
|
macroNode.Height := Max(macroNode.Height, maxBottom + FSpacing.Y + exitNode.Height);
|
|
exitNode.Position.Point := TPointF.Create(FSpacing.X, macroNode.Height - exitNode.Height - FSpacing.Y);
|
|
|
|
// 8. Finalize the main visitor state.
|
|
FCurrentPos.Y := macroNode.Position.Y + macroNode.Height + FSpacing.Y;
|
|
FLastResult.LayoutNode := macroNode;
|
|
FLastResult.OutputPin := nil; // A macro definition itself does not return a value.
|
|
CreateExit(macroNode, ''); // Execution flow continues after the definition.
|
|
FinalizeNodeLayout(macroNode);
|
|
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
|
var
|
|
details: string;
|
|
varDeclNode: TAuraNode;
|
|
oldParentControl: TControl;
|
|
oldPos: TPointF;
|
|
control: TControl;
|
|
boundIdentifier: TBoundIdentifierNode;
|
|
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 tempor�r 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-Gr��e 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 f�r den n�chsten 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 is TBoundIdentifierNode then
|
|
begin
|
|
boundIdentifier := Node.Identifier as TBoundIdentifierNode;
|
|
FSlotCache[boundIdentifier.Address.SlotIndex] := FLastResult;
|
|
end;
|
|
end;
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
end.
|