Ast editor rondtrip
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,258 @@
|
||||
unit Myc.Fmx.AstEditor.Controller;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Types,
|
||||
System.Generics.Collections,
|
||||
FMX.Controls,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Identities,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Environment,
|
||||
Myc.Fmx.AstEditor.Core,
|
||||
Myc.Fmx.AstEditor.Workspace;
|
||||
|
||||
type
|
||||
TAstEditorController = class
|
||||
private
|
||||
type
|
||||
TNodeMap = TDictionary<IAstIdentity, TAstViewNode>;
|
||||
|
||||
// Visitor to propagate Type Information from TypedAST to Visual Nodes
|
||||
TTypePropagator = class(TAstVisitor)
|
||||
private
|
||||
FMap: TNodeMap;
|
||||
procedure ApplyType(const Node: IAstNode);
|
||||
protected
|
||||
// Central hook: Called for every node during traversal
|
||||
procedure Accept(const Node: IAstNode); override;
|
||||
public
|
||||
constructor Create(AMap: TNodeMap);
|
||||
end;
|
||||
|
||||
private
|
||||
FEnv: TAstEnvironment;
|
||||
FWorkspace: TAstWorkspace;
|
||||
FNodeMap: TNodeMap;
|
||||
FRootViewNode: TAstViewNode;
|
||||
|
||||
procedure CollectNodes(Parent: TControl);
|
||||
procedure ClearVisuals;
|
||||
procedure ApplyErrors(const Log: ICompilerLog);
|
||||
procedure ApplyTypes(const TypedAst: IAstNode);
|
||||
|
||||
public
|
||||
constructor Create(const AEnv: TAstEnvironment; AWorkspace: TAstWorkspace);
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure ValidateAndShow;
|
||||
procedure SetRoot(const AstNode: IAstNode);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Data.Value;
|
||||
|
||||
{ TAstEditorController }
|
||||
|
||||
constructor TAstEditorController.Create(const AEnv: TAstEnvironment; AWorkspace: TAstWorkspace);
|
||||
begin
|
||||
inherited Create;
|
||||
FEnv := AEnv;
|
||||
FWorkspace := AWorkspace;
|
||||
FNodeMap := TNodeMap.Create;
|
||||
end;
|
||||
|
||||
destructor TAstEditorController.Destroy;
|
||||
begin
|
||||
FNodeMap.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.SetRoot(const AstNode: IAstNode);
|
||||
begin
|
||||
FWorkspace.DeleteChildren;
|
||||
FWorkspace.Build(AstNode, TPointF.Create(50, 50));
|
||||
|
||||
if FWorkspace.ChildrenCount > 0 then
|
||||
begin
|
||||
for var i := 0 to FWorkspace.ChildrenCount - 1 do
|
||||
if FWorkspace.Children[i] is TAstViewNode then
|
||||
begin
|
||||
FRootViewNode := TAstViewNode(FWorkspace.Children[i]);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
ValidateAndShow;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.CollectNodes(Parent: TControl);
|
||||
var
|
||||
i: Integer;
|
||||
child: TControl;
|
||||
viewNode: TAstViewNode;
|
||||
begin
|
||||
for i := 0 to Parent.ChildrenCount - 1 do
|
||||
begin
|
||||
if Parent.Children[i] is TControl then
|
||||
begin
|
||||
child := TControl(Parent.Children[i]);
|
||||
|
||||
if child is TAstViewNode then
|
||||
begin
|
||||
viewNode := TAstViewNode(child);
|
||||
// Register Identity -> ViewNode
|
||||
// Note: ReconstructAst updates the Node property of the ViewNode,
|
||||
// so we must ensure we use the identity from the *logical* node held by the view.
|
||||
if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then
|
||||
begin
|
||||
FNodeMap.AddOrSetValue(viewNode.Node.Identity, viewNode);
|
||||
end;
|
||||
end;
|
||||
|
||||
if child.ChildrenCount > 0 then
|
||||
CollectNodes(child);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ClearVisuals;
|
||||
begin
|
||||
for var viewNode in FNodeMap.Values do
|
||||
begin
|
||||
viewNode.ErrorMessage := '';
|
||||
viewNode.TypeInfoText := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ApplyErrors(const Log: ICompilerLog);
|
||||
var
|
||||
entry: TCompilerError;
|
||||
viewNode: TAstViewNode;
|
||||
begin
|
||||
for entry in Log.GetEntries do
|
||||
begin
|
||||
if (entry.Level = elError) and Assigned(entry.Node) and Assigned(entry.Node.Identity) then
|
||||
begin
|
||||
if FNodeMap.TryGetValue(entry.Node.Identity, viewNode) then
|
||||
begin
|
||||
if viewNode.ErrorMessage = '' then
|
||||
viewNode.ErrorMessage := entry.Message
|
||||
else
|
||||
viewNode.ErrorMessage := viewNode.ErrorMessage + sLineBreak + entry.Message;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ApplyTypes(const TypedAst: IAstNode);
|
||||
var
|
||||
propagator: TTypePropagator;
|
||||
begin
|
||||
if not Assigned(TypedAst) then
|
||||
Exit;
|
||||
|
||||
propagator := TTypePropagator.Create(FNodeMap);
|
||||
try
|
||||
// Start traversal. The overload Accept(Node) will be called.
|
||||
propagator.Accept(TypedAst);
|
||||
finally
|
||||
propagator.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ValidateAndShow;
|
||||
var
|
||||
logicalAst: IAstNode;
|
||||
begin
|
||||
if not Assigned(FRootViewNode) then
|
||||
Exit;
|
||||
|
||||
// 1. Reconstruct Logical AST from UI
|
||||
// This updates the .Node property on ViewNodes with fresh Identities (if configured) or reuses them.
|
||||
logicalAst := FRootViewNode.CreateAst;
|
||||
|
||||
// 2. Rebuild Mapping based on the new logical nodes
|
||||
FNodeMap.Clear;
|
||||
CollectNodes(FWorkspace);
|
||||
|
||||
// 3. Clear visuals
|
||||
ClearVisuals;
|
||||
|
||||
// 4. Compile
|
||||
try
|
||||
// To get type info, we re-bind/check manually as Compile doesn't return the TypedAST.
|
||||
var log := TCompilerLog.Create as ICompilerLog;
|
||||
|
||||
// We need to expand macros first to match the structure Compile used
|
||||
var expanded := FEnv.ExpandMacros(logicalAst);
|
||||
var typedAst := FEnv.Bind(expanded, [], log);
|
||||
|
||||
var specAst := FEnv.Specialize(typedAst);
|
||||
|
||||
ApplyTypes(specAst);
|
||||
|
||||
if specAst.Kind = akLambdaExpression then
|
||||
var compiled := FEnv.Link(specAst.AsLambdaExpression, log);
|
||||
|
||||
ApplyErrors(log);
|
||||
except
|
||||
on E: ECompilationFailed do
|
||||
begin
|
||||
var tempLog := TCompilerLog.Create as ICompilerLog;
|
||||
for var err in E.Errors do
|
||||
tempLog.Add(err.Level, err.Message, err.Node);
|
||||
ApplyErrors(tempLog);
|
||||
end;
|
||||
end;
|
||||
|
||||
FWorkspace.Repaint;
|
||||
end;
|
||||
|
||||
{ TAstEditorController.TTypePropagator }
|
||||
|
||||
constructor TAstEditorController.TTypePropagator.Create(AMap: TNodeMap);
|
||||
begin
|
||||
inherited Create;
|
||||
FMap := AMap;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.TTypePropagator.ApplyType(const Node: IAstNode);
|
||||
var
|
||||
viewNode: TAstViewNode;
|
||||
begin
|
||||
if Assigned(Node) and Assigned(Node.Identity) then
|
||||
begin
|
||||
if FMap.TryGetValue(Node.Identity, viewNode) then
|
||||
begin
|
||||
if Node.IsTyped then
|
||||
begin
|
||||
var st := Node.AsTypedNode.StaticType;
|
||||
if Assigned(st) then
|
||||
viewNode.TypeInfoText := st.ToString;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.TTypePropagator.Accept(const Node: IAstNode);
|
||||
begin
|
||||
if Node = nil then
|
||||
Exit;
|
||||
|
||||
// 1. Apply side effect
|
||||
ApplyType(Node);
|
||||
|
||||
// 2. Continue traversal (Standard TAstVisitor logic calls VisitXY which calls Accept for children)
|
||||
Node.Accept(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user