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

Compiler exceptions

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-25 15:51:04 +01:00
parent 4e508d90a5
commit 0a1df4e9fe
9 changed files with 194 additions and 303 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Compiler.Binder.pas
+8
View File
@@ -267,6 +267,10 @@ begin
if not IsValidIdentifier(identifier.Name) then
raise EBinderException.CreateFmt('Invalid identifier name: "%s".', [identifier.Name]);
// Check if the identifier is already defined in the current scope builder to avoid Scope Asserts.
if FCurrentBuilder.FindSlot(identifier.Name) >= 0 then
raise EBinderException.CreateFmt('Variable "%s" is already defined in this scope.', [identifier.Name]);
slot := FCurrentBuilder.Define(identifier.Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
@@ -334,6 +338,10 @@ begin
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
// Parameter names must also be checked for uniqueness, though usually guaranteed by Parser/AST construction
if FCurrentBuilder.FindSlot(Node.Parameters[i].Name) >= 0 then
raise EBinderException.CreateFmt('Duplicate parameter name "%s".', [Node.Parameters[i].Name]);
slot := FCurrentBuilder.Define(Node.Parameters[i].Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
Src/AST/Myc.Ast.Compiler.Macros.pas
+21 -10
View File
@@ -185,12 +185,21 @@ begin
if node.Kind = akUnquoteSplicing then
begin
var spliceExpr := node.AsUnquoteSplicing.Expression;
var evaluatedSpliceValue := FMacroEvaluator(FMacroScope, spliceExpr);
var evaluatedSpliceValue: TDataValue;
// GUARDED EVALUATION
try
evaluatedSpliceValue := FMacroEvaluator(FMacroScope, spliceExpr);
except
on E: EAstException do
raise;
on E: Exception do
raise EMacroException.Create('Error during macro splice evaluation: ' + E.Message);
end;
if (not evaluatedSpliceValue.IsVoid) and (evaluatedSpliceValue.Kind = vkInterface) then
begin
nodeToSplice := evaluatedSpliceValue.AsIntf<IAstNode>;
// If the result is a block, flatten it into the current list
if nodeToSplice.Kind = akBlockExpression then
newList.AddRange(nodeToSplice.AsBlockExpression.Expressions)
else
@@ -198,7 +207,6 @@ begin
end
else if (not evaluatedSpliceValue.IsVoid) then
begin
// Treat scalar values as constants in the AST
newList.Add(TAst.Constant(evaluatedSpliceValue));
end;
end
@@ -278,12 +286,9 @@ var
begin
expr := Node.Expression;
// Optimization: If unquoting a simple identifier that exists in the macro scope,
// try to resolve it directly to avoid unnecessary evaluation overhead.
if expr.Kind = akIdentifier then
begin
addr := FMacroScope.Resolve(expr.AsIdentifier.Name);
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
begin
var argValue := FMacroScope.Values[addr];
@@ -295,17 +300,23 @@ begin
end;
end;
// Evaluate the expression at compile time
value := FMacroEvaluator(FMacroScope, expr);
// Evaluate the expression at compile time.
// This executes user code! It must be guarded.
try
value := FMacroEvaluator(FMacroScope, expr);
except
on E: EAstException do
raise;
on E: Exception do
raise EMacroException.Create('Error during macro evaluation: ' + E.Message);
end;
if value.Kind = vkInterface then
begin
// It returned an AST node -> Inject it
Result := value.AsIntf<IAstNode>;
exit;
end;
// It returned a value -> Wrap as Constant
if value.Kind in [vkScalar, vkText, vkVoid] then
Result := TAst.Constant(value)
else
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+10 -67
View File
@@ -25,13 +25,12 @@ type
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
private
type
// Helper to track types per scope during traversal (The "Scratchpad")
TTypeContext = class
private
FParent: TTypeContext;
FLayout: IScopeLayout;
FSlotTypes: TArray<IStaticType>;
FUpvalueTypes: TArray<IStaticType>; // Types of captured variables
FUpvalueTypes: TArray<IStaticType>;
public
constructor Create(AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray<IStaticType>);
function LookupType(const Address: TResolvedAddress): IStaticType;
@@ -41,12 +40,9 @@ type
private
FCurrentContext: TTypeContext;
// Helper to recursively rebuild the context stack from the layout hierarchy
function CreateContextChain(L: IScopeLayout): TTypeContext;
protected
// Override all visit methods to perform type checking
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
function VisitAssignment(const Node: IAssignmentNode): IAstNode; override;
@@ -64,7 +60,6 @@ type
function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
function VisitNop(const Node: INopNode): IAstNode; override;
// Base cases (types are now set here)
function VisitConstant(const Node: IConstantNode): IAstNode; override;
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
@@ -92,7 +87,6 @@ begin
FLayout := ALayout;
FUpvalueTypes := AUpvalueTypes;
// Initialize slot types with Unknown
if Assigned(FLayout) then
begin
SetLength(FSlotTypes, FLayout.SlotCount);
@@ -125,7 +119,6 @@ begin
end;
akUpvalue:
begin
// Look up type in our local upvalue type cache
if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FUpvalueTypes)) then
Result := FUpvalueTypes[Address.SlotIndex]
else
@@ -151,30 +144,20 @@ begin
if L = nil then
exit(nil);
// Recursively build parent context
p := CreateContextChain(L.Parent);
// Create context for current layout level
// Note: We don't know UpvalueTypes for these static/parent layouts here, so [] is passed.
// Also: Slot types will be initialized to Unknown.
Result := TTypeContext.Create(p, L, []);
end;
constructor TTypeChecker.Create(const RootLayout: IScopeLayout);
begin
inherited Create;
// Build the full context chain based on the Layout's parent hierarchy
// This ensures that ScopeDepth lookups can traverse up to the root.
FCurrentContext := CreateContextChain(RootLayout);
// Fallback if RootLayout is nil (should not happen in valid pipeline)
if FCurrentContext = nil then
FCurrentContext := TTypeContext.Create(nil, nil, []);
end;
destructor TTypeChecker.Destroy;
begin
// Cleanup context stack
while Assigned(FCurrentContext) do
begin
var temp := FCurrentContext;
@@ -192,7 +175,6 @@ end;
function TTypeChecker.Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
begin
// Note: Layout passed here matches what was passed to Create/Constructor (via recursed ContextChain)
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
@@ -216,10 +198,7 @@ var
adr: TResolvedAddress;
begin
adr := Node.Address;
// Lookup type in our scratchpad context using the address resolved by Binder
typ := FCurrentContext.LookupType(adr);
// Create a new node with the inferred type
Result := TAst.Identifier(Node.Name, adr, typ);
end;
@@ -247,7 +226,6 @@ begin
adr := Node.Target.AsIdentifier.Address;
initType := TTypes.Unknown;
// Recursive lambda bootstrap logic
placeholderType := nil;
if (Node.Initializer <> nil) and (Node.Initializer.Kind = akLambdaExpression) then
begin
@@ -258,8 +236,6 @@ begin
paramTypes[i] := TTypes.Unknown;
placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown);
// Update Context (Scratchpad)
FCurrentContext.SetType(adr.SlotIndex, placeholderType);
initType := placeholderType;
end;
@@ -274,12 +250,10 @@ begin
else if not Assigned(placeholderType) then
initType := TTypes.Unknown;
// Update Context with final type
if initType.Kind <> stUnknown then
FCurrentContext.SetType(adr.SlotIndex, initType);
newIdent := TAst.Identifier(Node.Target.AsIdentifier.Name, adr, initType);
Result := TAst.VarDecl(newIdent.AsIdentifier, newInitializer, initType, Node.IsBoxed);
end;
@@ -296,7 +270,6 @@ begin
targetType := newIdent.AsTypedNode.StaticType;
adr := newIdent.AsIdentifier.Address;
// Recursive lambda assignment check
placeholderType := nil;
if (Node.Value <> nil) and (Node.Value.Kind = akLambdaExpression) then
begin
@@ -344,28 +317,18 @@ var
newBody: IAstNode;
bodyType, methodType: IStaticType;
paramTypes: TArray<IStaticType>;
// Upvalue Type Resolution
upvalueTypes: TArray<IStaticType>;
upvalueAddrs: TArray<TResolvedAddress>;
i: Integer;
finalDescriptor: IScopeDescriptor;
begin
// 1. Resolve Upvalue Types *in the current (parent) context*
upvalueAddrs := Node.Upvalues;
SetLength(upvalueTypes, Length(upvalueAddrs));
for i := 0 to High(upvalueAddrs) do
begin
// We look up the physical address (from Binder) in the current context chain
upvalueTypes[i] := FCurrentContext.LookupType(upvalueAddrs[i]);
end;
// 2. Create new TypeContext for this lambda scope, PASSING the upvalue types
// We use the layout from the Binder-Result-Node
FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes);
try
// 3. Set parameter types in the context
SetLength(newParams, Length(Node.Parameters));
SetLength(paramTypes, Length(Node.Parameters));
@@ -373,37 +336,22 @@ begin
begin
var paramIdent := Node.Parameters[i];
var paramAdr := paramIdent.Address;
// Here we could infer types if we had type annotations. For now, parameters are Unknown.
paramTypes[i] := TTypes.Unknown;
// Update context so body can resolve params
FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]);
newParams[i] := TAst.Identifier(paramIdent.Name, paramAdr, paramTypes[i]);
end;
// 4. Visit body
newBody := Accept(Node.Body);
bodyType := newBody.AsTypedNode.StaticType;
// 5. Create method type
methodType := TTypes.CreateMethod(paramTypes, bodyType);
// 6. Update <self> type in context (Slot 0)
FCurrentContext.SetType(0, methodType);
// 7. FINALIZE: Bake the Descriptor
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
finally
// 8. Pop Context
var temp := FCurrentContext;
FCurrentContext := FCurrentContext.FParent;
temp.Free;
end;
// 9. Create new node with the Descriptor attached!
Result :=
TAst.LambdaExpr(newParams, newBody, Node.Layout, finalDescriptor, Node.Upvalues, Node.HasNestedLambdas, Node.IsPure, methodType);
end;
@@ -509,7 +457,6 @@ begin
newElse := Accept(Node.ElseBranch);
conditionType := newCond.AsTypedNode.StaticType;
// Ordinal and Boolean are valid for if-conditions
if (conditionType.Kind <> stUnknown)
and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType)
and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then
@@ -520,12 +467,9 @@ begin
if newElse <> nil then newElse.AsTypedNode.StaticType
else TTypes.Void;
try
resultType := TTypeRules.Promote(thenType, elseType);
except
on E: Exception do // Catch base exception (ETypeException from Myc.Ast.Types)
raise ETypeCheckException.Create(E.Message);
end;
resultType := TTypeRules.Promote(thenType, elseType);
if resultType = nil then
raise ETypeCheckException.CreateFmt('Cannot promote types %s and %s in If-Expression', [thenType.ToString, elseType.ToString]);
Result := TAst.IfExpr(newCond, newThen, newElse, resultType);
end;
@@ -548,12 +492,9 @@ begin
thenType := newThen.AsTypedNode.StaticType;
elseType := newElse.AsTypedNode.StaticType;
try
resultType := TTypeRules.Promote(thenType, elseType);
except
on E: Exception do
raise ETypeCheckException.Create(E.Message);
end;
resultType := TTypeRules.Promote(thenType, elseType);
if resultType = nil then
raise ETypeCheckException.CreateFmt('Cannot promote types %s and %s in Ternary-Expression', [thenType.ToString, elseType.ToString]);
Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType);
end;
@@ -698,10 +639,12 @@ var
elemType: IStaticType;
begin
try
// TScalar.StringToKind might throw EConvertError or generic Exception if string is invalid
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
except
on E: Exception do
elemType := TTypes.Unknown;
// Instead of silently using Unknown, we now raise a proper compiler error
raise ETypeCheckException.CreateFmt('Invalid type definition "%s" in new-series.', [Node.Definition]);
end;
Result := TAst.CreateSeries(Node.Definition, TTypes.CreateSeries(elemType));
Src/AST/Myc.Ast.Evaluator.pas
+51 -77
View File
@@ -8,7 +8,7 @@ uses
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Nodes, // Provides EAstException
Myc.Ast.Scope;
type
@@ -16,8 +16,6 @@ type
EEvaluatorException = class(EAstException);
// The standard AST evaluator for production use.
// This class inherits directly from TInterfacedObject as it is an
// Interpreter (AST -> TDataValue), not a Transformer (AST -> IAstNode).
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor)
private
FScope: IExecutionScope;
@@ -139,8 +137,16 @@ begin
if not Assigned(RootNode) then
exit(TDataValue.Void);
Result := RootNode.Accept(Self);
HandleTCO(Result);
try
Result := RootNode.Accept(Self);
HandleTCO(Result);
except
on E: EAstException do
raise; // Already a compiler/runtime exception, pass through
on E: Exception do
// Wrap unexpected RTL exceptions (e.g. EDivByZero, EConvertError)
raise EEvaluatorException.Create('Runtime Error: ' + E.Message);
end;
end;
function TEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory;
@@ -152,12 +158,18 @@ end;
class procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
begin
// This is the central trampoline loop for Tail Call Optimization.
// It runs as long as the evaluation returns a thunk.
while ResultValue.Kind = vkGeneric do
begin
var thunk := ResultValue.AsGeneric<TThunk>;
var callee := thunk.Callee.AsMethod();
ResultValue := callee(thunk.Args);
try
while ResultValue.Kind = vkGeneric do
begin
var thunk := ResultValue.AsGeneric<TThunk>;
var callee := thunk.Callee.AsMethod();
ResultValue := callee(thunk.Args);
end;
except
on E: EAstException do
raise;
on E: Exception do
raise EEvaluatorException.Create('Runtime Error (TCO): ' + E.Message);
end;
end;
@@ -186,8 +198,6 @@ var
visitorFactory: TEvaluatorFactory;
begin
// 1. Capture Upvalues
// The Node.Upvalues array contains the physical addresses in the *current* scope (FScope)
// that map to the closure's upvalues.
if Node.Upvalues <> nil then
begin
SetLength(capturedCells, Length(Node.Upvalues));
@@ -198,9 +208,6 @@ begin
capturedCells := nil;
// 2. Determine Parent Scope for Closure
// Memory optimization: a lambda's scope does not need to be kept alive as a parent
// if it contains no nested lambdas that might need to capture from it later.
// (Assuming HasNestedLambdas flag is set correctly by Binder)
if Node.HasNestedLambdas then
closureScope := FScope
else
@@ -210,11 +217,10 @@ begin
visitorFactory := CreateVisitorFactory();
// 4. Capture Metadata for Closure
var descriptor := Node.Descriptor; // Runtime Descriptor (contains types + layout)
var descriptor := Node.Descriptor;
var params := Node.Parameters;
var cNode: ILambdaExpressionNode := Node;
// [unsafe] prevents a reference cycle since the closure captures itself for 'recur'.
var [unsafe] closure: TDataValue.TFunc;
closure :=
function(const ArgValues: TArray<TDataValue>): TDataValue
@@ -231,22 +237,16 @@ begin
lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells);
// Capture the closure itself in slot 0 for 'recur' to find it (if needed).
// Note: The Binder reserves Slot 0 for <self>.
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
adr.SlotIndex := 0;
lambdaScope[adr] := TDataValue(closure); // Explicit cast
lambdaScope[adr] := TDataValue(closure);
// Populate the scope with the actual parameters passed to the function.
for i := 0 to High(ArgValues) do
begin
// Parameters are bound to specific slots by the Binder.
// We access them via the Address stored in the parameter node.
adr := params[i].Address;
// Defensive check: Ensure we are writing to local scope
Assert(adr.ScopeDepth = 0);
lambdaScope[adr] := ArgValues[i];
end;
@@ -255,14 +255,11 @@ begin
Result := cNode.Body.Accept(bodyVisitor);
end;
// The result of visiting a lambda node is the callable closure itself.
Result := TDataValue(closure); // Explicit cast
Result := TDataValue(closure);
end;
function TEvaluatorVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// Macro definitions are compile-time constructs.
// The Evaluator ignores them (treated as Void).
Result := TDataValue.Void;
end;
@@ -291,19 +288,13 @@ begin
if Assigned(Node.StaticTarget) then
begin
// --- Static Path (Optimized) ---
// 1. Evaluate arguments
argNodes := Node.Arguments;
SetLength(argValues, Length(argNodes));
for i := 0 to High(argNodes) do
begin
// Assuming arguments passed type check
argValues[i] := argNodes[i].Accept(Self);
end;
// 2. Call the static target directly
// Call static target. Exceptions here are caught by Execute/HandleTCO.
Result := Node.StaticTarget(argValues);
// 3. Handle TCO
HandleTCO(Result);
end
else
@@ -320,12 +311,10 @@ begin
if Node.IsTailCall then
begin
// This is a tail call. Return a thunk to be processed by the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, false));
end
else
begin
// This is a non-tail call. It must execute the call and act as the trampoline.
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
@@ -334,8 +323,6 @@ end;
function TEvaluatorVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
// The evaluator simply "unwraps" the macro expansion node
// and executes the expanded body it contains.
Result := Node.ExpandedBody.Accept(Self);
end;
@@ -346,18 +333,15 @@ var
calleeValue: TDataValue;
i: Integer;
begin
// The binder ensures this is only in a tail position.
SetLength(argValues, Length(Node.Arguments));
for i := 0 to High(Node.Arguments) do
argValues[i] := Node.Arguments[i].Accept(Self);
// The callee is the current function, stored in slot 0 of the current scope.
calleeAddress.Kind := akLocalOrParent;
calleeAddress.ScopeDepth := 0;
calleeAddress.SlotIndex := 0;
calleeValue := FScope[calleeAddress];
// Recur always returns a thunk for the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, true));
end;
@@ -400,9 +384,7 @@ begin
if Node.Target.Kind <> akIdentifier then
raise EEvaluatorException.Create('Runtime Error: Assignment target must be an identifier.');
// Evaluate value
Result := Node.Value.Accept(Self);
// Assign
FScope[Node.Target.AsIdentifier.Address] := Result;
end;
@@ -413,8 +395,7 @@ end;
function TEvaluatorVisitor.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
// Return the keyword as a TScalar value
Result := TDataValue(TScalar.FromKeyword(Node.Value)); // Explicit cast
Result := TDataValue(TScalar.FromKeyword(Node.Value));
end;
function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
@@ -422,24 +403,30 @@ var
def: string;
begin
def := Node.Definition.Trim;
if def.StartsWith('[') then
begin
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then
raise EEvaluatorException.Create('Failed to parse record definition from JSON array.');
var recordSeries := TScalarRecordSeries.Create(recordDef);
Result := TDataValue.FromRecordSeries(recordSeries);
end
else
begin
var scalarKind := TScalar.StringToKind(def);
Result := TDataValue.FromSeries(TScalarSeries.Create(scalarKind));
try
if def.StartsWith('[') then
begin
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then
raise EEvaluatorException.Create('Failed to parse record definition from JSON array.');
var recordSeries := TScalarRecordSeries.Create(recordDef);
Result := TDataValue.FromRecordSeries(recordSeries);
end
else
begin
var scalarKind := TScalar.StringToKind(def);
Result := TDataValue.FromSeries(TScalarSeries.Create(scalarKind));
end;
except
on E: EAstException do
raise;
on E: Exception do
raise EEvaluatorException.Create('Invalid series definition: ' + E.Message);
end;
end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
// The scope's GetValues implementation handles unboxing and parent lookup.
Result := FScope[Node.Address];
end;
@@ -470,7 +457,7 @@ begin
series := baseValue.AsSeries;
if (index < 0) or (index >= series.TotalCount) then
raise EEvaluatorException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
Result := TDataValue(series.Items[Integer(index)]); // Explicit cast
Result := TDataValue(series.Items[Integer(index)]);
end;
vkRecordSeries:
begin
@@ -479,7 +466,6 @@ begin
raise EEvaluatorException
.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, recSeries.TotalCount]);
// Materialize the TScalarRecord by accessing each member series by index
fieldCount := Length(recSeries.Def.Fields);
SetLength(values, fieldCount);
@@ -508,7 +494,7 @@ begin
case baseValue.Kind of
vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries[Node.Member.Value]);
vkRecord: Result := TDataValue(baseValue.AsRecord[Node.Member.Value]); // Explicit cast
vkRecord: Result := TDataValue(baseValue.AsRecord[Node.Member.Value]);
vkGenericRecord:
begin
@@ -528,20 +514,14 @@ function TEvaluatorVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): T
var
i: Integer;
begin
// Use the properties populated by the TypeChecker/Binder
if Assigned(Node.GenericDefinition) then
begin
// --- GENERIC RECORD PATH ---
var genFields: TArray<TPair<IKeyword, TDataValue>>;
SetLength(genFields, Length(Node.Fields));
for i := 0 to High(Node.Fields) do
begin
genFields[i] :=
TPair<IKeyword, TDataValue>.Create(
Node.Fields[i].Key.Value,
Node.Fields[i].Value.Accept(Self) // Evaluate expression
);
genFields[i] := TPair<IKeyword, TDataValue>.Create(Node.Fields[i].Key.Value, Node.Fields[i].Value.Accept(Self));
end;
var dynRec := TDynamicRecord.Create(genFields);
@@ -549,7 +529,6 @@ begin
end
else if Assigned(Node.ScalarDefinition) then
begin
// --- SCALAR RECORD PATH ---
var values: TArray<TScalar.TValue>;
SetLength(values, Length(Node.Fields));
@@ -573,25 +552,20 @@ begin
if Node.Target.Kind <> akIdentifier then
raise EEvaluatorException.Create('Runtime Error: Variable declaration target must be an identifier.');
// 1. Evaluate Initializer
if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self)
else
Result := TDataValue.Void;
// 2. Get Address (assigned by Binder)
address := Node.Target.AsIdentifier.Address;
// 3. Store Value
if Node.IsBoxed then
begin
// Capture (heap alloc)
Assert(address.ScopeDepth = 0);
FScope.DefineBoxed(address.SlotIndex, Result);
end
else
begin
// Stack alloc
FScope[address] := Result;
end;
end;
@@ -643,7 +617,7 @@ begin
.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
end;
Result := TDataValue(TScalar.FromInt64(len)); // Explicit cast
Result := TDataValue(TScalar.FromInt64(len));
end;
end.
Src/AST/Myc.Ast.Scope.pas
+11 -15
View File
@@ -11,9 +11,6 @@ uses
Myc.Ast.Types;
type
// Exception specific to scope resolution and definition errors
EScopeException = class(Exception);
IExecutionScope = interface;
IScopeDescriptor = interface;
IScopeLayout = interface;
@@ -359,8 +356,8 @@ end;
function TScopeBuilder.Define(const Name: string): Integer;
begin
// Rule: Shadowing / Redefinition in the same scope is forbidden.
if FMap.ContainsKey(Name) then
raise EScopeException.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
// The Client (Binder) must ensure this name is not already taken before calling Define.
Assert(not FMap.ContainsKey(Name), 'Scope Error: Variable "' + Name + '" is already defined in this scope builder.');
// Allocate a new slot
Result := FNextSlot;
@@ -574,6 +571,8 @@ var
targetScope: TExecutionScope;
i: Integer;
begin
Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot capture an unresolved address.');
case Address.Kind of
akUpvalue:
begin
@@ -600,8 +599,6 @@ begin
TMonitor.Exit(targetScope);
end;
end;
else
raise EScopeException.Create('Cannot capture an unresolved address.');
end;
end;
@@ -613,10 +610,9 @@ begin
NeedNameToIndex;
id := GetNameID(Name);
// NOTE: Runtime redefinition is generally restricted in this dynamic Define
// (typically used for Root/Global definitions).
if FNameToIndex.ContainsKey(id) then
raise EScopeException.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
// NOTE: Runtime redefinition is generally restricted in this dynamic Define.
// The Client must ensure uniqueness.
Assert(not FNameToIndex.ContainsKey(id), 'Scope Error: Variable "' + Name + '" is already defined in this execution scope.');
index := Length(FValues);
SetLength(FValues, index + 1);
@@ -719,6 +715,8 @@ function TExecutionScope.GetValues(const Address: TResolvedAddress): TDataValue;
var
item: TScopeItem;
begin
Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot get value for an unresolved address.');
case Address.Kind of
akUpvalue:
begin
@@ -736,8 +734,6 @@ begin
else
Result := item.Value;
end;
else
raise EScopeException.Create('Cannot get value for an unresolved address.');
end;
end;
@@ -795,6 +791,8 @@ var
targetScope: TExecutionScope;
i: Integer;
begin
Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot set value for an unresolved address.');
case Address.Kind of
akUpvalue:
begin
@@ -812,8 +810,6 @@ begin
else
pItem.Value := Value;
end;
else
raise EScopeException.Create('Cannot set value for an unresolved address.');
end;
end;
Src/AST/Myc.Ast.Types.pas
+30 -95
View File
@@ -9,10 +9,6 @@ uses
Myc.Data.Keyword;
type
// Exception for atomic type errors (promotion failures, invalid operations)
// Inherits from Exception directly to keep Types unit independent of Nodes/AST.
ETypeException = class(Exception);
IStaticType = interface;
// Defines the categories of types available in the language.
@@ -68,8 +64,6 @@ type
property ElementType: IStaticType read GetElementType;
// The signatures (if Kind = stMethod).
// This array contains one entry for simple methods,
// and multiple entries for overloaded functions (like RTL).
property Signatures: TArray<IMethodSignature> read GetSignatures;
// The definition (if Kind = stRecord or stRecordSeries)
@@ -84,7 +78,6 @@ type
end;
// Factory and Flyweight access for static types.
// Use this record to create or access all IStaticType instances.
TTypes = record
private
class var
@@ -105,7 +98,7 @@ type
FKeyword: IStaticType;
class constructor Create;
public
// Flyweight accessors for simple types
// Flyweight accessors
class property Unknown: IStaticType read FUnknown;
class property Void: IStaticType read FVoid;
class property Ordinal: IStaticType read FOrdinal;
@@ -115,7 +108,7 @@ type
class property Text: IStaticType read FText;
class property Keyword: IStaticType read FKeyword;
// Factory functions for complex types
// Factory functions
class function CreateSeries(const AElementType: IStaticType): IStaticType; static;
class function CreateMethod(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType): IStaticType; static;
class function CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType; static;
@@ -129,14 +122,16 @@ type
// Defines the rules of the type system.
TTypeRules = record
public
// Returns the common type (promotion) or nil if incompatible.
class function Promote(const A, B: IStaticType): IStaticType; static;
// Checks if a value of type 'Source' can be assigned to 'Target'.
class function CanAssign(const Target, Source: IStaticType): Boolean; static;
// Determines the result type of a binary operation.
// Raises ETypeException on failure.
// Determines the result type of a binary operation. Returns nil on failure.
class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static;
// Determines the result type of a unary operation.
// Determines the result type of a unary operation. Returns nil on failure.
class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; static;
end;
@@ -185,7 +180,6 @@ end;
type
TAbstractStaticType = class(TInterfacedObject, IStaticType)
protected
// IStaticType (default implementations for non-applicable properties)
function GetKind: TStaticTypeKind; virtual; abstract;
function GetElementType: IStaticType; virtual;
function GetSignatures: TArray<IMethodSignature>; virtual;
@@ -208,7 +202,6 @@ end;
function TAbstractStaticType.GetDefinition: IScalarRecordDefinition;
begin
// Return an empty/invalid definition
Result := Default(IScalarRecordDefinition);
end;
@@ -219,8 +212,6 @@ end;
function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean;
begin
// Default implementation: types are equal if their kinds are equal.
// Complex types (Series, Record, Method) MUST override this.
if not Assigned(Other) then
exit(False);
Result := (GetKind = Other.Kind);
@@ -256,7 +247,6 @@ end;
function TSimpleStaticType.GetHashCode: Integer;
begin
// Simple types only hash their kind
Result := Ord(FKind);
end;
@@ -298,11 +288,9 @@ end;
function TSeriesType.GetHashCode: Integer;
begin
// Consistent with IsEqual
Result := Ord(stSeries);
if Assigned(FElementType) then
begin
// Combine hash of stSeries with hash of element type
var hash := FElementType.GetHashCode;
Result := THashBobJenkins.GetHashValue(Hash, SizeOf(Integer), Result);
end;
@@ -336,7 +324,6 @@ function TMethodSignature.GetHashCode: Integer;
var
i: Integer;
begin
// Consistent with TMethodType.IsEqual
Result := 0;
if Assigned(FReturnType) then
Result := FReturnType.GetHashCode;
@@ -409,11 +396,6 @@ begin
if Length(Self.FSignatures) <> Length(otherSigs) then
exit(False);
// This is complex. For now, assume equality means identical sets,
// which requires comparing O(N^2) signatures if order doesn't matter.
// Let's assume order *does* matter for equality to keep this simple (O(N)).
// Note: A better IsEqual would compare hashes of signatures.
for i := 0 to High(Self.FSignatures) do
begin
var sig1 := Self.FSignatures[i];
@@ -438,7 +420,6 @@ function TMethodType.GetHashCode: Integer;
var
sig: IMethodSignature;
begin
// Consistent with IsEqual
Result := Ord(stMethod);
for sig in FSignatures do
begin
@@ -461,7 +442,6 @@ begin
end
else
begin
// Handle overloaded methods
sb := TStringBuilder.Create;
try
sb.Append('Method{');
@@ -471,7 +451,7 @@ begin
sb.Append(SignatureToString(sig));
sb.Append('), ');
end;
sb.Remove(sb.Length - 2, 2); // Remove last ', '
sb.Remove(sb.Length - 2, 2);
sb.Append('}');
Result := sb.ToString;
finally
@@ -482,7 +462,6 @@ end;
// ---
type
// Represents stRecord and stRecordSeries (Scalar Records)
TRecordType = class(TAbstractStaticType)
private
FKind: TStaticTypeKind;
@@ -523,14 +502,13 @@ begin
var otherDef := Other.Definition;
if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then
exit(False); // Should not happen if Kind is equal, but defensive check
exit(False);
if Length(Self.FDefinition.Fields) <> Length(otherDef.Fields) then
exit(False);
for i := 0 to High(Self.FDefinition.Fields) do
begin
// Use fast interface comparison for Keys
if (Self.FDefinition.Fields[i].Key <> otherDef.Fields[i].Key) or (Self.FDefinition.Fields[i].Value <> otherDef.Fields[i].Value) then
exit(False);
end;
@@ -542,16 +520,13 @@ function TRecordType.GetHashCode: Integer;
var
field: TPair<IKeyword, TScalar.TKind>;
begin
// Consistent with IsEqual
Result := Ord(GetKind);
if Assigned(FDefinition) then
begin
for field in FDefinition.Fields do
begin
// Hash the Keyword pointer (fast, from flyweight)
var hash := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Pointer), Result);
// Hash the TScalar.TKind value
var data := Ord(field.Value);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Byte), Result);
end;
@@ -621,7 +596,6 @@ begin
for i := 0 to High(Self.FDefinition.Fields) do
begin
// Compare keys (fast) and static types (must use IsEqual)
if (Self.FDefinition.Fields[i].Key <> otherDef.Fields[i].Key)
or (not Self.FDefinition.Fields[i].Value.IsEqual(otherDef.Fields[i].Value)) then
exit(False);
@@ -634,16 +608,13 @@ function TGenericRecordType.GetHashCode: Integer;
var
field: TPair<IKeyword, IStaticType>;
begin
// Consistent with IsEqual
Result := Ord(stGenericRecord);
if Assigned(FDefinition) then
begin
for field in FDefinition.Fields do
begin
// Hash the Keyword pointer (fast, from flyweight)
var data := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Pointer), Result);
// Hash the IStaticType value
if Assigned(field.Value) then
begin
var hash := field.Value.GetHashCode;
@@ -674,7 +645,6 @@ end;
class constructor TTypes.Create;
begin
// Create the flyweight singletons
FUnknown := TSimpleStaticType.Create(stUnknown);
FVoid := TSimpleStaticType.Create(stVoid);
FOrdinal := TSimpleStaticType.Create(stOrdinal);
@@ -690,7 +660,6 @@ var
sig: IMethodSignature;
sigs: TArray<IMethodSignature>;
begin
// This is now a convenience helper for CreateMethodSet
sig := TMethodSignature.Create(AParamTypes, AReturnType);
SetLength(sigs, 1);
sigs[0] := sig;
@@ -699,7 +668,6 @@ end;
class function TTypes.CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType;
begin
// This is the new primary factory for method types
Result := TMethodType.Create(ASignatures);
end;
@@ -732,7 +700,8 @@ begin
TScalar.TKind.Boolean: Result := FBoolean;
TScalar.TKind.DateTime: Result := FDateTime;
else
raise ETypeException.Create('Cannot convert invalid TScalar.TKind to TStaticType.');
Assert(False, 'Invalid Scalar Kind');
Result := nil;
end;
end;
@@ -740,39 +709,30 @@ end;
class function TTypeRules.CanAssign(const Target, Source: IStaticType): Boolean;
begin
// Basic nil-check for safety.
if (not Assigned(Target)) or (not Assigned(Source)) then
exit(False);
// During inference, allow assignment involving Unknown
if (Target.Kind = stUnknown) or (Source.Kind = stUnknown) then
exit(True);
// Types are always assignable to themselves (identity).
if Target.IsEqual(Source) then
exit(True);
// Allow assigning an integer (Ordinal) to a float variable.
if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then
exit(True);
// Allow assigning Boolean to Ordinal (0/1)
if (Target.Kind = stOrdinal) and (Source.Kind = stBoolean) then
exit(True);
// Allow assigning DateTime to Float (TDateTime is Double)
if (Target.Kind = stFloat) and (Source.Kind = stDateTime) then
exit(True);
// Allow discarding the return value of a method (e.g., in a 'do' block).
if (Target.Kind = stVoid) and (Source.Kind = stMethod) then
exit(True);
// Allow implicit conversion from Keyword (internally an index) to Ordinal.
if (Target.Kind = stOrdinal) and (Source.Kind = stKeyword) then
exit(True);
// Default: Assignment is not allowed if no specific rule matches.
Result := False;
end;
@@ -798,17 +758,12 @@ begin
if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then
exit(TTypes.Ordinal);
// Implicit DateTime/Boolean logic via Ordinal/Float mapping?
// If types are identical (incl. Keyword, Text, Boolean, DateTime), return that type.
// If types are identical, return that type.
if A.IsEqual(B) then
exit(A);
// Cannot promote stGenericRecord or stRecord with anything other than itself/unknown
if (A.Kind in [stRecord, stGenericRecord]) or (B.Kind in [stRecord, stGenericRecord]) then
raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]);
// Cannot promote other combinations
raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]);
// No promotion possible
Result := nil;
end;
class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType;
@@ -816,65 +771,48 @@ var
promotedType: IStaticType;
promotedKind: TStaticTypeKind;
begin
// 1. Determine the effective type after promotion, handling Unknown.
try
promotedType := Promote(Left, Right);
except
// If promotion fails (e.g., Text and Ordinal), the operation is invalid.
on E: ETypeException do
raise ETypeException.CreateFmt(
'Operator %s cannot be applied to %s and %s (promotion failed: %s)',
[Op.ToString, Left.ToString, Right.ToString, E.Message]);
end;
promotedType := Promote(Left, Right);
// Mismatch during promotion
if not Assigned(promotedType) then
exit(nil);
// If promotion results in Unknown, the result type is also Unknown for now.
if promotedType.Kind = stUnknown then
exit(TTypes.Unknown);
// 2. Check if the operator is valid for the promoted type.
promotedKind := promotedType.Kind;
case Op of
TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply:
begin
// Numeric operations require Ordinal, Float, or DateTime(as Float)
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
raise ETypeException
.CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]);
Result := promotedType; // Result has the promoted type
exit(nil);
Result := promotedType;
end;
TScalar.TBinaryOp.Divide:
begin
// Division requires Ordinal or Float, but *always* results in Float
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
raise ETypeException
.CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]);
exit(nil);
Result := TTypes.Float;
end;
TScalar.TBinaryOp.Equal, TScalar.TBinaryOp.NotEqual:
begin
// Allow equality checks for Ordinal, Float, Keyword, Boolean, DateTime
if not (promotedKind in [stOrdinal, stFloat, stKeyword, stBoolean, stDateTime]) then
raise ETypeException.CreateFmt(
'Comparison operator %s requires scalar type, but got %s after promotion',
[Op.ToString, promotedType.ToString]);
// Result is always Boolean
exit(nil);
Result := TTypes.Boolean;
end;
TScalar.TBinaryOp.Less, TScalar.TBinaryOp.Greater, TScalar.TBinaryOp.LessOrEqual, TScalar.TBinaryOp.GreaterOrEqual:
begin
// Comparison requires Ordinal or Float (Keywords are not ordered)
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
raise ETypeException.CreateFmt(
'Comparison operator %s requires ordered type (Ordinal, Float, DateTime), but got %s after promotion',
[Op.ToString, promotedType.ToString]);
exit(nil);
Result := TTypes.Boolean;
end;
else
raise ETypeException.Create('Unknown binary operator for type resolution.');
// Operation not supported at the AST level (might need folding later, but here it implies invalid usage)
Result := nil;
end;
end;
@@ -884,28 +822,25 @@ var
begin
rightKind := Right.Kind;
// If operand is Unknown, result is Unknown.
if rightKind = stUnknown then
exit(TTypes.Unknown);
case Op of
TScalar.TUnaryOp.Negate:
begin
// Negation requires Ordinal or Float
if not (rightKind in [stOrdinal, stFloat]) then
raise ETypeException.CreateFmt('Unary negation cannot be applied to %s', [Right.ToString]);
Result := Right; // Negation preserves type
exit(nil);
Result := Right;
end;
TScalar.TUnaryOp.Not:
begin
// Logical not only applies to Boolean (or Ordinal if treated as bool)
if not (rightKind in [stOrdinal, stBoolean]) then
raise ETypeException.CreateFmt('Logical not cannot be applied to %s', [Right.ToString]);
exit(nil);
Result := TTypes.Boolean;
end;
else
raise ETypeException.Create('Unknown unary operator for type resolution.');
Result := nil;
end;
end;
Src/AST/Myc.Ast.pas
+61 -38
View File
@@ -77,14 +77,13 @@ type
class function Unquote(const AExpression: IAstNode): IUnquoteNode; static;
class function UnquoteSplicing(const AExpression: IQuasiquoteNode): IUnquoteSplicingNode; static;
// (* UPDATED Factory: Added AIsTargetPure *)
class function FunctionCall(
const ACallee: IAstNode;
const AArguments: TArray<IAstNode>;
const AStaticType: IStaticType = nil;
const AIsTailCall: Boolean = False;
const AStaticTarget: TDataValue.TFunc = nil;
const AIsTargetPure: Boolean = False // (* ADDED *)
const AIsTargetPure: Boolean = False
): IFunctionCallNode; static;
class function MacroExpansionNode(
@@ -193,7 +192,7 @@ type
FDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
FHasNestedLambdas: Boolean;
FIsPure: Boolean; // (* ADDED *)
FIsPure: Boolean;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
@@ -201,7 +200,7 @@ type
function GetDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
function GetIsPure: Boolean; // (* ADDED *)
function GetIsPure: Boolean;
function GetKind: TAstNodeKind; override;
public
constructor Create(
@@ -212,7 +211,7 @@ type
const ADescriptor: IScopeDescriptor;
const AUpvalues: TArray<TResolvedAddress>;
const AHasNestedLambdas: Boolean;
const AIsPure: Boolean // (* ADDED *)
const AIsPure: Boolean
);
destructor Destroy; override;
function Accept(const Visitor: IAstVisitor): TDataValue; override;
@@ -225,12 +224,12 @@ type
FArguments: TArray<IAstNode>;
FIsTailCall: Boolean;
FStaticTarget: TDataValue.TFunc;
FIsTargetPure: Boolean; // (* ADDED *)
FIsTargetPure: Boolean;
function GetCallee: IAstNode;
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
function GetStaticTarget: TDataValue.TFunc;
function GetIsTargetPure: Boolean; // (* ADDED *)
function GetIsTargetPure: Boolean;
function GetKind: TAstNodeKind; override;
public
constructor Create(
@@ -239,7 +238,7 @@ type
const AStaticType: IStaticType;
const AIsTailCall: Boolean;
const AStaticTarget: TDataValue.TFunc;
const AIsTargetPure: Boolean // (* ADDED *)
const AIsTargetPure: Boolean
);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
function AsFunctionCall: IFunctionCallNode; override;
@@ -677,7 +676,7 @@ class function TAst.FunctionCall(
const AStaticType: IStaticType = nil;
const AIsTailCall: Boolean = False;
const AStaticTarget: TDataValue.TFunc = nil;
const AIsTargetPure: Boolean = False // (* ADDED *)
const AIsTargetPure: Boolean = False
): IFunctionCallNode;
begin
Result :=
@@ -753,7 +752,7 @@ class function TAst.LambdaExpr(
const ADescriptor: IScopeDescriptor = nil;
const AUpvalues: TArray<TResolvedAddress> = nil;
const AHasNestedLambdas: Boolean = False;
const AIsPure: Boolean = False; // (* ADDED *)
const AIsPure: Boolean = False;
const AStaticType: IStaticType = nil
): ILambdaExpressionNode;
begin
@@ -917,122 +916,146 @@ end;
function TAstNode.AsAddSeriesItem: IAddSeriesItemNode;
begin
raise ETypeException.Create('Node is not an AddSeriesItem');
Assert(False, 'Node is not an AddSeriesItem');
Result := nil;
end;
function TAstNode.AsAssignment: IAssignmentNode;
begin
raise ETypeException.Create('Node is not an Assignment');
Assert(False, 'Node is not an Assignment');
Result := nil;
end;
function TAstNode.AsBlockExpression: IBlockExpressionNode;
begin
raise ETypeException.Create('Node is not a BlockExpression');
Assert(False, 'Node is not a BlockExpression');
Result := nil;
end;
function TAstNode.AsConstant: IConstantNode;
begin
raise ETypeException.Create('Node is not a Constant');
Assert(False, 'Node is not a Constant');
Result := nil;
end;
function TAstNode.AsCreateSeries: ICreateSeriesNode;
begin
raise ETypeException.Create('Node is not a CreateSeries');
Assert(False, 'Node is not a CreateSeries');
Result := nil;
end;
function TAstNode.AsFunctionCall: IFunctionCallNode;
begin
raise ETypeException.Create('Node is not a FunctionCall');
Assert(False, 'Node is not a FunctionCall');
Result := nil;
end;
function TAstNode.AsIdentifier: IIdentifierNode;
begin
raise ETypeException.Create('Node is not an Identifier');
Assert(False, 'Node is not an Identifier');
Result := nil;
end;
function TAstNode.AsIfExpression: IIfExpressionNode;
begin
raise ETypeException.Create('Node is not an IfExpression');
Assert(False, 'Node is not an IfExpression');
Result := nil;
end;
function TAstNode.AsIndexer: IIndexerNode;
begin
raise ETypeException.Create('Node is not an Indexer');
Assert(False, 'Node is not an Indexer');
Result := nil;
end;
function TAstNode.AsKeyword: IKeywordNode;
begin
raise ETypeException.Create('Node is not a Keyword');
Assert(False, 'Node is not a Keyword');
Result := nil;
end;
function TAstNode.AsLambdaExpression: ILambdaExpressionNode;
begin
raise ETypeException.Create('Node is not a LambdaExpression');
Assert(False, 'Node is not a LambdaExpression');
Result := nil;
end;
function TAstNode.AsMacroDefinition: IMacroDefinitionNode;
begin
raise ETypeException.Create('Node is not a MacroDefinition');
Assert(False, 'Node is not a MacroDefinition');
Result := nil;
end;
function TAstNode.AsMacroExpansion: IMacroExpansionNode;
begin
raise ETypeException.Create('Node is not a MacroExpansion');
Assert(False, 'Node is not a MacroExpansion');
Result := nil;
end;
function TAstNode.AsMemberAccess: IMemberAccessNode;
begin
raise ETypeException.Create('Node is not a MemberAccess');
Assert(False, 'Node is not a MemberAccess');
Result := nil;
end;
function TAstNode.AsNop: INopNode;
begin
raise ETypeException.Create('Node is not a Nop');
Assert(False, 'Node is not a Nop');
Result := nil;
end;
function TAstNode.AsQuasiquote: IQuasiquoteNode;
begin
raise ETypeException.Create('Node is not a Quasiquote');
Assert(False, 'Node is not a Quasiquote');
Result := nil;
end;
function TAstNode.AsRecordLiteral: IRecordLiteralNode;
begin
raise ETypeException.Create('Node is not a RecordLiteral');
Assert(False, 'Node is not a RecordLiteral');
Result := nil;
end;
function TAstNode.AsRecur: IRecurNode;
begin
raise ETypeException.Create('Node is not a Recur');
Assert(False, 'Node is not a Recur');
Result := nil;
end;
function TAstNode.AsSeriesLength: ISeriesLengthNode;
begin
raise ETypeException.Create('Node is not a SeriesLength');
Assert(False, 'Node is not a SeriesLength');
Result := nil;
end;
function TAstNode.AsTernaryExpression: ITernaryExpressionNode;
begin
raise ETypeException.Create('Node is not a TernaryExpression');
Assert(False, 'Node is not a TernaryExpression');
Result := nil;
end;
function TAstNode.AsTypedNode: IAstTypedNode;
begin
raise ETypeException.Create('Node has no type');
Assert(False, 'Node has no type');
Result := nil;
end;
function TAstNode.AsUnquote: IUnquoteNode;
begin
raise ETypeException.Create('Node is not an Unquote');
Assert(False, 'Node is not an Unquote');
Result := nil;
end;
function TAstNode.AsUnquoteSplicing: IUnquoteSplicingNode;
begin
raise ETypeException.Create('Node is not an UnquoteSplicing');
Assert(False, 'Node is not an UnquoteSplicing');
Result := nil;
end;
function TAstNode.AsVariableDeclaration: IVariableDeclarationNode;
begin
raise ETypeException.Create('Node is not a VariableDeclaration');
Assert(False, 'Node is not a VariableDeclaration');
Result := nil;
end;
function TAstNode.GetIsTyped: Boolean;
@@ -1244,7 +1267,7 @@ constructor TLambdaExpressionNode.Create(
const ADescriptor: IScopeDescriptor;
const AUpvalues: TArray<TResolvedAddress>;
const AHasNestedLambdas: Boolean;
const AIsPure: Boolean // (* ADDED *)
const AIsPure: Boolean
);
begin
inherited Create(AStaticType);
@@ -1306,7 +1329,7 @@ begin
Result := FHasNestedLambdas;
end;
function TLambdaExpressionNode.GetIsPure: Boolean; // (* ADDED *)
function TLambdaExpressionNode.GetIsPure: Boolean;
begin
Result := FIsPure;
end;
@@ -1448,7 +1471,7 @@ constructor TFunctionCallNode.Create(
const AStaticType: IStaticType;
const AIsTailCall: Boolean;
const AStaticTarget: TDataValue.TFunc;
const AIsTargetPure: Boolean // (* ADDED *)
const AIsTargetPure: Boolean
);
begin
inherited Create(AStaticType);
@@ -1494,7 +1517,7 @@ begin
Result := FStaticTarget;
end;
function TFunctionCallNode.GetIsTargetPure: Boolean; // (* ADDED *)
function TFunctionCallNode.GetIsTargetPure: Boolean;
begin
Result := FIsTargetPure;
end;
Src/AST/Test.Myc.Ast.Compiler.Binder.pas
+1 -1
View File
@@ -154,7 +154,7 @@ begin
// (do (def a 1) (def a 2)) - Forbidden!
root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1)), TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(2))]);
Assert.WillRaise(procedure begin Bind(root, layout); end, Exception, 'Binder must forbid redefinition in the same scope.');
Assert.WillRaise(procedure begin Bind(root, layout); end, EBinderException, 'Binder must forbid redefinition in the same scope.');
end;
// ... (Rest of validation tests remain identical)