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

RTL and Data value refactoring and defered values

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-18 13:35:25 +02:00
parent 4d380c8f98
commit 2c55a120f1
11 changed files with 783 additions and 365 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.dpr
+2 -1
View File
@@ -16,7 +16,8 @@ uses
Myc.Fmx.AstEditor.Workspace in 'Myc.Fmx.AstEditor.Workspace.pas',
Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas',
Myc.Ast.Traverser in '..\Src\AST\Myc.Ast.Traverser.pas',
Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas';
Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas',
Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+2 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName>
<TargetedPlatforms>2</TargetedPlatforms>
@@ -148,6 +148,7 @@
<DCCReference Include="Myc.Fmx.AstEditor.Text.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Traverser.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Binding.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
ASTPlayground/MainForm.pas
+105 -50
View File
@@ -136,6 +136,61 @@ begin
FWorkspace.OnMouseDown := WorkspaceMouseDown;
Tast.RegisterLibrary(
procedure(const Scope: IExecutionScope)
begin
var smaAst :=
TAst.LambdaExpr(
[TAst.Identifier('len')],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(0))),
TAst.LambdaExpr(
[TAst.Identifier('series'), TAst.Identifier('val')],
TAst.Block(
[
TAst.Assign(
TAst.Identifier('sum'),
TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
),
TAst.Assign(
TAst.Identifier('count'),
TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
),
TAst.Assign(
TAst.Identifier('sum'),
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boSubtract,
TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
),
TAst.Identifier('sum')
)
),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boDivide,
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')),
TAst.Identifier('count'),
TAst.Identifier('len')
)
)
]
)
)
]
)
);
Scope.Define('CreateSMA', smaAst.Accept(TEvaluatorVisitor.Create(TAstBinder.Bind(smaAst, FGScope).CreateScope(FGScope))));
end
);
// Setup global scope
ClearButtonClick(Self);
end;
@@ -401,54 +456,54 @@ begin
var setupAst :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('CreateSMA'),
TAst.LambdaExpr(
[TAst.Identifier('len')],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(0))),
TAst.LambdaExpr(
[TAst.Identifier('series'), TAst.Identifier('val')],
TAst.Block(
[
TAst.Assign(
TAst.Identifier('sum'),
TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
),
TAst.Assign(
TAst.Identifier('count'),
TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
),
TAst.IfExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
TAst.Assign(
TAst.Identifier('sum'),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boSubtract,
TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
)
),
nil
),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boDivide,
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')),
TAst.Identifier('count'),
TAst.Identifier('len')
)
)
]
)
)
]
)
)
),
// TAst.VarDecl(
// TAst.Identifier('CreateSMA'),
// TAst.LambdaExpr(
// [TAst.Identifier('len')],
// TAst.Block(
// [
// TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
// TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(0))),
// TAst.LambdaExpr(
// [TAst.Identifier('series'), TAst.Identifier('val')],
// TAst.Block(
// [
// TAst.Assign(
// TAst.Identifier('sum'),
// TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
// ),
// TAst.Assign(
// TAst.Identifier('count'),
// TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
// ),
// TAst.IfExpr(
// TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
// TAst.Assign(
// TAst.Identifier('sum'),
// TAst.BinaryExpr(
// TAst.Identifier('sum'),
// boSubtract,
// TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
// )
// ),
// nil
// ),
// TAst.BinaryExpr(
// TAst.Identifier('sum'),
// boDivide,
// TAst.TernaryExpr(
// TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')),
// TAst.Identifier('count'),
// TAst.Identifier('len')
// )
// )
// ]
// )
// )
// ]
// )
// )
// ),
TAst.VarDecl(
TAst.Identifier('smaFast'),
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
@@ -548,9 +603,9 @@ begin
TScalarValue.FromInt64(ohlcvRec.Volume)
]
);
series.AsRecordSeries.Value.Add(recordValue, lookback);
series.AsRecordSeries.Add(recordValue, lookback);
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
if series.AsRecordSeries.TotalCount >= smaSlowLength then
begin
scope[seriesAddress] := series;
var resultValue := callAst.Accept(visitor);
Src/AST/Myc.Ast.Binding.pas
+5 -2
View File
@@ -390,8 +390,11 @@ end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
begin
for var pair in Scope.NameToIndex do
if not FSymbols.ContainsKey(pair.Key) then
FSymbols.Add(pair.Key, pair.Value);
begin
var name := Scope.NameStrings[pair.Key];
if not FSymbols.ContainsKey(name) then
FSymbols.Add(name, pair.Value);
end;
end;
constructor TAstBinder.TUpvalueMapping.Create;
Src/AST/Myc.Ast.Evaluator.pas
+19 -19
View File
@@ -239,12 +239,12 @@ begin
if (itemValue.Kind <> vkScalar) then
raise EArgumentException.Create('Can only add scalar values to a TScalarSeries.');
with seriesVar.AsSeries.Value do
with seriesVar.AsSeries do
begin
if (itemValue.AsScalar.Kind <> Kind) then
raise EArgumentException
.CreateFmt('Type mismatch: Cannot add %s to a series of %s.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]);
Items.Add(itemValue.AsScalar.Value, lookback);
Add(itemValue.AsScalar.Value, lookback);
end;
end;
vkRecordSeries:
@@ -252,9 +252,9 @@ begin
if (itemValue.Kind <> vkRecord) then
raise EArgumentException.Create('Can only add record values to a TScalarRecordSeries.');
with seriesVar.AsRecordSeries.Value do
with seriesVar.AsRecordSeries do
begin
Add(itemValue.AsRecord.Value, lookback);
Add(itemValue.AsRecord, lookback);
end;
end;
else
@@ -292,7 +292,7 @@ begin
else
begin
var scalarKind := TScalar.StringToKind(def);
var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries<TScalarValue>));
var scalarSeries := TScalarSeries.Create(scalarKind);
Result := TDataValue.FromSeries(scalarSeries);
end;
end;
@@ -325,16 +325,16 @@ begin
case baseValue.Kind of
vkSeries:
begin
with baseValue.AsSeries.Value do
with baseValue.AsSeries do
begin
if (index < 0) or (index >= Items.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, Items.TotalCount]);
Result := TScalar.Create(Kind, Items[Integer(index)]);
if (index < 0) or (index >= TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, TotalCount]);
Result := Items[Integer(index)];
end;
end;
vkRecordSeries:
begin
var series := baseValue.AsRecordSeries.Value;
var series := baseValue.AsRecordSeries;
if (index < 0) or (index >= series.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
var recordValue := series.Items[Integer(index)];
@@ -342,7 +342,7 @@ begin
end;
vkMemberSeries:
begin
var memberSeries := baseValue.AsMemberSeries.Value;
var memberSeries := baseValue.AsMemberSeries;
if (index < 0) or (index >= memberSeries.Count) then
raise EArgumentException
.CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]);
@@ -364,20 +364,20 @@ begin
case baseValue.Kind of
vkSeries:
begin
with baseValue.AsSeries.Value do
with baseValue.AsSeries do
begin
if SameText(memberName, 'Count') then
Result := TScalar.FromInt64(Items.Count)
Result := TScalar.FromInt64(Count)
else if SameText(memberName, 'TotalCount') then
Result := TScalar.FromInt64(Items.TotalCount)
Result := TScalar.FromInt64(TotalCount)
else if SameText(memberName, 'Kind') then
Result := Kind.ToString
else
raise EArgumentException.CreateFmt('Member "%s" not found on TScalarSeries.', [memberName]);
end;
end;
vkRecordSeries: Result := TDataValue.FromMemberSeries(baseValue.AsRecordSeries.Value.CreateMemberSeries(memberName));
vkRecord: Result := baseValue.AsRecord.Value.Items[memberName];
vkRecordSeries: Result := TDataValue.FromMemberSeries(baseValue.AsRecordSeries.CreateMemberSeries(memberName));
vkRecord: Result := baseValue.AsRecord.Items[memberName];
else
raise EArgumentException.Create('Member access operator `.` is not supported for this value type.');
end;
@@ -460,9 +460,9 @@ begin
seriesValue := FScope[Node.Series.Address];
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Value.Items.Count;
vkRecordSeries: len := seriesValue.AsRecordSeries.Value.Count;
vkMemberSeries: len := seriesValue.AsMemberSeries.Value.Count;
vkSeries: len := seriesValue.AsSeries.Count;
vkRecordSeries: len := seriesValue.AsRecordSeries.Count;
vkMemberSeries: len := seriesValue.AsMemberSeries.Count;
else
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
end;
Src/AST/Myc.Ast.RTL.pas
+133
View File
@@ -0,0 +1,133 @@
unit Myc.Ast.RTL;
interface
// This unit is intended to be included in a 'uses' clause.
// It self-registers its functions via its initialization section.
implementation
uses
System.SysUtils,
System.Math,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Data.Decimal,
Myc.Ast,
Myc.Ast.Nodes,
Myc.Ast.Scope;
//--------------------------------------------------------------------------------------------------
//== Native Function Implementations
//--------------------------------------------------------------------------------------------------
// A helper to simplify argument validation for unary numeric functions.
function GetSingleNumericArg(const AName: string; const AArgs: TArray<TDataValue>; out AArg: TScalar): Boolean;
begin
if Length(AArgs) <> 1 then
raise EArgumentException.CreateFmt('%s requires exactly one argument.', [AName]);
if AArgs[0].Kind <> vkScalar then
raise EArgumentException.CreateFmt('%s requires a scalar argument.', [AName]);
AArg := AArgs[0].AsScalar;
if not (AArg.Kind in [skInteger, skInt64, skSingle, skDouble, skDecimal]) then
raise EArgumentException.CreateFmt('%s requires a numeric argument, but got %s.', [AName, AArg.Kind.ToString]);
Result := True;
end;
function NativeAbs(const Args: TArray<TDataValue>): TDataValue;
var
arg: TScalar;
begin
GetSingleNumericArg('Abs', Args, arg);
case arg.Kind of
skInteger: Result := TScalar.FromInteger(Abs(arg.Value.AsInteger));
skInt64: Result := TScalar.FromInt64(Abs(arg.Value.AsInt64));
skSingle: Result := TScalar.FromSingle(Abs(arg.Value.AsSingle));
skDouble: Result := TScalar.FromDouble(Abs(arg.Value.AsDouble));
skDecimal: Result := TScalar.FromDecimal(arg.Value.AsDecimal.Abs);
else
// Should be caught by GetSingleNumericArg, but as a safeguard:
raise EArgumentException.Create('Abs requires a numeric argument.');
end;
end;
function NativeTrunc(const Args: TArray<TDataValue>): TDataValue;
var
arg: TScalar;
begin
GetSingleNumericArg('Trunc', Args, arg);
case arg.Kind of
skInteger, skInt64: Result := arg; // Trunc on an integer is a no-op
skSingle: Result := TScalar.FromInt64(Trunc(arg.Value.AsSingle));
skDouble: Result := TScalar.FromInt64(Trunc(arg.Value.AsDouble));
skDecimal: Result := TScalar.FromInt64(Trunc(arg.Value.AsDecimal));
else
raise EArgumentException.Create('Trunc requires a numeric argument.');
end;
end;
function NativeCeil(const Args: TArray<TDataValue>): TDataValue;
var
arg: TScalar;
begin
GetSingleNumericArg('Ceil', Args, arg);
case arg.Kind of
skInteger, skInt64: Result := arg; // Ceil on an integer is a no-op
skSingle: Result := TScalar.FromInt64(Ceil(arg.Value.AsSingle));
skDouble: Result := TScalar.FromInt64(Ceil(arg.Value.AsDouble));
else
raise EArgumentException.Create('Ceil requires a numeric argument.');
end;
end;
function NativeFloor(const Args: TArray<TDataValue>): TDataValue;
var
arg: TScalar;
begin
GetSingleNumericArg('Floor', Args, arg);
case arg.Kind of
skInteger, skInt64: Result := arg; // Floor on an integer is a no-op
skSingle: Result := TScalar.FromInt64(Floor(arg.Value.AsSingle));
skDouble: Result := TScalar.FromInt64(Floor(arg.Value.AsDouble));
skDecimal: Result := TScalar.FromInt64(Trunc(arg.Value.AsDecimal));
else
raise EArgumentException.Create('Floor requires a numeric argument.');
end;
end;
function NativeSign(const Args: TArray<TDataValue>): TDataValue;
var
arg: TScalar;
begin
GetSingleNumericArg('Sign', Args, arg);
case arg.Kind of
skInteger: Result := TScalar.FromInteger(Sign(arg.Value.AsInteger));
skInt64: Result := TScalar.FromInteger(Sign(arg.Value.AsInt64));
skSingle: Result := TScalar.FromInteger(Sign(arg.Value.AsSingle));
skDouble: Result := TScalar.FromInteger(Sign(arg.Value.AsDouble));
skDecimal: Result := TScalar.FromInteger(arg.Value.AsDecimal.Sign);
else
raise EArgumentException.Create('Sign requires a numeric argument.');
end;
end;
//--------------------------------------------------------------------------------------------------
//== Library Registration
//--------------------------------------------------------------------------------------------------
procedure RegisterRtlFunctions(const AScope: IExecutionScope);
begin
AScope.Define('Abs', TDataValue(NativeAbs));
AScope.Define('Trunc', TDataValue(NativeTrunc));
AScope.Define('Ceil', TDataValue(NativeCeil));
AScope.Define('Floor', TDataValue(NativeFloor));
AScope.Define('Sign', TDataValue(NativeSign));
end;
initialization
// Register this library's functions with the central AST factory.
TAst.RegisterLibrary(RegisterRtlFunctions);
end.
Src/AST/Myc.Ast.Scope.pas
+49 -14
View File
@@ -36,11 +36,15 @@ type
FDescriptor: IScopeDescriptor;
FValues: TArray<TDataValue>;
FCapturedUpvalues: TArray<IValueCell>;
FNameToIndex: TDictionary<string, Integer>;
FNames: TDictionary<string, Integer>;
FNameStrings: TList<string>;
FNameToIndex: TDictionary<Integer, Integer>;
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
procedure NeedNameToIndex;
function GetNameID(const Name: String): Integer;
function GetParent: IExecutionScope;
function GetNameToIndex: TDictionary<string, Integer>;
function GetNameToIndex: TDictionary<Integer, Integer>;
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
public
@@ -50,7 +54,9 @@ type
function Dump: string;
procedure Define(const Name: string; const Value: TDataValue);
function Capture(const Address: TResolvedAddress): IValueCell;
property NameToIndex: TDictionary<string, Integer> read GetNameToIndex;
property Names: TDictionary<string, Integer> read FNames;
property NameStrings: TList<string> read FNameStrings;
property NameToIndex: TDictionary<Integer, Integer> read GetNameToIndex;
property Parent: IExecutionScope read FParent;
end;
@@ -88,9 +94,21 @@ begin
inherited Create;
FParent := AParent;
FDescriptor := ADescriptor;
FValues := [];
FCapturedUpvalues := ACapturedUpvalues; // Store upvalues
if FParent is TExecutionScope then
begin
FNames := (FParent as TExecutionScope).FNames;
FNameStrings := (FParent as TExecutionScope).FNameStrings;
end
else
begin
FNames := TDictionary<string, Integer>.Create;
FNameStrings := TList<string>.Create;
end;
if ADescriptor <> nil then
SetLength(FValues, ADescriptor.SlotCount);
end;
@@ -98,6 +116,11 @@ end;
destructor TExecutionScope.Destroy;
begin
Clear;
if not (FParent is TExecutionScope) then
begin
FNameStrings.Free;
FNames.Free;
end;
inherited Destroy;
end;
@@ -146,24 +169,27 @@ end;
procedure TExecutionScope.Define(const Name: string; const Value: TDataValue);
var
id: Integer;
index: Integer;
begin
NeedNameToIndex;
if FNameToIndex.ContainsKey(Name) then
id := GetNameID(Name);
if FNameToIndex.ContainsKey(id) then
raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
index := Length(FValues);
SetLength(FValues, index + 1);
FValues[index] := Value;
FNameToIndex.Add(Name, index);
FNameToIndex.Add(id, index);
end;
procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
var
pair: TPair<string, Integer>;
pair: TPair<Integer, Integer>;
indentStr: string;
sortedPairs: TArray<TPair<string, Integer>>;
sortedPairs: TArray<TPair<Integer, Integer>>;
begin
NeedNameToIndex;
@@ -171,15 +197,15 @@ begin
if FNameToIndex.Count > 0 then
begin
sortedPairs := FNameToIndex.ToArray;
TArray.Sort<TPair<string, Integer>>(
TArray.Sort<TPair<Integer, Integer>>(
sortedPairs,
TComparer<TPair<string, Integer>>
.Construct(function(const Left, Right: TPair<string, Integer>): Integer begin Result := Left.Value - Right.Value; end)
TComparer<TPair<Integer, Integer>>
.Construct(function(const Left, Right: TPair<Integer, Integer>): Integer begin Result := Left.Value - Right.Value; end)
);
for pair in sortedPairs do
// Access the value inside the cell for printing.
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].ToString]));
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, FNameStrings[pair.Key], FValues[pair.Value].ToString]));
end
else
begin
@@ -207,7 +233,7 @@ begin
end;
end;
function TExecutionScope.GetNameToIndex: TDictionary<string, Integer>;
function TExecutionScope.GetNameToIndex: TDictionary<Integer, Integer>;
begin
NeedNameToIndex;
Result := FNameToIndex;
@@ -244,15 +270,24 @@ begin
end;
end;
function TExecutionScope.GetNameID(const Name: String): Integer;
begin
if not FNames.TryGetValue(Name, Result) then
begin
Result := FNameStrings.Add(Name);
FNames.Add(Name, Result);
end;
end;
procedure TExecutionScope.NeedNameToIndex;
begin
if FNameToIndex = nil then
begin
FNameToIndex := TDictionary<string, Integer>.Create;
FNameToIndex := TDictionary<Integer, Integer>.Create;
if FDescriptor <> nil then
begin
for var item in FDescriptor.Symbols do
FNameToIndex.AddOrSetValue(item.Key, item.Value);
FNameToIndex.AddOrSetValue(GetNameId(item.Key), item.Value);
end;
end;
end;
Src/AST/Myc.Ast.pas
+36
View File
@@ -15,6 +15,16 @@ uses
type
// Record acting as a namespace for the factory functions.
TAst = record
public
type
TRegisterLibraryProc = reference to procedure(const Scope: IExecutionScope);
private
class var
FLibraries: TList<TRegisterLibraryProc>;
class constructor Create;
class destructor Destroy;
public
class procedure RegisterLibrary(const AProc: TRegisterLibraryProc); static;
class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static;
// --- Existing factory functions ---
@@ -659,6 +669,23 @@ begin
Result := FSeries;
end;
{ TAst }
class constructor TAst.Create;
begin
FLibraries := TList<TRegisterLibraryProc>.Create;
end;
class destructor TAst.Destroy;
begin
FLibraries.Free;
end;
class procedure TAst.RegisterLibrary(const AProc: TRegisterLibraryProc);
begin
FLibraries.Add(AProc);
end;
class function TAst.AddSeriesItem(const ASeries: IIdentifierNode; const AValue: IAstNode; const ALookback: IAstNode): IAddSeriesItemNode;
begin
Result := TAddSeriesItemNode.Create(ASeries, AValue, ALookback);
@@ -695,8 +722,17 @@ begin
end;
class function TAst.CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope;
var
proc: TRegisterLibraryProc;
begin
Result := TExecutionScope.Create(Parent, Descriptor, nil);
if Parent = nil then
begin
// When creating a root scope, automatically register all standard libraries.
for proc in FLibraries do
proc(Result);
end;
end;
class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: TArray<IAstNode>): IFunctionCallNode;
Src/Data/Myc.Data.Decimal.pas
+28 -9
View File
@@ -25,8 +25,8 @@ type
class operator LessThan(const A, B: TDecimal): Boolean; inline;
class operator LessThanOrEqual(const A, B: TDecimal): Boolean; inline;
class operator Negative(const A: TDecimal): TDecimal; inline;
class operator Round(const A: TDecimal): TDecimal;
class operator Trunc(const A: TDecimal): TDecimal;
class operator Round(const A: TDecimal): Int64;
class operator Trunc(const A: TDecimal): Int64;
class operator Implicit(const A: Int64): TDecimal; inline;
class operator Explicit(const A: TDecimal): Double;
@@ -34,6 +34,9 @@ type
class function MinValue(AScale: TScale): TDecimal; static;
class function MaxValue(AScale: TScale): TDecimal; static;
function Sign: Integer; inline;
function Abs: TDecimal; inline;
function GetValue: Int64;
function GetScale: TScale;
function GetRawValue: Int64; inline;
@@ -119,6 +122,14 @@ begin
FValue := (Int64(AScale) shl VALUE_BITS) or (intValue and RAW_VALUE_MASK);
end;
function TDecimal.Abs: TDecimal;
begin
if GetValue < 0 then
Result := -Self
else
Result := Self;
end;
class operator TDecimal.Add(const A, B: TDecimal): TDecimal;
begin
var aScale := A.GetScale;
@@ -302,24 +313,22 @@ begin
Result := TDecimal.Create(-A.GetValue, A.GetScale);
end;
class operator TDecimal.Round(const A: TDecimal): TDecimal;
class operator TDecimal.Round(const A: TDecimal): Int64;
var
value: Int64;
divisor: Int64;
begin
// Rounds to the nearest whole number (scale 0) using arithmetic rounding.
value := A.GetValue;
divisor := PowersOf10[A.GetScale];
if value >= 0 then
Result := TDecimal.Create((value + divisor div 2) div divisor, 0)
Result := (value + divisor div 2) div divisor
else
Result := TDecimal.Create((value - divisor div 2) div divisor, 0);
Result := (value - divisor div 2) div divisor;
end;
class operator TDecimal.Trunc(const A: TDecimal): TDecimal;
class operator TDecimal.Trunc(const A: TDecimal): Int64;
begin
// Truncates the fractional part, resulting in a decimal with scale 0
Result := TDecimal.Create(A.GetValue div PowersOf10[A.GetScale], 0);
Result := A.GetValue div PowersOf10[A.GetScale];
end;
class operator TDecimal.Implicit(const A: Int64): TDecimal;
@@ -365,4 +374,14 @@ begin
Result := FValue;
end;
function TDecimal.Sign: Integer;
begin
var val := GetValue;
if val < 0 then
exit(-1);
if val > 0 then
exit(-1);
exit(0);
end;
end.
Src/Data/Myc.Data.Scalar.pas
+154 -178
View File
@@ -173,70 +173,89 @@ type
FFields: TArray<TScalarValue>;
end;
// A time series of scalar values of the same kind.
TScalarSeries = record
private
FKind: TScalarKind;
FItems: TSeries<TScalarValue>;
public
// Creates a new scalar series.
constructor Create(AKind: TScalarKind; const AItems: TSeries<TScalarValue>);
property Kind: TScalarKind read FKind;
property Items: TSeries<TScalarValue> read FItems;
end;
TScalarMemberSeries = record
private
FArray: TChunkArray<TScalarValue>;
FElementIdx: Integer;
FKind: TScalarKind;
FElemCount: Integer;
ISeries = interface
{$region 'private'}
function GetCount: Int64;
function GetItems(Idx: Integer): TScalar;
public
constructor Create(AKind: TScalarKind; const AArray: TChunkArray<TScalarValue>; AElementIdx, AElemCount: Integer);
function GetKind: TScalarKind;
function GetTotalCount: Int64;
{$endregion}
property Count: Int64 read GetCount;
property Items[Idx: Integer]: TScalar read GetItems; default;
property Kind: TScalarKind read FKind;
property Kind: TScalarKind read GetKind;
property TotalCount: Int64 read GetTotalCount;
end;
// A time series of scalar tuples, optimized for memory and access speed.
TScalarTupleSeries = record
private
FDef: TArray<TScalarKind>;
FArray: TChunkArray<TScalarValue>;
FTotalCount: Int64;
function GetCount: Int64;
function GetItems(Idx: Integer): TScalarTuple;
public
constructor Create(const ADef: TArray<TScalarKind>);
procedure Add(const Item: TScalarTuple; Lookback: Int64 = -1);
function CreateMemberSeries(Idx: Integer): TScalarMemberSeries;
property Count: Int64 read GetCount;
property Def: TArray<TScalarKind> read FDef;
property Items[Idx: Integer]: TScalarTuple read GetItems; default;
property TotalCount: Int64 read FTotalCount;
IWriteableSeries = interface(ISeries)
procedure Add(const Item: TScalarValue; Lookback: Int64 = -1);
end;
// A time series of scalar records, optimized for memory and access speed.
TScalarRecordSeries = record
TScalarSeries = class(TInterfacedObject, ISeries, IWriteableSeries)
private
FKind: TScalarKind;
FArray: TChunkArray<TScalarValue>;
FTotalCount: Int64;
function GetKind: TScalarKind; inline;
function GetCount: Int64; inline;
function GetItems(Idx: Integer): TScalar; inline;
function GetTotalCount: Int64; inline;
public
constructor Create(AKind: TScalarKind);
procedure Add(const Item: TScalarValue; Lookback: Int64 = -1);
end;
IRecordSeries = interface
{$region 'private'}
function GetCount: Int64;
function GetDef: TScalarRecordDefinition;
function GetItems(Idx: Integer): TScalarRecord;
function GetTotalCount: Int64;
{$endregion}
procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1);
function CreateMemberSeries(const Field: String): ISeries;
property Count: Int64 read GetCount;
property Def: TScalarRecordDefinition read GetDef;
property Items[Idx: Integer]: TScalarRecord read GetItems; default;
property TotalCount: Int64 read GetTotalCount;
end;
// A time series of scalar records, optimized for memory and access speed.
TScalarRecordSeries = class(TInterfacedObject, IRecordSeries)
type
TMemberSeries = class(TInterfacedObject, ISeries)
private
FRecordSeries: TScalarRecordSeries;
FKind: TScalarKind;
FOffset: Integer;
function GetCount: Int64;
function GetItems(Idx: Integer): TScalar;
function GetKind: TScalarKind;
function GetTotalCount: Int64;
public
constructor Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
destructor Destroy; override;
end;
private
FDef: TScalarRecordDefinition;
FArray: TChunkArray<TScalarValue>;
FTotalCount: Int64;
function GetCount: Int64;
function GetCount: Int64; inline;
function GetDef: TScalarRecordDefinition; inline;
function GetItems(Idx: Integer): TScalarRecord;
function GetItems(Idx: Integer): TScalarRecord; inline;
function GetTotalCount: Int64; inline;
function GetItemRef(Idx: Integer): TChunkArray<TScalarValue>.PT; inline;
public
constructor Create(const ADef: TScalarRecordDefinition);
procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1);
function AsTupleSeries: TScalarTupleSeries;
function CreateMemberSeries(const Field: String): TScalarMemberSeries;
function CreateMemberSeries(const Field: String): ISeries;
property Count: Int64 read GetCount;
property Def: TScalarRecordDefinition read GetDef;
property Items[Idx: Integer]: TScalarRecord read GetItems; default;
property TotalCount: Int64 read FTotalCount;
property TotalCount: Int64 read GetTotalCount;
end;
TBinaryOperatorHelper = record helper for TBinaryOperator
@@ -1347,116 +1366,6 @@ begin
Result.Create(FDef.Fields[idx].Kind, FFields[idx]);
end;
{ TScalarSeries }
constructor TScalarSeries.Create(AKind: TScalarKind; const AItems: TSeries<TScalarValue>);
begin
FKind := AKind;
FItems := AItems;
end;
{ TScalarTupleSeries }
constructor TScalarTupleSeries.Create(const ADef: TArray<TScalarKind>);
begin
// Implements a time series of scalar tuples using a chunk array for efficient storage.
Assert(Length(ADef) > 0, 'Tuple definition cannot be empty.');
FDef := ADef;
FTotalCount := 0;
end;
procedure TScalarTupleSeries.Add(const Item: TScalarTuple; Lookback: Int64 = -1);
var
values: TArray<TScalarValue>;
i: Integer;
tupleSize: Integer;
maxCount: Integer;
begin
tupleSize := Length(FDef);
Assert(Length(Item) = tupleSize, 'Tuple does not match series definition.');
// Extract TScalarValue from TScalarTuple.
SetLength(values, tupleSize);
for i := 0 to tupleSize - 1 do
begin
Assert(Item[i].Kind = FDef[i], 'Tuple element kind mismatch.');
values[i] := Item[i].Value;
end;
if Lookback < 0 then
maxCount := -1
else
maxCount := tupleSize * Lookback;
FArray.Add(values, maxCount);
inc(FTotalCount);
end;
function TScalarTupleSeries.CreateMemberSeries(Idx: Integer): TScalarMemberSeries;
var
tupleSize: Integer;
begin
tupleSize := Length(FDef);
if (Idx < 0) or (Idx >= tupleSize) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for a tuple of size %d.', [Idx, tupleSize]);
// Creates a series view for a specific member of the tuple.
Result := TScalarMemberSeries.Create(FDef[Idx], FArray, Idx, tupleSize);
end;
function TScalarTupleSeries.GetCount: Int64;
begin
if Length(FDef) = 0 then
exit(0);
Result := FArray.Count div Length(FDef);
end;
function TScalarTupleSeries.GetItems(Idx: Integer): TScalarTuple;
var
values: TArray<TScalarValue>;
tupleSize, i: Integer;
begin
tupleSize := Length(FDef);
Assert(tupleSize > 0);
Assert((Idx >= 0) and (Idx < (FArray.Count div tupleSize)));
// Create a temporary array to hold the values for one tuple.
SetLength(values, tupleSize);
// Copy the tuple data from the chunk array (latest item is at the end).
Move(FArray.ItemRef[(FArray.Count - tupleSize) - (Idx * tupleSize)]^, values[0], sizeof(TScalarValue) * tupleSize);
// Reconstruct the TScalarTuple from the values and the definition.
SetLength(Result, tupleSize);
for i := 0 to tupleSize - 1 do
Result[i] := TScalar.Create(FDef[i], values[i]);
end;
{ TScalarMemberSeries }
constructor TScalarMemberSeries.Create(AKind: TScalarKind; const AArray: TChunkArray<TScalarValue>; AElementIdx, AElemCount: Integer);
begin
Assert(AArray.Count mod AElemCount = 0);
Assert(AElementIdx >= 0);
Assert(AElementIdx < AElemCount);
FKind := AKind;
FArray := AArray;
FElementIdx := AElementIdx;
FElemCount := AElemCount;
end;
function TScalarMemberSeries.GetCount: Int64;
begin
if FElemCount = 0 then
exit(0);
Result := FArray.Count div FElemCount;
end;
function TScalarMemberSeries.GetItems(Idx: Integer): TScalar;
begin
Result.Create(FKind, FArray.Items[(FArray.Count - FElemCount) - (Idx * FElemCount) + FElementIdx]);
end;
{ TScalarRecordDefinition }
constructor TScalarRecordDefinition.Create(const AFields: TArray<TScalarRecordField>);
@@ -1494,31 +1403,13 @@ begin
inc(FTotalCount);
end;
function TScalarRecordSeries.AsTupleSeries: TScalarTupleSeries;
var
tupleDef: TArray<TScalarKind>;
i: Integer;
begin
// Extract the kinds from the record definition to create a tuple definition.
SetLength(tupleDef, Length(FDef.Fields));
for i := 0 to High(FDef.Fields) do
tupleDef[i] := FDef.Fields[i].Kind;
// Create the tuple series with the new definition.
Result := TScalarTupleSeries.Create(tupleDef);
// The underlying data is compatible, so we can share it.
Result.FArray := FArray;
Result.FTotalCount := FTotalCount;
end;
function TScalarRecordSeries.CreateMemberSeries(const Field: String): TScalarMemberSeries;
function TScalarRecordSeries.CreateMemberSeries(const Field: String): ISeries;
begin
var elem := FDef.IndexOf(Field);
if elem < 0 then
raise EArgumentException.CreateFmt('Field "%s" not found in record definition.', [Field]);
Result := TScalarMemberSeries.Create(FDef.Fields[elem].Kind, FArray, elem, Length(FDef.Fields));
Result := TMemberSeries.Create(Self, elem);
end;
function TScalarRecordSeries.GetCount: Int64;
@@ -1531,17 +1422,26 @@ begin
Result := FDef;
end;
function TScalarRecordSeries.GetItemRef(Idx: Integer): TChunkArray<TScalarValue>.PT;
begin
var len := Length(FDef.Fields);
Result := FArray.ItemRef[(FArray.Count - len) - (Idx * len)];
end;
function TScalarRecordSeries.GetItems(Idx: Integer): TScalarRecord;
var
values: TArray<TScalarValue>;
fieldCount: Integer;
begin
fieldCount := Length(FDef.Fields);
SetLength(values, fieldCount);
Move(FArray.ItemRef[(FArray.Count - fieldCount) - (Idx * fieldCount)]^, values[0], sizeof(TScalarValue) * fieldCount);
SetLength(values, Length(FDef.Fields));
Move(GetItemRef(Idx)^, values[0], sizeof(TScalarValue) * Length(values));
Result.Create(FDef, values);
end;
function TScalarRecordSeries.GetTotalCount: Int64;
begin
Result := FTotalCount;
end;
function TScalarKindHelper.ToString: string;
begin
case Self of
@@ -1595,6 +1495,82 @@ begin
end;
end;
constructor TScalarRecordSeries.TMemberSeries.Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
begin
inherited Create;
FRecordSeries := ARecordSeries;
FRecordSeries._AddRef;
FKind := FRecordSeries.FDef.FFields[AElementIdx].Kind;
FOffset := sizeof(TScalarValue) * AElementIdx;
end;
destructor TScalarRecordSeries.TMemberSeries.Destroy;
begin
FRecordSeries._Release;
inherited;
end;
function TScalarRecordSeries.TMemberSeries.GetCount: Int64;
begin
Result := FRecordSeries.Count;
end;
function TScalarRecordSeries.TMemberSeries.GetItems(Idx: Integer): TScalar;
var
P: TChunkArray<TScalarValue>.PT;
begin
P := FRecordSeries.GetItemRef(Idx);
inc(PByte(P), FOffset);
Result.Create(FKind, P^);
end;
function TScalarRecordSeries.TMemberSeries.GetKind: TScalarKind;
begin
Result := FKind;
end;
function TScalarRecordSeries.TMemberSeries.GetTotalCount: Int64;
begin
Result := FRecordSeries.TotalCount;
end;
{ TScalarSeries }
// Implements a time series of scalar records using a chunk array for efficient storage.
// Each record's fields are stored sequentially in the TChunkArray.
constructor TScalarSeries.Create(AKind: TScalarKind);
begin
FKind := AKind;
FTotalCount := 0;
end;
procedure TScalarSeries.Add(const Item: TScalarValue; Lookback: Int64 = -1);
begin
FArray.Add(Item, Lookback);
inc(FTotalCount);
end;
function TScalarSeries.GetCount: Int64;
begin
Result := FArray.Count;
end;
function TScalarSeries.GetItems(Idx: Integer): TScalar;
begin
Result.Create(FKind, FArray[FArray.Count - Idx - 1]);
end;
function TScalarSeries.GetKind: TScalarKind;
begin
Result := FKind;
end;
function TScalarSeries.GetTotalCount: Int64;
begin
Result := FTotalCount;
end;
initialization
Assert(sizeof(TScalarValue) = 8);
Src/Data/Myc.Data.Value.pas
+250 -91
View File
@@ -8,25 +8,48 @@ uses
Myc.Data.Series;
type
TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric, vkMethod);
TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkMethod, vkGeneric);
TDataValue = record
public
type
TVal<T> = class(TInterfacedObject)
Value: T;
constructor Create(const AValue: T);
end;
TFunc = reference to function(const ArgNodes: TArray<TDataValue>): TDataValue;
private
type
IVal = interface
{$ifdef DEBUG}
function GetTypeHandle: Pointer;
{$endif}
end;
TVal<T> = class(TInterfacedObject, IVal)
Value: T;
{$ifdef DEBUG}
TypeHandle: Pointer;
function GetTypeHandle: Pointer;
{$endif}
constructor Create(const AValue: T);
end;
ILazy = interface
function GetKind: TDataValueKind;
function GetValue: TDataValue;
property Kind: TDataValueKind read GetKind;
property Value: TDataValue read GetValue;
end;
TInternalKind = (vkLazy = Ord(High(TDataValueKind)) + 1);
TInternalKindOrdinal = 0..Ord(High(TInternalKind));
var
FKind: TDataValueKind;
FKind: TInternalKindOrdinal;
FScalar: TScalar;
FInterface: IInterface;
function AsLazy: ILazy; inline;
function GetKind: TDataValueKind; inline;
function GetIsVoid: Boolean; inline;
public
class operator Initialize(out Dest: TDataValue);
class function Void: TDataValue; inline; static;
@@ -35,178 +58,292 @@ type
class operator Implicit(const AValue: String): TDataValue; overload; inline;
class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
class function From<T: record>(const [ref] AValue: T): TDataValue; static; inline;
function AsVal<T: record>: TVal<T>; inline;
class function FromGeneric<T>(const [ref] AValue: T): TDataValue; static; inline;
function AsGeneric<T>: T; inline;
class function FromSeries(const [ref] AValue: TScalarSeries): TDataValue; static; inline;
class function FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue; static; inline;
class function Defer(const Value: TDataValue; const Calc: TFunc): TDataValue; overload; static;
class function FromSeries(const AValue: IWriteableSeries): TDataValue; static; inline;
class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline;
class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline;
class function FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue; static; inline;
class function FromInterface(const [ref] AValue: IInterface): TDataValue; static; inline;
class function FromMemberSeries(const AValue: ISeries): TDataValue; static; inline;
function AsScalar: TScalar; inline;
function AsInterface: IInterface; inline;
function AsMethod: TFunc; 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 AsRecordSeries: IRecordSeries; inline;
function AsRecord: TScalarRecord; inline;
function AsMemberSeries: ISeries; inline;
function AsSeries: IWriteableSeries; inline;
function ToString: String;
property IsVoid: Boolean read GetIsVoid;
property Kind: TDataValueKind read GetKind;
end;
type
TDataValueKindHelper = record helper for TDataValueKind
public
function ToString: string;
end;
implementation
uses
TypInfo;
type
TManagedLazy = class(TInterfacedObject, TDataValue.ILazy)
private
FKind: TDataValueKind;
FVal: IInterface;
FCalc: TDataValue.TFunc;
function GetValue: TDataValue;
function GetKind: TDataValueKind;
public
constructor Create(AKind: TDataValueKind; const AVal: IInterface; const ACalc: TDataValue.TFunc);
end;
TScalarLazy = class(TInterfacedObject, TDataValue.ILazy)
private
FVal: TScalar;
FCalc: TDataValue.TFunc;
function GetKind: TDataValueKind;
function GetValue: TDataValue;
public
constructor Create(const AVal: TScalar; const ACalc: TDataValue.TFunc);
end;
constructor TManagedLazy.Create(AKind: TDataValueKind; const AVal: IInterface; const ACalc: TDataValue.TFunc);
begin
inherited Create;
FKind := AKind;
Assert(FKind <> vkVoid);
FVal := AVal;
FCalc := ACalc;
end;
function TManagedLazy.GetKind: TDataValueKind;
begin
Result := FKind;
end;
function TManagedLazy.GetValue: TDataValue;
var
dv: TDataValue;
begin
dv.FKind := Ord(FKind);
dv.FInterface := FVal;
Result := FCalc([dv]);
end;
constructor TScalarLazy.Create(const AVal: TScalar; const ACalc: TDataValue.TFunc);
begin
inherited Create;
FVal := AVal;
FCalc := ACalc;
end;
function TScalarLazy.GetKind: TDataValueKind;
begin
Result := vkScalar;
end;
function TScalarLazy.GetValue: TDataValue;
begin
Result := FCalc([FVal]);
end;
{ TDataValue.TVal<T> }
constructor TDataValue.TVal<T>.Create(const AValue: T);
begin
inherited Create;
Value := AValue;
{$ifdef DEBUG}
TypeHandle := TypeInfo(T);
{$endif}
end;
{$ifdef DEBUG}
function TDataValue.TVal<T>.GetTypeHandle: Pointer;
begin
Result := TypeHandle;
end;
{$endif}
function TDataValue.AsLazy: ILazy;
begin
Assert(FKind = Ord(vkLazy));
Result := ILazy(FInterface);
end;
{ TDataValue }
class operator TDataValue.Initialize(out Dest: TDataValue);
begin
Dest.FKind := vkVoid;
Dest.FKind := Ord(vkVoid);
Dest.FInterface := nil;
end;
function TDataValue.AsInterface: IInterface;
function TDataValue.AsMemberSeries: ISeries;
begin
if (FKind <> vkInterface) then
raise EInvalidCast.Create('Cannot read value as an Interface.');
Result := FInterface;
end;
function TDataValue.AsMemberSeries: TVal<TScalarMemberSeries>;
begin
if (FKind <> vkMemberSeries) then
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsMemberSeries);
if (FKind <> Ord(vkMemberSeries)) then
raise EInvalidCast.Create('Cannot read value as MemberSeries.');
Result := TVal<TScalarMemberSeries>(FInterface);
Result := ISeries(FInterface);
end;
function TDataValue.AsMethod: TFunc;
begin
if (FKind <> vkMethod) then
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsMethod);
if (FKind <> Ord(vkMethod)) then
raise EInvalidCast.Create('Cannot read value as a method.');
Result := TFunc(FInterface);
end;
function TDataValue.AsVal<T>: TVal<T>;
function TDataValue.AsGeneric<T>: T;
begin
if (FKind <> vkGeneric) then
raise EInvalidCast.Create('Cannot read value as ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
Result := TVal<T>(FInterface);
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsGeneric<T>);
if FKind <> Ord(vkGeneric) then
raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$ifdef DEBUG}
if TVal<T>(FInterface).TypeHandle <> TypeInfo(T) then
raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$endif}
Result := TVal<T>(FInterface).Value;
end;
function TDataValue.AsRecord: TVal<TScalarRecord>;
function TDataValue.AsRecord: TScalarRecord;
begin
if (FKind <> vkRecord) then
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsRecord);
if (FKind <> Ord(vkRecord)) then
raise EInvalidCast.Create('Cannot read value as Record.');
Result := (FInterface as TVal<TScalarRecord>);
Result := (FInterface as TVal<TScalarRecord>).Value;
end;
function TDataValue.AsRecordSeries: TVal<TScalarRecordSeries>;
function TDataValue.AsRecordSeries: IRecordSeries;
begin
if (FKind <> vkRecordSeries) then
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsRecordSeries);
if (FKind <> Ord(vkRecordSeries)) then
raise EInvalidCast.Create('Cannot read value as RecordSeries.');
Result := TVal<TScalarRecordSeries>(FInterface);
Result := IRecordSeries(FInterface);
end;
function TDataValue.AsScalar: TScalar;
begin
if (FKind <> vkScalar) then
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsScalar);
if (FKind <> Ord(vkScalar)) then
raise EInvalidCast.Create('Cannot read value as a Scalar.');
Result := FScalar;
end;
function TDataValue.AsSeries: TVal<TScalarSeries>;
function TDataValue.AsSeries: IWriteableSeries;
begin
if (FKind <> vkSeries) then
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsSeries);
if (FKind <> Ord(vkSeries)) then
raise EInvalidCast.Create('Cannot read value as Series.');
Result := TVal<TScalarSeries>(FInterface);
Result := IWriteableSeries(FInterface);
end;
function TDataValue.AsText: String;
begin
if (FKind <> vkText) then
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsText);
if (FKind <> Ord(vkText)) then
raise EInvalidCast.Create('Cannot read value as Text.');
Result := (FInterface as TVal<String>).Value;
end;
class function TDataValue.From<T>(const [ref] AValue: T): TDataValue;
class function TDataValue.Defer(const Value: TDataValue; const Calc: TFunc): TDataValue;
begin
Result.FKind := vkGeneric;
Result.FKind := Ord(vkLazy);
case Value.FKind of
Ord(vkScalar): Result.FInterface := TScalarLazy.Create(Value.AsScalar, Calc);
Ord(vkLazy):
begin
// Create a new lazy object that wraps the existing one, passing the original
// kind and the inner lazy interface.
var cCalc: TFunc := Calc;
Result.FInterface :=
TManagedLazy.Create(
Value.AsLazy.Kind,
Value.FInterface,
function(const ArgNodes: TArray<TDataValue>): TDataValue
begin
// Chain lazy computations. The new calculation function will first evaluate
// the inner lazy value and then pass the result to the new calculation.
// The reconstructed TDataValue in ArgNodes[0] contains the inner ILazy interface.
Assert(Length(ArgNodes) = 1, 'Expected 1 argument in lazy computation chain');
Result := cCalc([ILazy(ArgNodes[0].FInterface).Value]);
end
);
end;
else
Result.FInterface := TManagedLazy.Create(Value.Kind, Value.FInterface, Calc);
end;
end;
class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
Result.FKind := Ord(vkGeneric);
Result.FInterface := TVal<T>.Create(AValue);
end;
class function TDataValue.FromInterface(const [ref] AValue: IInterface): TDataValue;
class function TDataValue.FromMemberSeries(const AValue: ISeries): TDataValue;
begin
Result.FKind := vkInterface;
Result.FKind := Ord(vkMemberSeries);
Result.FInterface := AValue;
end;
class function TDataValue.FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue;
begin
Result.FKind := vkMemberSeries;
Result.FInterface := TVal<TScalarMemberSeries>.Create(AValue);
end;
class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue;
begin
Result.FKind := vkRecord;
Result.FKind := Ord(vkRecord);
Result.FInterface := TVal<TScalarRecord>.Create(AValue);
end;
class function TDataValue.FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue;
class function TDataValue.FromRecordSeries(const AValue: IRecordSeries): TDataValue;
begin
Result.FKind := vkRecordSeries;
Result.FInterface := TVal<TScalarRecordSeries>.Create(AValue);
Result.FKind := Ord(vkRecordSeries);
Result.FInterface := AValue;
end;
class function TDataValue.FromSeries(const [ref] AValue: TScalarSeries): TDataValue;
class function TDataValue.FromSeries(const AValue: IWriteableSeries): TDataValue;
begin
Result.FKind := vkSeries;
Result.FInterface := TVal<TScalarSeries>.Create(AValue);
Result.FKind := Ord(vkSeries);
Result.FInterface := AValue;
end;
class operator TDataValue.Implicit(const AValue: TScalar): TDataValue;
begin
Result.FKind := vkScalar;
Result.FKind := Ord(vkScalar);
Result.FScalar := AValue;
Result.FInterface := nil;
end;
class operator TDataValue.Implicit(const AValue: String): TDataValue;
begin
Result.FKind := vkText;
Result.FKind := Ord(vkText);
Result.FInterface := TVal<String>.Create(AValue);
end;
function TDataValue.GetIsVoid: Boolean;
begin
Result := FKind = vkVoid;
Result := FKind = Ord(vkVoid);
end;
function TDataValue.GetKind: TDataValueKind;
begin
Result := FKind;
end;
procedure TDataValue.SetVoid;
begin
FKind := vkVoid;
FInterface := nil;
if FKind = Ord(vkLazy) then
exit(AsLazy.Kind);
Result := TDataValueKind(FKind);
end;
function TDataValue.ToString: String;
@@ -216,18 +353,17 @@ var
first: Boolean;
begin
case FKind of
vkScalar: Result := FScalar.ToString;
vkInterface: Result := '<interface>';
vkText: Result := '"' + AsText + '"';
vkSeries:
Ord(vkScalar): Result := FScalar.ToString;
Ord(vkText): Result := '"' + AsText + '"';
Ord(vkSeries):
begin
var series := AsSeries.Value;
var series := AsSeries;
// Add type and count for series
Result := Format('<series<%s>[%d]>', [series.Kind.ToString, series.Items.Count]);
Result := Format('<series<%s>[%d]>', [series.Kind.ToString, series.Count]);
end;
vkRecordSeries:
Ord(vkRecordSeries):
begin
var series := AsRecordSeries.Value;
var series := AsRecordSeries;
sb := TStringBuilder.Create;
try
sb.Append('{');
@@ -246,9 +382,9 @@ begin
sb.Free;
end;
end;
vkRecord:
Ord(vkRecord):
begin
var rec := AsRecord.Value;
var rec := AsRecord;
sb := TStringBuilder.Create;
try
sb.Append('{');
@@ -267,18 +403,23 @@ begin
sb.Free;
end;
end;
vkMemberSeries:
Ord(vkMemberSeries):
begin
var series := AsMemberSeries.Value;
var series := AsMemberSeries;
// Add type and count for member series
Result := Format('<member_series<%s>[%d]>', [series.Kind.ToString, series.Count]);
end;
vkVoid: Result := '<void>';
vkMethod: Result := '<method>';
vkGeneric:
Ord(vkVoid): Result := '<void>';
Ord(vkMethod): Result := '<method>';
Ord(vkGeneric):
// Getting meaningful type information for vkGeneric is not easily possible
// without storing additional RTTI, as the specific type of T in TVal<T> is lost.
{$ifdef DEBUG}
Result := '<' + String(PTypeInfo(TDataValue.IVal(FInterface).GetTypeHandle).Name) + '>';
{$else}
Result := '<generic>';
{$endif}
Ord(vkLazy): Result := Format('<lazy[%s]>', [AsLazy.Kind.ToString]);
else
Result := '[Unknown DataValue]';
end;
@@ -291,8 +432,26 @@ end;
class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue;
begin
Result.FKind := vkMethod;
Result.FKind := Ord(vkMethod);
TFunc(Result.FInterface) := AValue;
end;
{ TDataValueKindHelper }
function TDataValueKindHelper.ToString: string;
begin
case Self of
vkVoid: Result := 'Void';
vkScalar: Result := 'Scalar';
vkText: Result := 'Text';
vkSeries: Result := 'Series';
vkRecordSeries: Result := 'RecordSeries';
vkRecord: Result := 'Record';
vkMemberSeries: Result := 'MemberSeries';
vkMethod: Result := 'Method';
else
Result := 'unknown';
end;
end;
end.