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-05 02:45:13 +02:00
parent 54bf350c70
commit 0d73a13051
6 changed files with 373 additions and 218 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+17 -5
View File
@@ -345,17 +345,29 @@ begin
if not (pair.JsonValue is TJSONObject) then
continue;
// First, deserialize the AST node from JSON.
funcAst := converter.Deserialize(pair.JsonValue as TJSONObject);
// Execute the lambda to get a callable function value
var adr := scopeDescr.FindSymbol(pair.JsonString.Value);
if adr.Kind = akUnresolved then
begin
funcValue := ExecuteAst(funcAst, FGScope);
FGScope.Define(pair.JsonString.Value, funcValue);
Memo1.Lines.Add(Format('Defined function "%s"', [pair.JsonString.Value]));
// Distinguish between loading a macro and loading a function.
if funcAst is TMacroDefinitionNode then
begin
// Macros are stored as raw AST nodes in the scope.
FGScope.Define(pair.JsonString.Value, TDataValue.FromIntf<IAstNode>(funcAst));
Memo1.Lines.Add(Format('Defined macro "%s"', [pair.JsonString.Value]));
end
else
begin
// Functions (lambdas) must be executed to create a callable closure.
funcValue := ExecuteAst(funcAst, FGScope);
FGScope.Define(pair.JsonString.Value, funcValue);
Memo1.Lines.Add(Format('Defined function "%s"', [pair.JsonString.Value]));
end;
end
else
Memo1.Lines.Add(Format('Function "%s" already defined', [pair.JsonString.Value]));
Memo1.Lines.Add(Format('Symbol "%s" already defined', [pair.JsonString.Value]));
end;
finally
jsonObj.Free;
Src/AST/Myc.Ast.Binding.pas
+127 -167
View File
@@ -6,6 +6,7 @@ uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
@@ -21,15 +22,16 @@ type
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;
function TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
protected
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
public
constructor Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope);
end;
@@ -53,7 +55,9 @@ type
FNextIsTail: Boolean;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FEvaluatorFactory: TEvaluatorFactory;
FMacros: TDictionary<string, IMacroDefinitionNode>;
// Operator folding maps
FBinaryOperators: TDictionary<string, TScalar.TBinaryOp>;
FUnaryOperators: TDictionary<string, TScalar.TUnaryOp>;
procedure EnterScope;
procedure ExitScope;
@@ -152,6 +156,44 @@ begin
FMacroScope := AMacroScope;
end;
function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
var
newList: TList<IAstNode>;
nodeToSplice: IAstNode;
begin
newList := TList<IAstNode>.Create;
try
for var node in ANodes do
begin
if (node is TUnquoteSplicingNode) then
begin
var spliceExpr := (node as TUnquoteSplicingNode).Expression;
var evaluatedSpliceValue := VisitUnquote(TAst.Unquote(spliceExpr));
if (not evaluatedSpliceValue.IsVoid) and (evaluatedSpliceValue.Kind = vkInterface) then
begin
nodeToSplice := evaluatedSpliceValue.AsIntf<IAstNode>;
if (nodeToSplice is TBlockExpressionNode) then
newList.AddRange((nodeToSplice as TBlockExpressionNode).Expressions)
else
raise Exception.Create('Expression inside unquote-splicing (`~@`) must be a list of nodes (a block).');
end
else
raise Exception.Create('Expression inside unquote-splicing (`~@`) must evaluate to a list of nodes (a block).');
end
else
begin
var transformedValue := node.Accept(self);
if not transformedValue.IsVoid then
newList.Add(transformedValue.AsIntf<IAstNode>);
end;
end;
Result := newList.ToArray;
finally
newList.Free;
end;
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
var
value: TDataValue;
@@ -160,82 +202,49 @@ var
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));
raise Exception.Create('Unquote-splicing (`~@`) can only appear inside a list form (e.g., a function call or a `do` block).');
end;
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
newArgs: TList<IAstNode>;
transformedArg: IAstNode;
splicingNode: IUnquoteSplicingNode;
newArgs: TArray<IAstNode>;
transformedCallee: IAstNode;
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;
transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
newArgs := TransformAndSpliceNodes(Node.Arguments);
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs));
end;
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;
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
newExprs: TArray<IAstNode>;
begin
newExprs := TransformAndSpliceNodes(Node.Expressions);
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(newExprs));
end;
{ TBoundIdentifierNode }
@@ -312,6 +321,8 @@ end;
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
var
op: TScalar.TBinaryOp;
begin
inherited Create;
Assert(Assigned(AInitialScope));
@@ -325,15 +336,24 @@ begin
FIsTailStack := TStack<Boolean>.Create;
FNextIsTail := True;
FBoxedDeclarations := nil;
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
// Initialize operator folding maps
FBinaryOperators := TDictionary<string, TScalar.TBinaryOp>.Create;
for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
FBinaryOperators.Add(op.ToString, op);
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
// Note: '-' is handled as a special case in VisitFunctionCall
end;
destructor TAstBinder.Destroy;
begin
FUnaryOperators.Free;
FBinaryOperators.Free;
FIsTailStack.Free;
FUpvalueStack.Free;
FBoxedDeclarations.Free;
FMacros.Free;
inherited;
end;
@@ -364,20 +384,11 @@ var
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;
@@ -388,15 +399,10 @@ begin
EnterScope;
try
var transformedValue := Accept(RootNode);
// Handle the case where the entire script was just declarations.
if transformedValue.IsVoid then
// Return a valid, empty AST.
Result := TAst.Block([])
else
// The script produced a valid, executable AST.
Result := transformedValue.AsIntf<IAstNode>;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
@@ -408,101 +414,89 @@ 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 and safely handled by all visitors.
FCurrentDescriptor.DefineMacro(Node.Name.Name, Node);
Result := TDataValue.Void;
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;
binaryOp: TScalar.TBinaryOp;
unaryOp: TScalar.TUnaryOp;
macroDef: IMacroDefinitionNode;
begin
// First, check if this is a macro call.
// --- Optimization: Operator Folding ---
if (Node.Callee is TIdentifierNode) then
begin
calleeIdentifier := Node.Callee as TIdentifierNode;
if FMacros.TryGetValue(calleeIdentifier.Name, macroDef) then
// Try to fold binary operators
if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) 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
if Length(Node.Arguments) = 2 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]));
FNextIsTail := False;
var left := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
var right := Accept(Node.Arguments[1]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.BinaryExpr(left, binaryOp, right));
exit;
end;
end;
// Try to fold unary operators
if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then
begin
if Length(Node.Arguments) = 1 then
begin
FNextIsTail := False;
var right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.UnaryExpr(unaryOp, right));
exit;
end;
end;
// Special case for negation '-'
if (calleeIdentifier.Name = '-') and (Length(Node.Arguments) = 1) then
begin
FNextIsTail := False;
var right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right));
exit;
end;
// --- Macro Expansion ---
macroDef := FCurrentDescriptor.FindMacro(calleeIdentifier.Name);
if macroDef <> nil then
begin
var expansionScope := TAst.CreateScope(nil);
var params := macroDef.Parameters;
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 var i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// 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);
// Bind the newly generated AST fragment.
var expander := TExpansionVisitor.Create(Self, expansionScope);
var expandedBody := expander.Execute(quasiquoteBody.Expression);
var boundExpandedBody := Self.Accept(expandedBody).AsIntf<IAstNode>;
// Wrap the result in a TMacroExpansionNode.
// The original 'Node' is passed to preserve the call site information for tools.
var macroNode := TMacroExpansionNode.Create(Node, boundExpandedBody);
Result := TDataValue.FromIntf<IMacroExpansionNode>(macroNode);
exit;
end;
end;
// It's a regular function call, proceed with normal binding.
isTailCall := FIsTailStack.Peek;
// --- Default: Bind as a standard function call ---
var isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := TransformNodes<IAstNode>(Node.Arguments);
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
var callee := Accept(Node.Callee).AsIntf<IAstNode>;
var args := TransformNodes<IAstNode>(Node.Arguments);
var boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
Result := TDataValue.FromIntf<IFunctionCallNode>(boundCall);
end;
@@ -513,22 +507,11 @@ var
boundExpandedBody: IAstNode;
boundOriginalCall: IFunctionCallNode;
begin
// This handles the case where a macro expansion node is injected into the
// tree before binding. The binder must recursively bind its contents.
// 1. Bind the components of the original call site.
boundCallee := Accept(Node.Callee).AsIntf<IAstNode>;
boundArgs := TransformNodes<IAstNode>(Node.Arguments);
// 2. Bind the expanded body.
boundExpandedBody := Accept(Node.ExpandedBody).AsIntf<IAstNode>;
// 3. Re-create the IFunctionCallNode part of the original call with bound children.
boundOriginalCall := TAst.FunctionCall(boundCallee, boundArgs);
// 4. Create a new TMacroExpansionNode that wraps the now-bound components.
var newMacroNode := TMacroExpansionNode.Create(boundOriginalCall, boundExpandedBody);
Result := TDataValue.FromIntf<IMacroExpansionNode>(newMacroNode);
end;
@@ -543,11 +526,9 @@ var
begin
if Name.IsEmpty then
exit(False);
c := Name[1];
if not (c.IsLetter or (c = '_')) then
exit(False);
for c in Name do
begin
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
@@ -583,7 +564,6 @@ begin
begin
FNextIsTail := isContextTail and (i = High(Node.Expressions));
transformedValue := Accept(Node.Expressions[i]);
// If a sub-expression (like a macro definition) returns a void value, skip it.
if not transformedValue.IsVoid then
exprList.Add(transformedValue.AsIntf<IAstNode>);
end;
@@ -592,7 +572,6 @@ begin
exprList.Free;
end;
// Avoid creating a new node if nothing changed.
if (Length(exprs) = Length(Node.Expressions)) then
begin
var same := True;
@@ -618,10 +597,8 @@ var
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>;
@@ -648,7 +625,6 @@ begin
EnterScope;
try
FCurrentDescriptor.Define('<self>');
SetLength(boundParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
@@ -659,10 +635,8 @@ begin
end;
lastNestedLambdaCount := FNestedLambdaCount;
FNextIsTail := True;
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
finally
@@ -677,11 +651,9 @@ begin
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;
@@ -695,7 +667,6 @@ 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;
@@ -706,10 +677,8 @@ var
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>;
@@ -737,17 +706,13 @@ begin
if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
begin
var upvalue := FUpvalueStack.Peek;
// up to outer scope
dec(adr.ScopeDepth);
var upvalueIndex: Integer;
if not upvalue.Map.TryGetValue(adr, upvalueIndex) then
begin
upvalueIndex := upvalue.Map.Count;
upvalue.Map.Add(adr, upvalueIndex);
end;
boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex));
end
else
@@ -777,13 +742,8 @@ begin
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
// Check if the analysis pass marked this declaration as being captured by a closure.
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
// Always create a bound declaration node, passing the IsBoxed flag.
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
Result := TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl);
end;
Src/AST/Myc.Ast.RTL.Core.pas
+166 -6
View File
@@ -10,12 +10,41 @@ uses
type
// Contains the "pure" native implementations.
// These functions work with Delphi-native types (like TScalar) instead of TDataValue,
// making them type-safe and easier to test.
// The registration mechanism below will automatically create the required high-performance
// wrappers to make them available to the script interpreter.
TRtlFunctions = record
public
[TRtlFunction('+')]
class function Add(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('-')]
class function Subtract(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('*')]
class function Multiply(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('/')]
class function Divide(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('=')]
class function Equal(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('<>')]
class function NotEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('<')]
class function LessThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('<=')]
class function LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('>')]
class function GreaterThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('>=')]
class function GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('not')]
class function LogicalNot(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlFunction('Abs')]
class function Abs(const Arg: TScalar): TScalar; static;
@@ -31,8 +60,6 @@ type
[TRtlFunction('Sign')]
class function Sign(const Arg: TScalar): TScalar; static;
// NOTE: Higher-order and complex functions can keep the TDataValue signature for now.
// The registry is smart enough to handle both native types and the TDataValue signature directly.
[TRtlFunction('Memoize')]
class function Memoize(const Args: TArray<TDataValue>): TDataValue; static;
@@ -57,6 +84,139 @@ uses
System.Math,
Myc.Data.Decimal;
{ TRtlFunctions - Operator Implementations }
class function TRtlFunctions.Add(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator + requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Add, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator +.');
Result := res;
end;
class function TRtlFunctions.Subtract(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) = 1 then // Unary negation
begin
if not TScalar.TryUnaryOperation(TScalar.TUnaryOp.Negate, Args[0], res) then
raise EArgumentException.Create('Invalid argument for unary operator -.');
end
else if Length(Args) = 2 then // Binary subtraction
begin
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Subtract, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for binary operator -.');
end
else
raise EArgumentException.Create('Operator - requires 1 or 2 arguments.');
Result := res;
end;
class function TRtlFunctions.Multiply(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator * requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Multiply, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator *.');
Result := res;
end;
class function TRtlFunctions.Divide(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator / requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Divide, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator /.');
Result := res;
end;
class function TRtlFunctions.Equal(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator = requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Equal, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator =.');
Result := res;
end;
class function TRtlFunctions.NotEqual(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator <> requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.NotEqual, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator <>.');
Result := res;
end;
class function TRtlFunctions.LessThan(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator < requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Less, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator <.');
Result := res;
end;
class function TRtlFunctions.LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator <= requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.LessOrEqual, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator <=.');
Result := res;
end;
class function TRtlFunctions.GreaterThan(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator > requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Greater, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator >.');
Result := res;
end;
class function TRtlFunctions.GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator >= requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.GreaterOrEqual, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator >=.');
Result := res;
end;
class function TRtlFunctions.LogicalNot(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 1 then
raise EArgumentException.Create('Operator not requires 1 argument.');
if not TScalar.TryUnaryOperation(TScalar.TUnaryOp.Not, Args[0], res) then
raise EArgumentException.Create('Invalid argument for operator not.');
Result := res;
end;
{ TRtlFunctions - Standard Functions }
class function TRtlFunctions.Abs(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
Src/AST/Myc.Ast.Scope.pas
+52 -8
View File
@@ -45,7 +45,7 @@ type
property Parent: IExecutionScope read GetParent;
end;
// Describes the layout of a scope: variable names and their slot indices.
// Describes the layout of a scope: variable names, their slot indices and macros.
// This is generated by the binder and used to create TExecutionScope instances at runtime.
IScopeDescriptor = interface
{$region 'private'}
@@ -55,7 +55,9 @@ type
{$endregion}
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
function Define(const Name: string): Integer;
procedure DefineMacro(const Name: string; const Node: IMacroDefinitionNode);
function FindSymbol(const Name: string): TResolvedAddress;
function FindMacro(const Name: string): IMacroDefinitionNode;
property Parent: IScopeDescriptor read GetParent;
property SlotCount: Integer read GetSlotCount;
property Symbols: TDictionary<string, Integer> read GetSymbols;
@@ -77,7 +79,8 @@ implementation
uses
System.Generics.Defaults,
System.SyncObjs;
System.SyncObjs,
Myc.Ast;
type
TExecutionScope = class(TInterfacedObject, IExecutionScope)
@@ -132,6 +135,7 @@ type
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
FMacros: TDictionary<string, IMacroDefinitionNode>;
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
@@ -140,7 +144,9 @@ type
destructor Destroy; override;
class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static;
function Define(const Name: string): Integer;
procedure DefineMacro(const Name: string; const Node: IMacroDefinitionNode);
function FindSymbol(const Name: string): TResolvedAddress;
function FindMacro(const Name: string): IMacroDefinitionNode;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(Scope: TExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
@@ -447,16 +453,18 @@ begin
end;
{ TScopeDescriptor }
// ... (Implementation unchanged and correct) ...
constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
end;
destructor TScopeDescriptor.Destroy;
begin
FMacros.Free;
FSymbols.Free;
inherited;
end;
@@ -484,22 +492,42 @@ begin
FSymbols.Add(Name, Result);
end;
function TScopeDescriptor.FindSymbol(const Name: string): TResolvedAddress;
procedure TScopeDescriptor.DefineMacro(const Name: string; const Node: IMacroDefinitionNode);
begin
FMacros.AddOrSetValue(Name, Node);
end;
function TScopeDescriptor.FindMacro(const Name: string): IMacroDefinitionNode;
var
currentDescriptor: TScopeDescriptor;
begin
// Find a macro by searching up the parent scope chain.
Result := nil;
currentDescriptor := Self;
while Assigned(currentDescriptor) do
begin
if currentDescriptor.FMacros.TryGetValue(Name, Result) then
exit;
currentDescriptor := currentDescriptor.FParent as TScopeDescriptor;
end;
end;
function TScopeDescriptor.FindSymbol(const Name: string): TResolvedAddress;
var
currentDescriptor: IScopeDescriptor;
begin
Result.Kind := akUnresolved;
Result.ScopeDepth := 0;
currentDescriptor := Self;
while currentDescriptor <> nil do
while Assigned(currentDescriptor) do
begin
if currentDescriptor.FSymbols.TryGetValue(Name, Result.SlotIndex) then
if currentDescriptor.Symbols.TryGetValue(Name, Result.SlotIndex) then
begin
Result.Kind := akLocalOrParent;
exit;
end;
inc(Result.ScopeDepth);
currentDescriptor := currentDescriptor.FParent as TScopeDescriptor;
currentDescriptor := currentDescriptor.Parent;
end;
end;
@@ -519,15 +547,31 @@ begin
end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
var
val: TDataValue;
begin
// Recreate descriptor by iterating all defined symbols in the runtime scope.
for var pair in Scope.NameToIndex do
begin
var name := Scope.NameStrings[pair.Key];
var slotIndex := pair.Value;
// Add to variable symbol table.
if not FSymbols.ContainsKey(name) then
FSymbols.Add(name, pair.Value);
FSymbols.Add(name, slotIndex);
// Check if the symbol is also a macro and add it to the macro table.
val := Scope.FValues[slotIndex].Value;
if (val.Kind = vkInterface) and (val.AsIntf<IAstNode> is TMacroDefinitionNode) then
begin
if not FMacros.ContainsKey(name) then
FMacros.Add(name, val.AsIntf<IMacroDefinitionNode>);
end;
end;
end;
{ TScope }
class function TScope.CreateDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor;
begin
Result := TScopeDescriptor.Create(Parent);
Src/AST/Myc.Ast.Script.pas
+10 -32
View File
@@ -38,6 +38,7 @@ type
tkQuote, // '
tkBacktick, // `
tkTilde, // ~
tkAt, // @
tkIdentifier,
tkNumber,
tkString,
@@ -251,6 +252,11 @@ begin
Result.Kind := tkTilde;
Advance;
end;
'@':
begin
Result.Kind := tkAt;
Advance;
end;
'"':
begin
Result.Kind := tkString;
@@ -351,7 +357,6 @@ begin
head := elements[0];
// Convert the rest of the list to an array for the factory functions
SetLength(tailTokens, elements.Count - 1);
SetLength(tailNodes, elements.Count - 1);
for var i := 0 to High(tailNodes) do
@@ -391,7 +396,6 @@ begin
end
else if SameText(head.Token.Text, 'defmacro') then
begin
// (defmacro name [params] body)
if (Length(tailNodes) <> 3) or (tailTokens[0].Kind <> tkIdentifier) then
raise Exception.Create('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.');
if elements[2].Params = nil then
@@ -424,34 +428,10 @@ begin
else if SameText(head.Token.Text, 'get') then
Result := TAst.Indexer(tailNodes[0], tailNodes[1])
else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
Result := TAst.MemberAccess(tailNodes[0], TAst.Identifier(head.Token.Text.Substring(1)))
else
begin
if Length(tailNodes) = 1 then
begin
for var op := Low(TScalar.TUnaryOp) to High(TScalar.TUnaryOp) do
begin
if head.Token.Text = op.ToString then
begin
Result := TAst.UnaryExpr(op, tailNodes[0]);
break
end;
end;
end
else if Length(tailNodes) = 2 then
begin
for var op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
begin
if head.Token.Text = op.ToString then
begin
Result := TAst.BinaryExpr(tailNodes[0], op, tailNodes[1]);
break
end;
end;
end;
end;
Result := TAst.MemberAccess(tailNodes[0], TAst.Identifier(head.Token.Text.Substring(1)));
end;
// If no special form matched, treat it as a generic function call.
if Result = nil then
Result := TAst.FunctionCall(head.Node, tailNodes);
@@ -480,14 +460,13 @@ begin
tkTilde:
begin
NextToken;
// Check for unquote-splicing ('~@')
if (FCurrentToken.Kind = tkIdentifier) and (FCurrentToken.Text = '@') then
if FCurrentToken.Kind = tkAt then
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.UnquoteSplicing(expr.Node);
end
else // It's a regular unquote ('~')
else
begin
expr := ParseExpression;
Result.Node := TAst.Unquote(expr.Node);
@@ -498,7 +477,6 @@ begin
begin
NextToken;
expr := ParseExpression;
// A regular quote '(...) can be desugared into (quote (...))
Result.Node := TAst.FunctionCall(TAst.Identifier('quote'), [expr.Node]);
exit;
end;
Src/AST/Myc.Ast.pas
+1
View File
@@ -194,6 +194,7 @@ type
public
constructor Create(const AExpression: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property Expression: IAstNode read GetExpression;
end;
TFunctionCallNode = class(TAstNode, IFunctionCallNode)