From d37862186c4dede5d2d308107a8d12d352377677 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Fri, 12 Sep 2025 13:20:00 +0200 Subject: [PATCH] TDataValue as new global variant type --- ASTPlayground/ASTPlayground.dproj | 2 +- Src/AST/Myc.Ast.Evaluator.pas | 126 ++++++++-------------------- Src/Data/Myc.Data.Types.pas | 2 +- Src/Data/Myc.Data.Value.pas | 60 ++++++++----- Src/Myc.Trade.Indicators.Common.pas | 1 + 5 files changed, 80 insertions(+), 111 deletions(-) diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index dc08114..cdaa73a 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Release + Debug Win64 ASTPlayground 2 diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 2a2f886..31a8483 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -13,7 +13,6 @@ uses Myc.Ast; type - // TEvaluatorVisitor is the base implementation for evaluating an AST. TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) private FScope: IExecutionScope; @@ -40,7 +39,6 @@ type function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual; end; - // TDebugEvaluatorVisitor now overrides all visit methods for full tracing TDebugEvaluatorVisitor = class(TEvaluatorVisitor) private FLog: TStrings; @@ -73,7 +71,6 @@ type function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; end; -// Registers all native core functions in the given scope. procedure RegisterNativeFunctions(const AScope: IExecutionScope); implementation @@ -87,10 +84,18 @@ uses Myc.Data.Scalar.JSON; type - // The signature for a native Delphi function callable from the script. TNativeFunction = function(const Args: TArray): TDataValue; - TClosureValue = class(TInterfacedObject, TDataValue.ICallable) + TClosure = class(TInterfacedObject) + function GetArity: Integer; virtual; abstract; + function Invoke( + const AVisitor: IAstVisitor; + const ASelf: TDataValue; + const AArgNodes: TList + ): TDataValue; virtual; abstract; + end; + + TClosureValue = class(TClosure) private FLambdaNode: ILambdaExpressionNode; FClosureScope: IExecutionScope; @@ -101,22 +106,18 @@ type const AClosureScope: IExecutionScope; const AUpvalues: TArray ); - // ICallable implementation (the generic, slower path) - function GetArity: Integer; - function Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray): TDataValue; - // Fast Path - function InvokeFast(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; + function GetArity: Integer; override; + function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; override; end; - TNativeClosure = class(TInterfacedObject, TDataValue.ICallable) + TNativeClosure = class(TClosure) private FMethod: TNativeFunction; FArity: Integer; public constructor Create(const AMethod: TNativeFunction; AArity: Integer); - // ICallable implementation - function GetArity: Integer; - function Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray): TDataValue; + function GetArity: Integer; override; + function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; override; end; // --- Native Functions Implementation --- @@ -169,15 +170,16 @@ begin Result := Length(FLambdaNode.Parameters); end; -// This is the generic, slightly slower path, kept for compatibility with ICallable. -function TClosureValue.Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray): TDataValue; +function TClosureValue.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; var i: Integer; descriptor: IScopeDescriptor; callScope: IExecutionScope; adr: TResolvedAddress; - callVisitor: IAstVisitor; begin + if (AArgNodes.Count <> GetArity) then + raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [GetArity, AArgNodes.Count]); + descriptor := FLambdaNode.ScopeDescriptor; if not Assigned(descriptor) then raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?'); @@ -189,52 +191,12 @@ begin adr.SlotIndex := 0; callScope[adr].Value := ASelf; - for i := 0 to High(AArgs) do - begin - adr.SlotIndex := FLambdaNode.Parameters[i].Address.SlotIndex; - callScope[adr].Value := AArgs[i]; - end; - - callVisitor := (AVisitor as TEvaluatorVisitor).CreateVisitorForScope(callScope); - Result := FLambdaNode.Body.Accept(callVisitor); -end; - -// This is the new, optimized method that evaluates argument nodes directly. -function TClosureValue.InvokeFast(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; -var - i: Integer; - descriptor: IScopeDescriptor; - callScope: IExecutionScope; - adr: TResolvedAddress; -begin - // Arity check - if (AArgNodes.Count <> Length(FLambdaNode.Parameters)) then - raise EArgumentException - .CreateFmt('Argument count mismatch: expected %d, got %d', [Length(FLambdaNode.Parameters), AArgNodes.Count]); - - descriptor := FLambdaNode.ScopeDescriptor; - if not Assigned(descriptor) then - raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?'); - - // Create the scope for the call directly - callScope := TExecutionScope.Create(FClosureScope, descriptor, FUpvalues); - - adr.Kind := akLocalOrParent; - adr.ScopeDepth := 0; - - // Set the 'Self' variable - adr.SlotIndex := 0; - callScope[adr].Value := ASelf; - - // Evaluate arguments DIRECTLY into the new scope (no temporary array!) for i := 0 to AArgNodes.Count - 1 do begin adr.SlotIndex := FLambdaNode.Parameters[i].Address.SlotIndex; - // Evaluate in CALLER'S scope (AVisitor), place in CALLEE'S scope (callScope) callScope[adr].Value := AArgNodes[i].Accept(AVisitor); end; - // Execute the body with a new visitor for the new scope Result := FLambdaNode.Body.Accept((AVisitor as TEvaluatorVisitor).CreateVisitorForScope(callScope)); end; @@ -252,14 +214,20 @@ begin Result := FArity; end; -function TNativeClosure.Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray): TDataValue; +function TNativeClosure.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; +var + argValues: TArray; + i: Integer; begin - // Arity check - if (FArity <> -1) and (Length(AArgs) <> FArity) then - raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [FArity, Length(AArgs)]); + if (FArity <> -1) and (AArgNodes.Count <> FArity) then + raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [FArity, AArgNodes.Count]); - // AVisitor and ASelf are ignored for native calls. - Result := FMethod(AArgs); + // Evaluate argument nodes to get values for the native function + SetLength(argValues, AArgNodes.Count); + for i := 0 to AArgNodes.Count - 1 do + argValues[i] := AArgNodes[i].Accept(AVisitor); + + Result := FMethod(argValues); end; { TEvaluatorVisitor } @@ -296,37 +264,17 @@ end; function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; var calleeValue: TDataValue; - callable: TDataValue.ICallable; - i: Integer; begin calleeValue := Node.Callee.Accept(Self); - if calleeValue.Kind <> vkCallable then - raise EArgumentException.Create('Expression is not a callable value.'); + // Check if the value holds an interface and if that interface supports our invocation contract. + if (calleeValue.Kind <> vkInterface) or not (calleeValue.AsInterface is TClosure) then + raise EArgumentException.Create('Expression is not invokable in this context.'); - callable := calleeValue.AsCallable; - - if callable is TClosureValue then - begin - // "Fast Path": Call the optimized method directly. - Result := (callable as TClosureValue).InvokeFast(Self, calleeValue, Node.Arguments); - end - else - begin - // "Generic Path": For other ICallable types (e.g., TNativeClosure). - // Evaluate arguments into a temporary array first. - var argValues: TArray; - SetLength(argValues, Node.Arguments.Count); - for i := 0 to Node.Arguments.Count - 1 do - argValues[i] := Node.Arguments[i].Accept(Self); - - // Call the generic Invoke method. - Result := callable.Invoke(Self, calleeValue, argValues); - end; + // "Tell, Don't Ask": Simply tell the object to invoke itself. + Result := (calleeValue.AsInterface as TClosure).Invoke(Self, calleeValue, Node.Arguments); end; -{ TEvaluatorVisitor } - function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; var itemValue, lookbackValue, seriesVar: TDataValue; @@ -531,7 +479,7 @@ begin for i := 0 to High(sourceAddresses) do capturedCells[i] := FScope.GetCell(sourceAddresses[i]); - Result := TClosureValue.Create(Node, FScope, capturedCells); + Result := TClosureValue.Create(Node, FScope, capturedCells) as IInterface; end; function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; diff --git a/Src/Data/Myc.Data.Types.pas b/Src/Data/Myc.Data.Types.pas index 42567e6..2e1858f 100644 --- a/Src/Data/Myc.Data.Types.pas +++ b/Src/Data/Myc.Data.Types.pas @@ -1,4 +1,4 @@ -unit Myc.Data.Types; +unit Myc.Data.Types deprecated; interface diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index e32a370..3a2f845 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -9,22 +9,15 @@ uses Myc.Data.Decimal; type - TDataValueKind = (vkVoid, vkScalar, vkCallable, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries); + TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric); TDataValue = record public type - ICallable = interface - function GetArity: Integer; - function Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray): TDataValue; - property Arity: Integer read GetArity; - end; - TVal = class(TInterfacedObject) Value: T; constructor Create(const AValue: T); end; - private var FKind: TDataValueKind; @@ -37,8 +30,11 @@ type class function Void: TDataValue; inline; static; class operator Implicit(const AValue: TScalar): TDataValue; overload; inline; - class operator Implicit(const AValue: ICallable): TDataValue; overload; inline; class operator Implicit(const AValue: String): TDataValue; overload; inline; + class operator Implicit(const AValue: IInterface): TDataValue; overload; inline; + + class function From(const [ref] AValue: T): TDataValue; static; inline; + function AsVal: TVal; inline; class function FromSeries(const [ref] AValue: TScalarSeries): TDataValue; static; inline; class function FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue; static; inline; @@ -46,13 +42,15 @@ type class function FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue; static; inline; function AsScalar: TScalar; inline; - function AsCallable: ICallable; inline; + function AsInterface: IInterface; inline; function AsText: String; inline; function AsRecordSeries: TVal; inline; function AsRecord: TVal; inline; function AsMemberSeries: TVal; inline; function AsSeries: TVal; inline; + procedure SetVoid; + function ToString: String; property IsVoid: Boolean read GetIsVoid; property Kind: TDataValueKind read GetKind; @@ -60,6 +58,9 @@ type implementation +uses + TypInfo; + { TDataValue.TVal } constructor TDataValue.TVal.Create(const AValue: T); @@ -72,15 +73,15 @@ end; class operator TDataValue.Initialize(out Dest: TDataValue); begin - Dest.FKind := vkVoid; // Geändert + Dest.FKind := vkVoid; Dest.FInterface := nil; end; -function TDataValue.AsCallable: ICallable; +function TDataValue.AsInterface: IInterface; begin - if (FKind <> vkCallable) then - raise EInvalidCast.Create('Cannot read value as a Callable.'); - Result := ICallable(FInterface); + if (FKind <> vkInterface) then + raise EInvalidCast.Create('Cannot read value as an Interface.'); + Result := FInterface; end; function TDataValue.AsMemberSeries: TVal; @@ -90,6 +91,13 @@ begin Result := TVal(FInterface); end; +function TDataValue.AsVal: TVal; +begin + if (FKind <> vkGeneric) then + raise EInvalidCast.Create('Cannot read value as ' + PTypeInfo(TypeInfo(T)).Name + '.'); + Result := TVal(FInterface); +end; + function TDataValue.AsRecord: TVal; begin if (FKind <> vkRecord) then @@ -125,6 +133,12 @@ begin Result := (FInterface as TVal).Value; end; +class function TDataValue.From(const [ref] AValue: T): TDataValue; +begin + Result.FKind := vkGeneric; + Result.FInterface := TVal.Create(AValue); +end; + class function TDataValue.FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue; begin Result.FKind := vkMemberSeries; @@ -153,9 +167,9 @@ begin Result.FScalar := Default(TScalar); end; -class operator TDataValue.Implicit(const AValue: ICallable): TDataValue; +class operator TDataValue.Implicit(const AValue: IInterface): TDataValue; begin - Result.FKind := vkCallable; + Result.FKind := vkInterface; Result.FInterface := AValue; Result.FScalar := Default(TScalar); end; @@ -176,7 +190,7 @@ end; function TDataValue.GetIsVoid: Boolean; begin - Result := FKind = vkVoid; // Geändert + Result := FKind = vkVoid; end; function TDataValue.GetKind: TDataValueKind; @@ -184,17 +198,23 @@ begin Result := FKind; end; +procedure TDataValue.SetVoid; +begin + FKind := vkVoid; + FInterface := nil; +end; + function TDataValue.ToString: String; begin case FKind of vkScalar: Result := FScalar.ToString; - vkCallable: Result := ''; + vkInterface: Result := ''; vkText: Result := AsText; vkSeries: Result := ''; vkRecordSeries: Result := ''; vkRecord: Result := ''; vkMemberSeries: Result := ''; - vkVoid: Result := ''; // Geändert + vkVoid: Result := ''; else Result := '[Unknown DataValue]'; end; diff --git a/Src/Myc.Trade.Indicators.Common.pas b/Src/Myc.Trade.Indicators.Common.pas index 6afd417..b08d682 100644 --- a/Src/Myc.Trade.Indicators.Common.pas +++ b/Src/Myc.Trade.Indicators.Common.pas @@ -9,6 +9,7 @@ uses Myc.Data.Pipeline, Myc.Data.Series, Myc.Data.Types, + Myc.Data.Value, Myc.Trade.Types, Myc.Trade.Indicators;