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

TDataValue as new global variant type

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-12 13:20:00 +02:00
parent 646ffe92bb
commit d37862186c
5 changed files with 80 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.dproj
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName>
<TargetedPlatforms>2</TargetedPlatforms>
Src/AST/Myc.Ast.Evaluator.pas
+37 -89
View File
@@ -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>): 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<IAstNode>
): TDataValue; virtual; abstract;
end;
TClosureValue = class(TClosure)
private
FLambdaNode: ILambdaExpressionNode;
FClosureScope: IExecutionScope;
@@ -101,22 +106,18 @@ type
const AClosureScope: IExecutionScope;
const AUpvalues: TArray<IValueCell>
);
// ICallable implementation (the generic, slower path)
function GetArity: Integer;
function Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray<TDataValue>): TDataValue;
// Fast Path
function InvokeFast(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
function GetArity: Integer; override;
function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): 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>): TDataValue;
function GetArity: Integer; override;
function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): 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>): TDataValue;
function TClosureValue.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): 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<IAstNode>): 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>): TDataValue;
function TNativeClosure.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
var
argValues: TArray<TDataValue>;
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,36 +264,16 @@ 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<TDataValue>;
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);
// "Tell, Don't Ask": Simply tell the object to invoke itself.
Result := (calleeValue.AsInterface as TClosure).Invoke(Self, calleeValue, Node.Arguments);
end;
end;
{ TEvaluatorVisitor }
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
@@ -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;
Src/Data/Myc.Data.Types.pas
+1 -1
View File
@@ -1,4 +1,4 @@
unit Myc.Data.Types;
unit Myc.Data.Types deprecated;
interface
Src/Data/Myc.Data.Value.pas
+40 -20
View File
@@ -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>): TDataValue;
property Arity: Integer read GetArity;
end;
TVal<T> = 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<T: record>(const [ref] AValue: T): TDataValue; static; inline;
function AsVal<T: record>: TVal<T>; 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<TScalarRecordSeries>; inline;
function AsRecord: TVal<TScalarRecord>; inline;
function AsMemberSeries: TVal<TScalarMemberSeries>; inline;
function AsSeries: TVal<TScalarSeries>; 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<T> }
constructor TDataValue.TVal<T>.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<TScalarMemberSeries>;
@@ -90,6 +91,13 @@ begin
Result := TVal<TScalarMemberSeries>(FInterface);
end;
function TDataValue.AsVal<T>: TVal<T>;
begin
if (FKind <> vkGeneric) then
raise EInvalidCast.Create('Cannot read value as ' + PTypeInfo(TypeInfo(T)).Name + '.');
Result := TVal<T>(FInterface);
end;
function TDataValue.AsRecord: TVal<TScalarRecord>;
begin
if (FKind <> vkRecord) then
@@ -125,6 +133,12 @@ begin
Result := (FInterface as TVal<String>).Value;
end;
class function TDataValue.From<T>(const [ref] AValue: T): TDataValue;
begin
Result.FKind := vkGeneric;
Result.FInterface := TVal<T>.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 := '<callable>';
vkInterface: Result := '<interface>';
vkText: Result := AsText;
vkSeries: Result := '<series>';
vkRecordSeries: Result := '<record_series>';
vkRecord: Result := '<record>';
vkMemberSeries: Result := '<member_series>';
vkVoid: Result := '<void>'; // Geändert
vkVoid: Result := '<void>';
else
Result := '[Unknown DataValue]';
end;
Src/Myc.Trade.Indicators.Common.pas
+1
View File
@@ -9,6 +9,7 @@ uses
Myc.Data.Pipeline,
Myc.Data.Series,
Myc.Data.Types,
Myc.Data.Value,
Myc.Trade.Types,
Myc.Trade.Indicators;