Fix in Upvalue-Logic
This commit is contained in:
Michael Schimmel
@@ -78,6 +78,30 @@ type
|
||||
property Symbols: TDictionary<string, Integer> read FSymbols;
|
||||
end;
|
||||
|
||||
// A custom equality comparer for TResolvedAddress to ensure correct behavior in TDictionary.
|
||||
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
|
||||
public
|
||||
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
|
||||
function GetHashCode(const Value: TResolvedAddress): Integer; override;
|
||||
end;
|
||||
|
||||
{ TResolvedAddressComparer }
|
||||
|
||||
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
|
||||
begin
|
||||
// Use the existing equality operator for the record.
|
||||
Result := (Left = Right);
|
||||
end;
|
||||
|
||||
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
|
||||
begin
|
||||
// Classic hash combining algorithm using prime numbers.
|
||||
Result := 17;
|
||||
Result := Result * 23 + Ord(Value.Kind);
|
||||
Result := Result * 23 + Value.ScopeDepth;
|
||||
Result := Result * 23 + Value.SlotIndex;
|
||||
end;
|
||||
|
||||
{ TAstBinder }
|
||||
|
||||
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
|
||||
@@ -190,6 +214,44 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
var
|
||||
depth, idx: Integer;
|
||||
identNode: TIdentifierNode;
|
||||
upvalue: TUpvalueMapping;
|
||||
originalAddress: TResolvedAddress;
|
||||
upvalueIndex: Integer;
|
||||
begin
|
||||
identNode := Node as TIdentifierNode;
|
||||
if identNode.Address.Kind <> akUnresolved then
|
||||
exit;
|
||||
|
||||
if FCurrentDescriptor.FindSymbol(identNode.Name, depth, idx) then
|
||||
begin
|
||||
if (depth > 0) and (FUpvalueStack.Count > 0) then
|
||||
begin
|
||||
upvalue := FUpvalueStack.Peek;
|
||||
|
||||
// Address is relative to the lambda's parent scope.
|
||||
dec(depth);
|
||||
originalAddress := TResolvedAddress.Create(akLocalOrParent, depth, idx);
|
||||
|
||||
if not upvalue.Map.TryGetValue(originalAddress, upvalueIndex) then
|
||||
begin
|
||||
upvalueIndex := upvalue.Map.Count;
|
||||
upvalue.Map.Add(originalAddress, upvalueIndex);
|
||||
end;
|
||||
|
||||
(Node as TIdentifierNode).Address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
|
||||
end
|
||||
else
|
||||
(Node as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, depth, idx);
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]);
|
||||
end;
|
||||
|
||||
(*
|
||||
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
var
|
||||
depth, idx: Integer;
|
||||
@@ -227,7 +289,7 @@ begin
|
||||
else
|
||||
raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]);
|
||||
end;
|
||||
|
||||
*)
|
||||
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
begin
|
||||
// The condition is never in a tail position.
|
||||
@@ -400,7 +462,8 @@ end;
|
||||
constructor TAstBinder.TUpvalueMapping.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Map := TDictionary<TResolvedAddress, Integer>.Create;
|
||||
// Use the custom equality comparer to ensure correct dictionary behavior.
|
||||
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Create);
|
||||
Nodes := TList<IIdentifierNode>.Create();
|
||||
end;
|
||||
|
||||
|
||||
@@ -0,0 +1,327 @@
|
||||
unit Myc.Ast.Dumper;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Traverser,
|
||||
Myc.Data.Value,
|
||||
Myc.Data.Scalar;
|
||||
|
||||
type
|
||||
// Dumps a bound AST into a human-readable format for debugging purposes.
|
||||
TAstDumper = class(TAstTraverser)
|
||||
private
|
||||
FOutput: TStrings;
|
||||
FIndent: Integer;
|
||||
procedure Indent;
|
||||
procedure Unindent;
|
||||
procedure Log(const Text: string); overload;
|
||||
procedure LogFmt(const Fmt: string; const Args: array of const); overload;
|
||||
function FormatAddress(const Addr: TResolvedAddress): string;
|
||||
protected
|
||||
function Accept(const Node: IAstNode): TDataValue; override;
|
||||
public
|
||||
// Creates a new instance of the AST dumper.
|
||||
constructor Create(const AOutput: TStrings);
|
||||
|
||||
// Traverses the given root node and writes the structural information into the output.
|
||||
class procedure Dump(const RootNode: IAstNode; const Output: TStrings);
|
||||
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TAstDumper }
|
||||
|
||||
class procedure TAstDumper.Dump(const RootNode: IAstNode; const Output: TStrings);
|
||||
var
|
||||
dumper: TAstDumper;
|
||||
begin
|
||||
if not Assigned(Output) then
|
||||
exit;
|
||||
|
||||
Output.Clear;
|
||||
dumper := TAstDumper.Create(Output);
|
||||
try
|
||||
dumper.Accept(RootNode);
|
||||
finally
|
||||
dumper.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TAstDumper.Create(const AOutput: TStrings);
|
||||
begin
|
||||
inherited Create;
|
||||
FOutput := AOutput;
|
||||
FIndent := 0;
|
||||
end;
|
||||
|
||||
function TAstDumper.Accept(const Node: IAstNode): TDataValue;
|
||||
begin
|
||||
Result := TDataValue.Void;
|
||||
if Assigned(Node) then
|
||||
Result := inherited Accept(Node);
|
||||
end;
|
||||
|
||||
procedure TAstDumper.Indent;
|
||||
begin
|
||||
inc(FIndent, 2);
|
||||
end;
|
||||
|
||||
procedure TAstDumper.Unindent;
|
||||
begin
|
||||
dec(FIndent, 2);
|
||||
end;
|
||||
|
||||
procedure TAstDumper.Log(const Text: string);
|
||||
begin
|
||||
FOutput.Add(StringOfChar(' ', FIndent) + Text);
|
||||
end;
|
||||
|
||||
procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const);
|
||||
begin
|
||||
Log(Format(Fmt, Args));
|
||||
end;
|
||||
|
||||
function TAstDumper.FormatAddress(const Addr: TResolvedAddress): string;
|
||||
begin
|
||||
case Addr.Kind of
|
||||
akUnresolved: Result := '!! UNRESOLVED !!';
|
||||
akLocalOrParent: Result := Format('LocalOrParent (Depth: %d, Slot: %d)', [Addr.ScopeDepth, Addr.SlotIndex]);
|
||||
akUpvalue: Result := Format('Upvalue (Index: %d)', [Addr.SlotIndex]);
|
||||
else
|
||||
Result := 'Unknown Address Kind';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
begin
|
||||
LogFmt('Constant: %s', [Node.Value.ToString]);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
begin
|
||||
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(Node.Address)]);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
begin
|
||||
LogFmt('BinaryExpression: %s', [Node.Operator.ToString]);
|
||||
Indent;
|
||||
Accept(Node.Left);
|
||||
Accept(Node.Right);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
begin
|
||||
LogFmt('UnaryExpression: %s', [Node.Operator.ToString]);
|
||||
Indent;
|
||||
Accept(Node.Right);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
begin
|
||||
Log('IfExpression');
|
||||
Indent;
|
||||
Log('Condition:');
|
||||
Accept(Node.Condition);
|
||||
Log('Then:');
|
||||
Accept(Node.ThenBranch);
|
||||
if Assigned(Node.ElseBranch) then
|
||||
begin
|
||||
Log('Else:');
|
||||
Accept(Node.ElseBranch);
|
||||
end;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
begin
|
||||
Log('TernaryExpression');
|
||||
Indent;
|
||||
Log('Condition:');
|
||||
Accept(Node.Condition);
|
||||
Log('Then:');
|
||||
Accept(Node.ThenBranch);
|
||||
Log('Else:');
|
||||
Accept(Node.ElseBranch);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
var
|
||||
param: IIdentifierNode;
|
||||
upvalueAddr: TResolvedAddress;
|
||||
pair: TPair<string, Integer>;
|
||||
begin
|
||||
LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString]);
|
||||
Indent;
|
||||
|
||||
Log('Parameters:');
|
||||
Indent;
|
||||
for param in Node.Parameters do
|
||||
Accept(param);
|
||||
Unindent;
|
||||
|
||||
LogFmt('Upvalues (%d):', [Length(Node.Upvalues)]);
|
||||
Indent;
|
||||
for upvalueAddr in Node.Upvalues do
|
||||
Log(FormatAddress(upvalueAddr));
|
||||
Unindent;
|
||||
|
||||
Log('Scope Descriptor:');
|
||||
Indent;
|
||||
if Assigned(Node.ScopeDescriptor) then
|
||||
for pair in Node.ScopeDescriptor.Symbols do
|
||||
LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value])
|
||||
else
|
||||
Log('(none)');
|
||||
Unindent;
|
||||
|
||||
Log('Body:');
|
||||
Accept(Node.Body);
|
||||
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
var
|
||||
arg: IAstNode;
|
||||
begin
|
||||
LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString]);
|
||||
Indent;
|
||||
Log('Callee:');
|
||||
Accept(Node.Callee);
|
||||
LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
|
||||
Indent;
|
||||
for arg in Node.Arguments do
|
||||
Accept(arg);
|
||||
Unindent;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
var
|
||||
expr: IAstNode;
|
||||
begin
|
||||
Log('BlockExpression');
|
||||
Indent;
|
||||
for expr in Node.Expressions do
|
||||
Accept(expr);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
begin
|
||||
Log('VariableDeclaration');
|
||||
Indent;
|
||||
Accept(Node.Identifier);
|
||||
if Assigned(Node.Initializer) then
|
||||
begin
|
||||
Log('Initializer:');
|
||||
Accept(Node.Initializer);
|
||||
end;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
begin
|
||||
Log('Assignment');
|
||||
Indent;
|
||||
Accept(Node.Identifier);
|
||||
Log('Value:');
|
||||
Accept(Node.Value);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
begin
|
||||
Log('Indexer');
|
||||
Indent;
|
||||
Log('Base:');
|
||||
Accept(Node.Base);
|
||||
Log('Index:');
|
||||
Accept(Node.Index);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
begin
|
||||
Log('MemberAccess');
|
||||
Indent;
|
||||
Log('Base:');
|
||||
Accept(Node.Base);
|
||||
Log('Member:');
|
||||
Accept(Node.Member);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
begin
|
||||
LogFmt('CreateSeries: %s', [Node.Definition]);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
begin
|
||||
Log('AddSeriesItem');
|
||||
Indent;
|
||||
Log('Series:');
|
||||
Accept(Node.Series);
|
||||
Log('Value:');
|
||||
Accept(Node.Value);
|
||||
if Assigned(Node.Lookback) then
|
||||
begin
|
||||
Log('Lookback:');
|
||||
Accept(Node.Lookback);
|
||||
end;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
begin
|
||||
Log('SeriesLength');
|
||||
Indent;
|
||||
Log('Series:');
|
||||
Accept(Node.Series);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -65,7 +65,7 @@ function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
|
||||
var
|
||||
jsonDef: string;
|
||||
recordDef: TScalarRecordDefinition;
|
||||
series: TScalarRecordSeries;
|
||||
series: IRecordSeries;
|
||||
begin
|
||||
if (Length(Args) <> 1) or (Args[0].Kind <> vkText) then
|
||||
raise EArgumentException.Create('CreateRecordSeries requires one string argument.');
|
||||
@@ -162,7 +162,7 @@ begin
|
||||
adr.Kind := akLocalOrParent;
|
||||
adr.ScopeDepth := 0;
|
||||
|
||||
// Capture 'Self' (slot 0) for recursion.
|
||||
// Capture 'Self' (slot 0) for recursion using the captured variable.
|
||||
adr.SlotIndex := 0;
|
||||
lambdaScope[adr] := closureValue;
|
||||
|
||||
@@ -279,8 +279,7 @@ begin
|
||||
else
|
||||
begin
|
||||
var scalarKind := TScalar.StringToKind(def);
|
||||
var scalarSeries := TScalarSeries.Create(scalarKind);
|
||||
Result := TDataValue.FromSeries(scalarSeries);
|
||||
Result := TDataValue.FromSeries(TScalarSeries.Create(scalarKind));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@@ -140,7 +140,7 @@ begin
|
||||
case Address.Kind of
|
||||
akUpvalue:
|
||||
begin
|
||||
// TODO Dieser Pfad wir nie erreicht!
|
||||
// TODO Dieser Pfad wird nie erreicht!
|
||||
Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
|
||||
Assert(
|
||||
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)),
|
||||
|
||||
Reference in New Issue
Block a user