diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index c3d40eb..38fe519 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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(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; diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 0103ac7..3d8feaf 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -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): TArray; 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; FEvaluatorFactory: TEvaluatorFactory; - FMacros: TDictionary; + // Operator folding maps + FBinaryOperators: TDictionary; + FUnaryOperators: TDictionary; procedure EnterScope; procedure ExitScope; @@ -152,6 +156,44 @@ begin FMacroScope := AMacroScope; end; +function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: TArray): TArray; +var + newList: TList; + nodeToSplice: IAstNode; +begin + newList := TList.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; + 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); + 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(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; - Result := TDataValue.FromIntf(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; - transformedArg: IAstNode; - splicingNode: IUnquoteSplicingNode; + newArgs: TArray; + transformedCallee: IAstNode; begin - // This override handles splicing arguments (~@). - newArgs := TList.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; + newArgs := TransformAndSpliceNodes(Node.Arguments); + Result := TDataValue.FromIntf(TAst.FunctionCall(transformedCallee, newArgs)); +end; - transformedArg := transformedArgValue.AsIntf; - - 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; - Result := TDataValue.FromIntf(TAst.FunctionCall(transformedCallee, newArgs.ToArray)); - finally - newArgs.Free; - end; +function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; +var + newExprs: TArray; +begin + newExprs := TransformAndSpliceNodes(Node.Expressions); + Result := TDataValue.FromIntf(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.Create; FNextIsTail := True; FBoxedDeclarations := nil; - FMacros := TDictionary.Create; + + // Initialize operator folding maps + FBinaryOperators := TDictionary.Create; + for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do + FBinaryOperators.Add(op.ToString, op); + + FUnaryOperators := TDictionary.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; - 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; - 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(Node.Arguments[i])); - - // Bind rest arguments as a list (AST block) - var restArgs: TArray; - 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(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(Node.Arguments[i])); + FNextIsTail := False; + var left := Accept(Node.Arguments[0]).AsIntf; + var right := Accept(Node.Arguments[1]).AsIntf; + Result := TDataValue.FromIntf(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; + Result := TDataValue.FromIntf(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; + Result := TDataValue.FromIntf(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(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; - - // 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(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; - args := TransformNodes(Node.Arguments); - - boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall); + var callee := Accept(Node.Callee).AsIntf; + var args := TransformNodes(Node.Arguments); + var boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall); Result := TDataValue.FromIntf(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; boundArgs := TransformNodes(Node.Arguments); - - // 2. Bind the expanded body. boundExpandedBody := Accept(Node.ExpandedBody).AsIntf; - - // 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(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); 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; - FNextIsTail := isContextTail; thenBranch := Accept(Node.ThenBranch).AsIntf; elseBranch := Accept(Node.ElseBranch).AsIntf; @@ -648,7 +625,6 @@ begin EnterScope; try FCurrentDescriptor.Define(''); - 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; - hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount; lambdaScope := FCurrentDescriptor; finally @@ -677,11 +651,9 @@ begin function(const Left, Right: TPair): 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; - FNextIsTail := isContextTail; thenBranch := Accept(Node.ThenBranch).AsIntf; elseBranch := Accept(Node.ElseBranch).AsIntf; @@ -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(boundDecl); end; diff --git a/Src/AST/Myc.Ast.RTL.Core.pas b/Src/AST/Myc.Ast.RTL.Core.pas index 2f51874..a6f5346 100644 --- a/Src/AST/Myc.Ast.RTL.Core.pas +++ b/Src/AST/Myc.Ast.RTL.Core.pas @@ -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; static; + + [TRtlFunction('-')] + class function Subtract(const Args: TArray): TDataValue; static; + + [TRtlFunction('*')] + class function Multiply(const Args: TArray): TDataValue; static; + + [TRtlFunction('/')] + class function Divide(const Args: TArray): TDataValue; static; + + [TRtlFunction('=')] + class function Equal(const Args: TArray): TDataValue; static; + + [TRtlFunction('<>')] + class function NotEqual(const Args: TArray): TDataValue; static; + + [TRtlFunction('<')] + class function LessThan(const Args: TArray): TDataValue; static; + + [TRtlFunction('<=')] + class function LessThanOrEqual(const Args: TArray): TDataValue; static; + + [TRtlFunction('>')] + class function GreaterThan(const Args: TArray): TDataValue; static; + + [TRtlFunction('>=')] + class function GreaterThanOrEqual(const Args: TArray): TDataValue; static; + + [TRtlFunction('not')] + class function LogicalNot(const Args: TArray): 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; static; @@ -57,6 +84,139 @@ uses System.Math, Myc.Data.Decimal; +{ TRtlFunctions - Operator Implementations } + +class function TRtlFunctions.Add(const Args: TArray): 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; +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; +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; +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; +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; +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; +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; +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; +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; +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; +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 diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index e09c2c6..72188f3 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -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 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; + FMacros: TDictionary; function GetParent: IScopeDescriptor; function GetSlotCount: Integer; function GetSymbols: TDictionary; @@ -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 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.Create; + FMacros := TDictionary.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 is TMacroDefinitionNode) then + begin + if not FMacros.ContainsKey(name) then + FMacros.Add(name, val.AsIntf); + end; end; end; +{ TScope } + class function TScope.CreateDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor; begin Result := TScopeDescriptor.Create(Parent); diff --git a/Src/AST/Myc.Ast.Script.pas b/Src/AST/Myc.Ast.Script.pas index 58cb2fb..8c0a443 100644 --- a/Src/AST/Myc.Ast.Script.pas +++ b/Src/AST/Myc.Ast.Script.pas @@ -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; diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 6d75bdd..edce060 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -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)