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

Macro expander integrated in binder

Browse Source
This commit is contained in:
Michael Schimmel
2025-10-04 19:05:50 +02:00
parent d9219474e0
commit 7c48e9e203
16 changed files with 487 additions and 522 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+1
View File
@@ -81,3 +81,4 @@ __recovery/
# Boss dependency manager vendor folder https://github.com/HashLoad/boss
modules/
.vscode
ASTPlayground/ASTPlayground.delphilsp.json
+1
View File
File diff suppressed because one or more lines are too long
ASTPlayground/ASTPlayground.dpr
+2 -2
View File
@@ -1,6 +1,7 @@
program ASTPlayground;
uses
FastMM5,
System.StartUpCopy,
FMX.Forms,
MainForm in 'MainForm.pas' {Form1},
@@ -19,8 +20,7 @@ uses
Myc.Fmx.AstEditor.Workspace in 'Myc.Fmx.AstEditor.Workspace.pas',
Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas',
Myc.Utils in '..\Src\Myc.Utils.pas',
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas',
Myc.Ast.MacroExpander in '..\Src\AST\Myc.Ast.MacroExpander.pas';
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
-2
View File
@@ -134,7 +134,6 @@
</DelphiCompile>
<DCCReference Include="MainForm.pas">
<Form>Form1</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="..\Src\AST\Myc.Ast.Evaluator.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Nodes.pas"/>
@@ -152,7 +151,6 @@
<DCCReference Include="Myc.Fmx.AstEditor.Text.pas"/>
<DCCReference Include="..\Src\Myc.Utils.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Script.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.MacroExpander.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
ASTPlayground/MainForm.fmx
-20
View File
@@ -20,7 +20,6 @@ object Form1: TForm1
Position.Y = 32.000000000000000000
TabOrder = 1
Text = 'Test 1'
TextSettings.Trimming = None
OnClick = Test1ButtonClick
end
object Test2Button: TButton
@@ -28,7 +27,6 @@ object Form1: TForm1
Position.Y = 62.000000000000000000
TabOrder = 2
Text = 'Test 2'
TextSettings.Trimming = None
OnClick = Test2ButtonClick
end
object PrettyPrintButton: TButton
@@ -36,7 +34,6 @@ object Form1: TForm1
Position.Y = 479.000000000000000000
TabOrder = 3
Text = 'Print'
TextSettings.Trimming = None
OnClick = PrettyPrintButtonClick
end
object RecursionButton: TButton
@@ -47,7 +44,6 @@ object Form1: TForm1
Size.PlatformDefault = False
TabOrder = 4
Text = 'Recursion'
TextSettings.Trimming = None
OnClick = RecursionButtonClick
end
object ShowScopeBox: TCheckBox
@@ -61,7 +57,6 @@ object Form1: TForm1
Position.Y = 122.000000000000000000
TabOrder = 7
Text = 'Fibonacci'
TextSettings.Trimming = None
OnClick = FibonacciButtonClick
end
object CrerateTriggerExampleButton: TButton
@@ -69,7 +64,6 @@ object Form1: TForm1
Position.Y = 168.000000000000000000
TabOrder = 8
Text = 'TriggerTest'
TextSettings.Trimming = None
OnClick = CreateTriggerExampleButtonClick
end
object DoTriggerButton: TButton
@@ -77,13 +71,11 @@ object Form1: TForm1
Position.Y = 198.000000000000000000
TabOrder = 9
Text = 'Trigger!'
TextSettings.Trimming = None
OnClick = DoTriggerButtonClick
object DoTrigger2Button: TButton
Position.Y = 30.000000000000000000
TabOrder = 5
Text = 'Trigger2'
TextSettings.Trimming = None
OnClick = DoTrigger2ButtonClick
end
end
@@ -95,7 +87,6 @@ object Form1: TForm1
Size.PlatformDefault = False
TabOrder = 10
Text = 'Clear'
TextSettings.Trimming = None
OnClick = ClearButtonClick
end
object FlowOnlyBox: TCheckBox
@@ -113,7 +104,6 @@ object Form1: TForm1
Size.PlatformDefault = False
TabOrder = 13
Text = 'Series'
TextSettings.Trimming = None
OnClick = SeriesTestButtonClick
end
object OHLCButton: TButton
@@ -121,7 +111,6 @@ object Form1: TForm1
Position.Y = 288.000000000000000000
TabOrder = 14
Text = 'OHLC'
TextSettings.Trimming = None
OnClick = OHLCButtonClick
end
object DebugBox: TCheckBox
@@ -135,7 +124,6 @@ object Form1: TForm1
Position.Y = 602.000000000000000000
TabOrder = 16
Text = 'From JSON'
TextSettings.Trimming = None
OnClick = FromJSONButtonClick
end
object ToJSONButton: TButton
@@ -143,7 +131,6 @@ object Form1: TForm1
Position.Y = 632.000000000000000000
TabOrder = 17
Text = 'To JSON'
TextSettings.Trimming = None
OnClick = ToJSONButtonClick
end
object ExternalFuncButton: TButton
@@ -151,7 +138,6 @@ object Form1: TForm1
Position.Y = 318.000000000000000000
TabOrder = 18
Text = 'External Func'
TextSettings.Trimming = None
OnClick = ExternalFuncButtonClick
end
object InnerLambdaButton: TButton
@@ -159,7 +145,6 @@ object Form1: TForm1
Position.Y = 348.000000000000000000
TabOrder = 19
Text = 'Inner Lambda'
TextSettings.Trimming = None
OnClick = InnerLambdaButtonClick
end
object DumpButton: TButton
@@ -167,7 +152,6 @@ object Form1: TForm1
Position.Y = 509.000000000000000000
TabOrder = 20
Text = 'Dump'
TextSettings.Trimming = None
OnClick = DumpButtonClick
end
object FailingUpvalueButton: TButton
@@ -175,7 +159,6 @@ object Form1: TForm1
Position.Y = 378.000000000000000000
TabOrder = 22
Text = 'Upvalue'
TextSettings.Trimming = None
OnClick = FailingUpvalueButtonClick
end
object TailCallButten: TButton
@@ -183,7 +166,6 @@ object Form1: TForm1
Position.Y = 406.000000000000000000
TabOrder = 23
Text = 'Tail calls'
TextSettings.Trimming = None
OnClick = TailCallButtenClick
end
object SaveUserLibButton: TButton
@@ -191,7 +173,6 @@ object Form1: TForm1
Position.Y = 680.000000000000000000
TabOrder = 24
Text = 'Save Lib'
TextSettings.Trimming = None
OnClick = SaveUserLibButtonClick
end
object LoadUserLibButton: TButton
@@ -199,7 +180,6 @@ object Form1: TForm1
Position.Y = 710.000000000000000000
TabOrder = 25
Text = 'LoadLib'
TextSettings.Trimming = None
OnClick = LoadUserLibButtonClick
end
end
ASTPlayground/MainForm.pas
+23 -29
View File
@@ -33,7 +33,6 @@ uses
Myc.Ast.Binding,
Myc.Ast.RTL,
Myc.Ast.Script,
Myc.Ast.MacroExpander,
FMX.Layouts,
FMX.Objects,
Myc.Ast.Debugger,
@@ -114,7 +113,7 @@ type
FTriggerScope: IExecutionScope;
FScriptUpdate: Boolean;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
function CreateEvaluator(Scope: IExecutionScope): IEvaluatorVisitor;
function CreateEvaluator(const Scope: IExecutionScope): IEvaluatorVisitor;
// Helper function to encapsulate the Bind -> Evaluate pattern
function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
procedure UpdateScript;
@@ -212,31 +211,26 @@ end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
var
binder: IAstBinder;
scriptScope: IExecutionScope;
boundAst: IAstNode;
descriptor: IScopeDescriptor;
evalScope: IExecutionScope;
visitor: IEvaluatorVisitor;
begin
var macroExpander :=
TMacroExpander.Create(
function(const ANode: IAstNode): TDataValue
begin
var binder := TAstBinder.Create(AParentScope) as IAstBinder;
// The new, streamlined pipeline: The binder handles macro expansion internally.
var descriptor: IScopeDescriptor;
var boundAst := binder.Execute(ANode, descriptor);
// Step 1: Create a binder, passing the evaluator factory for compile-time evaluations.
binder := TAstBinder.Create(AParentScope, CreateEvaluator);
var evalScope := descriptor.CreateScope(AParentScope);
var evaluator := CreateEvaluator(evalScope);
boundAst := binder.Execute(ANode, descriptor);
Result := evaluator.Execute(boundAst);
end)
as IMacroExpander;
// Store the final bound AST for visualization and debugging.
FCurrAst := ANode;
FCurrDesc := descriptor;
binder := TAstBinder.Create(AParentScope);
FCurrAst := binder.Execute(macroExpander.Execute(ANode), FCurrDesc);
scriptScope := FCurrDesc.CreateScope(AParentScope);
visitor := CreateEvaluator(scriptScope);
Result := visitor.Execute(FCurrAst);
// Step 2: Create the final scope and evaluator for runtime execution.
evalScope := descriptor.CreateScope(AParentScope);
visitor := CreateEvaluator(evalScope);
Result := visitor.Execute(boundAst);
end;
procedure TForm1.FormCreate(Sender: TObject);
@@ -307,7 +301,7 @@ begin
)
);
binder := TAstBinder.Create(Scope);
binder := TAstBinder.Create(Scope, CreateEvaluator);
boundSmaAst := binder.Execute(smaAst, smaDescriptor);
smaScope := smaDescriptor.CreateScope(Scope);
@@ -496,7 +490,7 @@ begin
raise EJSONParseException.Create('Invalid JSON format.');
try
var binder := TAstBinder.Create(FGScope);
var binder := TAstBinder.Create(FGScope, CreateEvaluator);
var unboundAst := converter.Deserialize(jsonObj);
FCurrAst := binder.Execute(unboundAst, FCurrDesc);
Memo1.Lines.Add('AST deserialized successfully from JSON.');
@@ -566,7 +560,7 @@ begin
end;
// Re-bind the current AST against the global scope to ensure up-to-date binding info for the dump.
binder := TAstBinder.Create(FGScope);
binder := TAstBinder.Create(FGScope, CreateEvaluator);
boundNode := binder.Execute(FCurrAst, FCurrDesc);
TAstDumper.Dump(boundNode, Memo1.Lines);
end;
@@ -608,7 +602,7 @@ begin
]
);
binder := TAstBinder.Create(FGScope);
binder := TAstBinder.Create(FGScope, CreateEvaluator);
var desc: IScopeDescriptor;
boundFibAst := binder.Execute(fibAst, desc);
fibScope := desc.CreateScope(FGScope);
@@ -902,7 +896,7 @@ begin
);
// 1. Bind and execute the setup script.
binder := TAstBinder.Create(FGScope);
binder := TAstBinder.Create(FGScope, CreateEvaluator);
boundSetupAst := binder.Execute(setupAst, setupDescriptor);
scope := setupDescriptor.CreateScope(FGScope);
@@ -915,7 +909,7 @@ begin
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// 3. Re-bind the call AST within the now-populated scope to resolve the new variable.
binder := TAstBinder.Create(scope);
binder := TAstBinder.Create(scope, CreateEvaluator);
boundCallAst := binder.Execute(callAst, callDescriptor);
// 4. Get the address of 'current_series' from the new descriptor.
@@ -1041,7 +1035,7 @@ begin
]
);
binder := TAstBinder.Create(FGScope);
binder := TAstBinder.Create(FGScope, CreateEvaluator);
FCurrAst := binder.Execute(blk, FCurrDesc);
FTriggerScope := FCurrDesc.CreateScope(FGScope);
@@ -1053,7 +1047,7 @@ begin
UpdateScript;
end;
function TForm1.CreateEvaluator(Scope: IExecutionScope): IEvaluatorVisitor;
function TForm1.CreateEvaluator(const Scope: IExecutionScope): IEvaluatorVisitor;
begin
if DebugBox.IsChecked then
Result := TDebugEvaluatorVisitor.Create(Scope, Memo1.Lines, ShowScopeBox.IsChecked)
Src/AST/Myc.Ast.Binding.pas
+427 -185
View File
@@ -14,16 +14,29 @@ uses
Myc.Ast;
type
// The binder is a transformer that enriches the AST with semantic information
// like resolved addresses, scopes, and tail-call annotations.
IAstBinder = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
end;
TAstBinder = class; // Forward declaration
// This visitor handles the expansion of a single macro body (` `...`).
// It correctly distinguishes between syntactic unquoting and value unquoting.
TExpansionVisitor = class(TAstTransformer)
private
FBinder: TAstBinder;
FMacroScope: IExecutionScope;
protected
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
public
constructor Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope);
end;
TAstBinder = class(TAstTransformer, IAstBinder)
private
type
// Helper class to track upvalues for a lambda expression.
TUpvalueMapping = class
public
Map: TDictionary<TResolvedAddress, Integer>;
@@ -32,24 +45,23 @@ type
destructor Destroy; override;
end;
private
FInitialScope: IExecutionScope;
FCurrentDescriptor: IScopeDescriptor;
FUpvalueStack: TStack<TUpvalueMapping>;
FNestedLambdaCount: Integer;
FIsTailStack: TStack<Boolean>;
FNextIsTail: Boolean;
// Contains all variable declarations that are captured by a closure.
// This is populated by a pre-pass before the transformation begins.
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FEvaluatorFactory: TEvaluatorFactory;
FMacros: TDictionary<string, IMacroDefinitionNode>;
procedure EnterScope;
procedure ExitScope;
function IsValidIdentifier(const Name: string): Boolean;
function EvaluateAtCompileTime(const ANode: IAstNode): TDataValue;
protected
// Stack management for tail-call state is centralized here.
function Accept(const Node: IAstNode): TDataValue; override;
// The binder overrides specific visit methods to enrich the AST.
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
@@ -62,10 +74,10 @@ type
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
public
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
end;
@@ -77,7 +89,6 @@ type
property Address: TResolvedAddress read FAddress;
end;
// A bound variable declaration node that includes whether the variable is captured (boxed).
TBoundVariableDeclarationNode = class(TVariableDeclarationNode)
private
FIsBoxed: Boolean;
@@ -100,7 +111,6 @@ type
const AUpvalues: TArray<TResolvedAddress>;
AHasNestedLambdas: Boolean
);
property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read FUpvalues;
property HasNestedLambdas: Boolean read FHasNestedLambdas;
@@ -126,13 +136,107 @@ uses
System.Character;
type
// A custom equality comparer for TResolvedAddress to ensure correct behavior in TDictionary.
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
public
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
{ TExpansionVisitor }
constructor TExpansionVisitor.Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope);
begin
inherited Create;
FBinder := ABinder;
FMacroScope := AMacroScope;
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
var
value: TDataValue;
expr: IAstNode;
addr: TResolvedAddress;
begin
expr := Node.Expression;
// Check if the expression is a simple identifier that refers to a macro parameter.
if (expr is TIdentifierNode) then
begin
addr := FMacroScope.CreateDescriptor.FindSymbol((expr as TIdentifierNode).Name);
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
begin
// It's a macro parameter. Get its value, which is the AST passed as an argument.
var argValue := FMacroScope.Values[addr];
if argValue.Kind = vkInterface then
begin
// This is syntactic unquoting. Return the AST directly.
Result := argValue;
exit;
end;
end;
end;
// If it's not a parameter or the parameter doesn't hold an AST, it's value unquoting.
// Evaluate the expression at compile time using the binder's context.
value := FBinder.EvaluateAtCompileTime(expr);
// Convert the resulting value back into an AST node to splice it into the tree.
if value.Kind in [vkScalar, vkText, vkVoid] then
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value))
else
// For now, other complex types are not supported for value unquoting.
raise Exception.CreateFmt('Cannot unquote complex value of type %s at compile time.', [value.Kind.ToString]);
end;
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
// Similar to VisitUnquote, but we expect the result to be a list of nodes.
// We evaluate the inner expression. The result is a TDataValue.
// We don't do anything with it here; we just return it.
// The VisitFunctionCall override will check for this and perform the "splicing".
var value := VisitUnquote(TAst.Unquote(Node.Expression)).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IUnquoteSplicingNode>(TAst.UnquoteSplicing(value));
end;
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
newArgs: TList<IAstNode>;
transformedArg: IAstNode;
splicingNode: IUnquoteSplicingNode;
begin
// This override handles splicing arguments (~@).
newArgs := TList<IAstNode>.Create;
try
for var arg in Node.Arguments do
begin
var transformedArgValue := Self.Accept(arg); // This might return an UnquoteSplicing node.
if transformedArgValue.IsVoid then
continue;
transformedArg := transformedArgValue.AsIntf<IAstNode>;
if (transformedArg is TUnquoteSplicingNode) then
begin
splicingNode := transformedArg as TUnquoteSplicingNode;
// The inner expression should have been evaluated to an AST block
if (splicingNode.Expression is TBlockExpressionNode) then
newArgs.AddRange((splicingNode.Expression as TBlockExpressionNode).Expressions)
else
raise Exception.Create('Expression inside unquote-splicing (`~@`) must evaluate to a list of nodes (a block).');
end
else
begin
newArgs.Add(transformedArg);
end;
end;
var transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs.ToArray));
finally
newArgs.Free;
end;
end;
{ TBoundIdentifierNode }
constructor TBoundIdentifierNode.Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
begin
@@ -204,15 +308,23 @@ begin
inherited Destroy;
end;
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
begin
inherited Create;
Assert(Assigned(AInitialScope));
Assert(Assigned(AEvaluatorFactory));
FInitialScope := AInitialScope;
FEvaluatorFactory := AEvaluatorFactory;
FCurrentDescriptor := AInitialScope.CreateDescriptor;
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
FNestedLambdaCount := 0;
FIsTailStack := TStack<Boolean>.Create;
FNextIsTail := True;
FBoxedDeclarations := nil;
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
end;
destructor TAstBinder.Destroy;
@@ -220,6 +332,7 @@ begin
FIsTailStack.Free;
FUpvalueStack.Free;
FBoxedDeclarations.Free;
FMacros.Free;
inherited;
end;
@@ -241,16 +354,46 @@ begin
FCurrentDescriptor := TScope.CreateDescriptor(FCurrentDescriptor);
end;
function TAstBinder.EvaluateAtCompileTime(const ANode: IAstNode): TDataValue;
var
subBinder: IAstBinder;
subDescriptor: IScopeDescriptor;
boundSubAst: IAstNode;
evalScope: IExecutionScope;
evaluator: IEvaluatorVisitor;
tempInitScope: IExecutionScope;
begin
// Create a temporary scope that represents the binder's current lexical context.
tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil);
// 1. Bind the sub-tree in a new binder, using the current scope descriptor.
subBinder := TAstBinder.Create(tempInitScope, FEvaluatorFactory);
boundSubAst := subBinder.Execute(ANode, subDescriptor);
// 2. Create the execution scope for this specific evaluation.
evalScope := subDescriptor.CreateScope(tempInitScope);
// 3. Create the correct evaluator (Debug/Production) using the injected factory.
evaluator := FEvaluatorFactory(evalScope);
// 4. Execute and return the resulting value.
Result := evaluator.Execute(boundSubAst);
end;
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
// First pass: Analyze the entire AST to find all variable declarations
// that are captured by closures (upvalues).
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
try
// Second pass: Transform the tree, using the information from the analysis pass.
EnterScope;
try
Result := Accept(RootNode).AsIntf<IAstNode>;
var transformedNode := Accept(RootNode).AsIntf<IAstNode>;
// If the result of the transformation is a single void constant, return an empty block instead.
if (transformedNode is TConstantNode) and (TConstantNode(transformedNode).Value.IsVoid) then
Result := TAst.Block([])
else
Result := transformedNode;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
@@ -260,6 +403,101 @@ begin
end;
end;
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// Register the macro for the current binder instance.
FMacros.AddOrSetValue(Node.Name.Name, Node);
// Return an empty block node. This is a valid "no-op" node
// that is simply ignored by the evaluator.
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block([]));
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
macroDef: IMacroDefinitionNode;
calleeIdentifier: TIdentifierNode;
i: Integer;
expansionScope: IExecutionScope;
expander: TExpansionVisitor;
expandedBody: IAstNode;
isTailCall: Boolean;
callee: IAstNode;
args: TArray<IAstNode>;
boundCall: IFunctionCallNode;
begin
// First, check if this is a macro call.
if (Node.Callee is TIdentifierNode) then
begin
calleeIdentifier := Node.Callee as TIdentifierNode;
if FMacros.TryGetValue(calleeIdentifier.Name, macroDef) then
begin
// It's a macro. Expand it now.
expansionScope := TAst.CreateScope(nil);
// Check for variadic macro parameter
var params := macroDef.Parameters;
var lastParamName := '';
if Length(params) > 0 then
lastParamName := params[High(params)].Name;
if (Length(params) > 1) and (lastParamName.StartsWith('&')) then
begin
var requiredArgs := Length(params) - 1;
if Length(Node.Arguments) < requiredArgs then
raise Exception.CreateFmt(
'Macro %s expects at least %d arguments, but got %d',
[calleeIdentifier.Name, requiredArgs, Length(Node.Arguments)]);
// Bind fixed arguments
for i := 0 to requiredArgs - 1 do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// Bind rest arguments as a list (AST block)
var restArgs: TArray<IAstNode>;
SetLength(restArgs, Length(Node.Arguments) - requiredArgs);
for i := 0 to High(restArgs) do
restArgs[i] := Node.Arguments[requiredArgs + i];
expansionScope.Define(lastParamName.Substring(1), TDataValue.FromIntf<IAstNode>(TAst.Block(restArgs)));
end
else
begin
if Length(Node.Arguments) <> Length(params) then
raise Exception.CreateFmt(
'Macro %s expects %d arguments, but got %d',
[calleeIdentifier.Name, Length(params), Length(Node.Arguments)]);
for i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
end;
// A macro body MUST be a quasiquote.
if not (macroDef.Body is TQuasiquoteNode) then
raise Exception.CreateFmt('Macro body for "%s" must be a quasiquoted expression.', [calleeIdentifier.Name]);
// Use the dedicated expansion visitor to process the CONTENT of the macro body.
var quasiquoteBody := macroDef.Body as TQuasiquoteNode;
expander := TExpansionVisitor.Create(Self, expansionScope);
expandedBody := expander.Execute(quasiquoteBody.Expression);
// IMPORTANT: Recursively call Accept on the newly generated AST fragment
// to bind it within the current scope.
Result := Self.Accept(expandedBody);
exit;
end;
end;
// It's a regular function call, proceed with normal binding.
isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := TransformNodes<IAstNode>(Node.Arguments);
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
Result := TDataValue.FromIntf<IFunctionCallNode>(boundCall);
end;
procedure TAstBinder.ExitScope;
begin
FCurrentDescriptor := FCurrentDescriptor.Parent;
@@ -284,6 +522,176 @@ begin
Result := True;
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
FNextIsTail := False;
Result := inherited VisitAssignment(Node);
end;
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
FNextIsTail := False;
Result := inherited VisitBinaryExpression(Node);
end;
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
exprs: TArray<IAstNode>;
i: Integer;
isContextTail: Boolean;
transformedValue: TDataValue;
exprList: TList<IAstNode>;
begin
isContextTail := FIsTailStack.Peek;
exprList := TList<IAstNode>.Create;
try
for i := 0 to High(Node.Expressions) do
begin
FNextIsTail := isContextTail and (i = High(Node.Expressions));
transformedValue := Accept(Node.Expressions[i]);
// If a sub-expression (like a macro definition) returns void, skip it.
if not transformedValue.IsVoid then
exprList.Add(transformedValue.AsIntf<IAstNode>);
end;
exprs := exprList.ToArray;
finally
exprList.Free;
end;
// Avoid creating a new node if nothing changed.
if (Length(exprs) = Length(Node.Expressions)) then
begin
var same := True;
for i := 0 to High(exprs) do
if exprs[i] <> Node.Expressions[i] then
begin
same := False;
break;
end;
if same then
begin
Result := TDataValue.FromIntf<IBlockExpressionNode>(Node);
exit;
end;
end;
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(exprs));
end;
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TDataValue.FromIntf<IIfExpressionNode>(TAst.IfExpr(condition, thenBranch, elseBranch))
else
Result := TDataValue.FromIntf<IIfExpressionNode>(Node);
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
i: integer;
boundParams: TArray<IIdentifierNode>;
boundBody: IAstNode;
lambdaScope: IScopeDescriptor;
upvalues: TArray<TResolvedAddress>;
hasNestedLambdas: Boolean;
lastNestedLambdaCount: Integer;
boundLambda: ILambdaExpressionNode;
begin
FUpvalueStack.Push(TUpvalueMapping.Create);
try
EnterScope;
try
FCurrentDescriptor.Define('<self>');
SetLength(boundParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramNode := Node.Parameters[i];
var slotIndex := FCurrentDescriptor.Define(paramNode.Name);
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
end;
lastNestedLambdaCount := FNestedLambdaCount;
FNextIsTail := True;
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
finally
ExitScope;
end;
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.Map.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
sortedPairs,
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
)
);
SetLength(upvalues, Length(sortedPairs));
for i := 0 to High(sortedPairs) do
upvalues[i] := sortedPairs[i].Key;
finally
FUpvalueStack.Pop;
end;
inc(FNestedLambdaCount);
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
Result := TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda);
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
FNextIsTail := False;
Result := inherited VisitRecurNode(Node);
end;
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TDataValue.FromIntf<ITernaryExpressionNode>(TAst.TernaryExpr(condition, thenBranch, elseBranch))
else
Result := TDataValue.FromIntf<ITernaryExpressionNode>(Node);
end;
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
FNextIsTail := False;
Result := inherited VisitUnaryExpression(Node);
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
adr: TResolvedAddress;
@@ -346,170 +754,4 @@ begin
Result := TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl);
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
FNextIsTail := False;
Result := inherited VisitAssignment(Node);
end;
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
FNextIsTail := False;
Result := inherited VisitBinaryExpression(Node);
end;
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
FNextIsTail := False;
Result := inherited VisitUnaryExpression(Node);
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
i: integer;
boundParams: TArray<IIdentifierNode>;
boundBody: IAstNode;
lambdaScope: IScopeDescriptor;
upvalues: TArray<TResolvedAddress>;
hasNestedLambdas: Boolean;
lastNestedLambdaCount: Integer;
boundLambda: ILambdaExpressionNode;
begin
FUpvalueStack.Push(TUpvalueMapping.Create);
try
EnterScope;
try
FCurrentDescriptor.Define('<self>');
SetLength(boundParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramNode := Node.Parameters[i];
var slotIndex := FCurrentDescriptor.Define(paramNode.Name);
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
end;
lastNestedLambdaCount := FNestedLambdaCount;
FNextIsTail := True;
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
finally
ExitScope;
end;
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.Map.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
sortedPairs,
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
)
);
SetLength(upvalues, Length(sortedPairs));
for i := 0 to High(sortedPairs) do
upvalues[i] := sortedPairs[i].Key;
finally
FUpvalueStack.Pop;
end;
inc(FNestedLambdaCount);
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
Result := TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda);
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
isTailCall: Boolean;
callee: IAstNode;
args: TArray<IAstNode>;
boundCall: IFunctionCallNode;
begin
isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := TransformNodes<IAstNode>(Node.Arguments);
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
Result := TDataValue.FromIntf<IFunctionCallNode>(boundCall);
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
FNextIsTail := False;
Result := inherited VisitRecurNode(Node);
end;
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
exprs: TArray<IAstNode>;
i: Integer;
isContextTail: Boolean;
begin
isContextTail := FIsTailStack.Peek;
SetLength(exprs, Length(Node.Expressions));
for i := 0 to High(exprs) do
begin
FNextIsTail := isContextTail and (i = High(exprs));
exprs[i] := Accept(Node.Expressions[i]).AsIntf<IAstNode>;
end;
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(exprs));
end;
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TDataValue.FromIntf<IIfExpressionNode>(TAst.IfExpr(condition, thenBranch, elseBranch))
else
Result := TDataValue.FromIntf<IIfExpressionNode>(Node);
end;
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// The binder runs after the macro expander. It should never see a macro definition.
raise Exception.Create('IMacroDefinitionNode found in AST after macro expansion phase.');
end;
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TDataValue.FromIntf<ITernaryExpressionNode>(TAst.TernaryExpr(condition, thenBranch, elseBranch))
else
Result := TDataValue.FromIntf<ITernaryExpressionNode>(Node);
end;
end.
Src/AST/Myc.Ast.Evaluator.pas
-7
View File
@@ -14,13 +14,6 @@ uses
Myc.Ast.Scope;
type
IEvaluatorVisitor = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): TDataValue;
end;
// A factory for creating visitors, primarily used by the debugger subsystem.
TEvaluatorFactory = reference to function(const Scope: IExecutionScope): IEvaluatorVisitor;
// The standard AST evaluator for production use.
TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor)
private
Src/AST/Myc.Ast.MacroExpander.pas
-269
View File
@@ -1,269 +0,0 @@
unit Myc.Ast.MacroExpander;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Ast.Visitor;
type
// Defines the strategy for compiling and evaluating an AST node at compile time.
TCompileTimeExecutor = reference to function(const ANode: IAstNode): TDataValue;
IMacroExpander = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
// The macro expander is now a pure AST transformation engine.
TMacroExpander = class(TAstTransformer, IMacroExpander)
private
FMacros: TDictionary<string, IMacroDefinitionNode>;
FExecutor: TCompileTimeExecutor;
function ExpandNode(const ANode: IAstNode): IAstNode;
protected
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
public
constructor Create(const AExecutor: TCompileTimeExecutor);
destructor Destroy; override;
function Execute(const RootNode: IAstNode): IAstNode;
end;
implementation
uses
Myc.Ast;
type
TExpansionHelper = class(TAstTransformer)
private
FExpansionScope: IExecutionScope;
FExpander: TMacroExpander;
FExecutor: TCompileTimeExecutor;
protected
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
public
constructor Create(AExpansionScope: IExecutionScope; AExpander: TMacroExpander; AExecutor: TCompileTimeExecutor);
class function Expand(
Node: IAstNode;
ExpansionScope: IExecutionScope;
Expander: TMacroExpander;
Executor: TCompileTimeExecutor
): IAstNode; static;
end;
TSubstitutor = class(TAstTransformer)
private
FParamScope: IExecutionScope;
protected
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
public
constructor Create(AParamScope: IExecutionScope);
end;
{ TMacroExpander }
constructor TMacroExpander.Create(const AExecutor: TCompileTimeExecutor);
begin
inherited Create;
Assert(Assigned(AExecutor), 'A TCompileTimeExecutor must be provided.');
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
FExecutor := AExecutor;
end;
destructor TMacroExpander.Destroy;
begin
FMacros.Free;
inherited;
end;
function TMacroExpander.ExpandNode(const ANode: IAstNode): IAstNode;
var
lastNode: IAstNode;
begin
Result := ANode;
if not Assigned(Result) then
exit;
repeat
lastNode := Result;
Result := Self.Accept(lastNode).AsIntf<IAstNode>;
until Result = lastNode;
end;
function TMacroExpander.Execute(const RootNode: IAstNode): IAstNode;
begin
FMacros.Clear;
Result := ExpandNode(RootNode);
end;
function TMacroExpander.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
macroDef: IMacroDefinitionNode;
expandedNode: IAstNode;
i: Integer;
begin
if not (Node.Callee is TIdentifierNode) then
begin
Result := inherited VisitFunctionCall(Node);
exit;
end;
var calleeIdentifier := Node.Callee as TIdentifierNode;
if FMacros.TryGetValue(calleeIdentifier.Name, macroDef) then
begin
var expansionScope := TAst.CreateScope(nil); // Temporary scope for parameters, no parent needed.
if Length(Node.Arguments) <> Length(macroDef.Parameters) then
raise Exception.CreateFmt(
'Macro %s expects %d arguments, but got %d',
[macroDef.Name.Name, Length(macroDef.Parameters), Length(Node.Arguments)]);
for i := 0 to High(macroDef.Parameters) do
expansionScope.Define(macroDef.Parameters[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
if not (macroDef.Body is TQuasiquoteNode) then
raise Exception.CreateFmt('Macro body for "%s" must be a quasiquoted expression.', [macroDef.Name.Name]);
expandedNode := TExpansionHelper.Expand(IQuasiquoteNode(macroDef.Body).Expression, expansionScope, Self, FExecutor);
Result := Self.Accept(expandedNode);
end
else
begin
Result := inherited VisitFunctionCall(Node);
end;
end;
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
FMacros.AddOrSetValue(Node.Name.Name, Node);
Result := TDataValue.FromIntf<IBlockExpressionNode>(TBlockExpressionNode.Create([]));
end;
{ TExpansionHelper }
constructor TExpansionHelper.Create(AExpansionScope: IExecutionScope; AExpander: TMacroExpander; AExecutor: TCompileTimeExecutor);
begin
inherited Create;
FExpansionScope := AExpansionScope;
FExpander := AExpander;
FExecutor := AExecutor;
end;
class function TExpansionHelper.Expand(
Node: IAstNode;
ExpansionScope: IExecutionScope;
Expander: TMacroExpander;
Executor: TCompileTimeExecutor
): IAstNode;
var
helper: TExpansionHelper;
begin
helper := TExpansionHelper.Create(ExpansionScope, Expander, Executor);
try
Result := helper.Accept(Node).AsIntf<IAstNode>;
finally
helper.Free;
end;
end;
function TExpansionHelper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
newArgs: TList<IAstNode>;
transformedArgValue: TDataValue;
transformedArgNode: IAstNode;
transformedCallee: IAstNode;
begin
newArgs := TList<IAstNode>.Create;
try
for var arg in Node.Arguments do
begin
transformedArgValue := Self.Accept(arg);
if transformedArgValue.IsVoid then
continue;
transformedArgNode := transformedArgValue.AsIntf<IAstNode>;
if (transformedArgNode is TBlockExpressionNode) then
newArgs.AddRange((transformedArgNode as TBlockExpressionNode).Expressions)
else
newArgs.Add(transformedArgNode);
end;
transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.FunctionCall(transformedCallee, newArgs.ToArray));
finally
newArgs.Free;
end;
end;
function TExpansionHelper.VisitUnquote(const Node: IUnquoteNode): TDataValue;
var
substitutor: TSubstitutor;
substitutedAst, expandedAst: IAstNode;
value: TDataValue;
begin
// Step 1: Substitute macro parameters with their AST node values.
substitutor := TSubstitutor.Create(FExpansionScope);
try
substitutedAst := substitutor.Execute(Node.Expression);
finally
substitutor.Free;
end;
// Step 2: Recursively expand any macros within the substituted expression.
expandedAst := FExpander.ExpandNode(substitutedAst);
// Step 3: Call the injected executor strategy to bind and evaluate the AST.
value := FExecutor(expandedAst);
// Step 4: Wrap the resulting value for insertion into the template.
if value.Kind in [vkScalar, vkText] then
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value))
else
Result := value;
end;
function TExpansionHelper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
var
unquotedValue: TDataValue;
unquotedNode: IAstNode;
begin
unquotedValue := Self.VisitUnquote(TAst.Unquote(Node.Expression));
if unquotedValue.Kind = vkInterface then
unquotedNode := unquotedValue.AsIntf<IAstNode>
else
unquotedNode := nil;
if not (unquotedNode is TBlockExpressionNode) then
raise Exception.Create('Expression inside unquote-splicing (`~@`) must evaluate to a list of nodes (a block).');
Result := unquotedValue;
end;
{ TSubstitutor }
constructor TSubstitutor.Create(AParamScope: IExecutionScope);
begin
inherited Create;
FParamScope := AParamScope;
end;
function TSubstitutor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
addr: TResolvedAddress;
nodeValue: TDataValue;
begin
addr := FParamScope.CreateDescriptor.FindSymbol(Node.Name);
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
begin
nodeValue := FParamScope.Values[addr];
Result := nodeValue;
exit;
end;
Result := inherited VisitIdentifier(Node);
end;
end.
Src/AST/Myc.Ast.Nodes.pas
+4
View File
@@ -263,6 +263,10 @@ type
property Series: IIdentifierNode read GetSeries;
end;
IEvaluatorVisitor = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): TDataValue;
end;
implementation
uses
Src/AST/Myc.Ast.Scope.pas
+3
View File
@@ -61,6 +61,9 @@ type
property Symbols: TDictionary<string, Integer> read GetSymbols;
end;
// A factory for creating visitors, primarily used by the debugger subsystem.
TEvaluatorFactory = reference to function(const Scope: IExecutionScope): IEvaluatorVisitor;
TScope = record
class function CreateScope(
const Parent: IExecutionScope;
Src/AST/Myc.Ast.Script.pas
+7 -1
View File
@@ -366,7 +366,13 @@ begin
if not (Length(tailNodes) in [2, 3]) then
raise Exception.Create('Syntax Error in if statement.');
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], IfThen(Length(tailNodes) > 2, tailNodes[2], nil))
Result :=
TAst.IfExpr(
tailNodes[0],
tailNodes[1],
if Length(tailNodes) > 2 then tailNodes[2]
else nil
)
end
else if SameText(head.Token.Text, '?') then
begin
Src/AST/Myc.Ast.Visitor.pas
+5 -1
View File
@@ -147,7 +147,11 @@ function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): TData
begin
var condition := Accept(Node.Condition).AsIntf<IAstNode>;
var thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
var elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
var elseBranchValue := Accept(Node.ElseBranch);
var elseBranch :=
if elseBranchValue.IsVoid then nil
else elseBranchValue.AsIntf<IAstNode>;
if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then
Result := TDataValue.FromIntf<IIfExpressionNode>(Node)
else
Src/AST/Myc.Ast.pas
+9 -1
View File
@@ -74,6 +74,7 @@ type
public
constructor Create(const AValue: TDataValue);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property Value: TDataValue read GetValue;
end;
TIdentifierNode = class(TAstNode, IIdentifierNode)
@@ -169,6 +170,7 @@ type
public
constructor Create(const AExpression: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property Expression: IAstNode read GetExpression;
end;
TUnquoteNode = class(TAstNode, IUnquoteNode)
@@ -865,7 +867,13 @@ end;
class function TAst.IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode;
begin
Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch);
Result :=
TIfExpressionNode.Create(
ACondition,
AThenBranch,
if AElseBranch = nil then TBlockExpressionNode.Create([]) as IAstNode
else AElseBranch
);
end;
class function TAst.Indexer(const ABase: IAstNode; const AIndex: IAstNode): IIndexerNode;
Test/MycTests.dpr
+1 -1
View File
@@ -7,13 +7,13 @@ program MycTests;
uses
FastMM5,
DUnitX.MemoryLeakMonitor.FastMM5,
System.SysUtils,
{$IFDEF TESTINSIGHT}
TestInsight.DUnitX,
{$ELSE}
DUnitX.Loggers.Console,
{$ENDIF }
DUnitX.TestFramework,
System.SysUtils,
TestNotifier in 'TestNotifier.pas',
TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',},
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
Test/MycTests.dproj
+4 -4
View File
@@ -159,10 +159,10 @@ $(PreBuildEvent)]]></PreBuildEvent>
<Source Name="MainSource">MycTests.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k290.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp290.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k370.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp370.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k370.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp370.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="5">