diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr
index ebedc40..6b9472e 100644
--- a/ASTPlayground/ASTPlayground.dpr
+++ b/ASTPlayground/ASTPlayground.dpr
@@ -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}
diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj
index 91a3108..733318a 100644
--- a/ASTPlayground/ASTPlayground.dproj
+++ b/ASTPlayground/ASTPlayground.dproj
@@ -4,7 +4,7 @@
20.3
FMX
True
- Debug
+ Release
Win64
ASTPlayground
2
@@ -148,6 +148,7 @@
+
Base
diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas
index 894de89..387e503 100644
--- a/ASTPlayground/MainForm.pas
+++ b/ASTPlayground/MainForm.pas
@@ -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);
diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas
index 12da01a..0bc09fb 100644
--- a/Src/AST/Myc.Ast.Binding.pas
+++ b/Src/AST/Myc.Ast.Binding.pas
@@ -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;
diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas
index f0c79c1..751745d 100644
--- a/Src/AST/Myc.Ast.Evaluator.pas
+++ b/Src/AST/Myc.Ast.Evaluator.pas
@@ -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));
+ 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;
diff --git a/Src/AST/Myc.Ast.RTL.pas b/Src/AST/Myc.Ast.RTL.pas
new file mode 100644
index 0000000..1f60f6c
--- /dev/null
+++ b/Src/AST/Myc.Ast.RTL.pas
@@ -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; 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;
+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;
+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;
+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;
+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;
+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.
diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas
index fdd5f46..ceafa01 100644
--- a/Src/AST/Myc.Ast.Scope.pas
+++ b/Src/AST/Myc.Ast.Scope.pas
@@ -36,11 +36,15 @@ type
FDescriptor: IScopeDescriptor;
FValues: TArray;
FCapturedUpvalues: TArray;
- FNameToIndex: TDictionary;
+ FNames: TDictionary;
+ FNameStrings: TList;
+ FNameToIndex: TDictionary;
+
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
procedure NeedNameToIndex;
+ function GetNameID(const Name: String): Integer;
function GetParent: IExecutionScope;
- function GetNameToIndex: TDictionary;
+ function GetNameToIndex: TDictionary;
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 read GetNameToIndex;
+ property Names: TDictionary read FNames;
+ property NameStrings: TList read FNameStrings;
+ property NameToIndex: TDictionary 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.Create;
+ FNameStrings := TList.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;
+ pair: TPair;
indentStr: string;
- sortedPairs: TArray>;
+ sortedPairs: TArray>;
begin
NeedNameToIndex;
@@ -171,15 +197,15 @@ begin
if FNameToIndex.Count > 0 then
begin
sortedPairs := FNameToIndex.ToArray;
- TArray.Sort>(
+ TArray.Sort>(
sortedPairs,
- TComparer>
- .Construct(function(const Left, Right: TPair): Integer begin Result := Left.Value - Right.Value; end)
+ TComparer>
+ .Construct(function(const Left, Right: TPair): 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;
+function TExecutionScope.GetNameToIndex: TDictionary;
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.Create;
+ FNameToIndex := TDictionary.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;
diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas
index d2dc0fb..4738c85 100644
--- a/Src/AST/Myc.Ast.pas
+++ b/Src/AST/Myc.Ast.pas
@@ -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;
+ 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.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): IFunctionCallNode;
diff --git a/Src/Data/Myc.Data.Decimal.pas b/Src/Data/Myc.Data.Decimal.pas
index 8b8b9b5..a355506 100644
--- a/Src/Data/Myc.Data.Decimal.pas
+++ b/Src/Data/Myc.Data.Decimal.pas
@@ -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.
diff --git a/Src/Data/Myc.Data.Scalar.pas b/Src/Data/Myc.Data.Scalar.pas
index e905a6b..ebb0ec9 100644
--- a/Src/Data/Myc.Data.Scalar.pas
+++ b/Src/Data/Myc.Data.Scalar.pas
@@ -173,70 +173,89 @@ type
FFields: TArray;
end;
- // A time series of scalar values of the same kind.
- TScalarSeries = record
- private
- FKind: TScalarKind;
- FItems: TSeries;
- public
- // Creates a new scalar series.
- constructor Create(AKind: TScalarKind; const AItems: TSeries);
-
- property Kind: TScalarKind read FKind;
- property Items: TSeries read FItems;
- end;
-
- TScalarMemberSeries = record
- private
- FArray: TChunkArray;
- 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; 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;
- FArray: TChunkArray;
- FTotalCount: Int64;
- function GetCount: Int64;
- function GetItems(Idx: Integer): TScalarTuple;
- public
- constructor Create(const ADef: TArray);
- procedure Add(const Item: TScalarTuple; Lookback: Int64 = -1);
- function CreateMemberSeries(Idx: Integer): TScalarMemberSeries;
- property Count: Int64 read GetCount;
- property Def: TArray 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;
+ 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;
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.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);
-begin
- FKind := AKind;
- FItems := AItems;
-end;
-
-{ TScalarTupleSeries }
-
-constructor TScalarTupleSeries.Create(const ADef: TArray);
-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;
- 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;
- 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; 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);
@@ -1494,31 +1403,13 @@ begin
inc(FTotalCount);
end;
-function TScalarRecordSeries.AsTupleSeries: TScalarTupleSeries;
-var
- tupleDef: TArray;
- 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.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;
- 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.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);
diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas
index 0c986a7..3f1a8bc 100644
--- a/Src/Data/Myc.Data.Value.pas
+++ b/Src/Data/Myc.Data.Value.pas
@@ -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 = class(TInterfacedObject)
- Value: T;
- constructor Create(const AValue: T);
- end;
-
TFunc = reference to function(const ArgNodes: TArray): TDataValue;
private
+ type
+ IVal = interface
+{$ifdef DEBUG}
+ function GetTypeHandle: Pointer;
+{$endif}
+ end;
+
+ TVal = 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(const [ref] AValue: T): TDataValue; static; inline;
- function AsVal: TVal; inline;
+ class function FromGeneric(const [ref] AValue: T): TDataValue; static; inline;
+ function AsGeneric: 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; inline;
- function AsRecord: TVal; inline;
- function AsMemberSeries: TVal; inline;
- function AsSeries: TVal; 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 }
constructor TDataValue.TVal.Create(const AValue: T);
begin
inherited Create;
Value := AValue;
+{$ifdef DEBUG}
+ TypeHandle := TypeInfo(T);
+{$endif}
+end;
+
+{$ifdef DEBUG}
+function TDataValue.TVal.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;
-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(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: TVal;
+function TDataValue.AsGeneric: T;
begin
- if (FKind <> vkGeneric) then
- raise EInvalidCast.Create('Cannot read value as ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
- Result := TVal(FInterface);
+ if FKind = Ord(vkLazy) then
+ exit(AsLazy.Value.AsGeneric);
+ if FKind <> Ord(vkGeneric) then
+ raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
+{$ifdef DEBUG}
+ if TVal(FInterface).TypeHandle <> TypeInfo(T) then
+ raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
+{$endif}
+ Result := TVal(FInterface).Value;
end;
-function TDataValue.AsRecord: TVal;
+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);
+ Result := (FInterface as TVal).Value;
end;
-function TDataValue.AsRecordSeries: TVal;
+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(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;
+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(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).Value;
end;
-class function TDataValue.From(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
+ 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(const [ref] AValue: T): TDataValue;
+begin
+ Result.FKind := Ord(vkGeneric);
Result.FInterface := TVal.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.Create(AValue);
-end;
-
class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue;
begin
- Result.FKind := vkRecord;
+ Result.FKind := Ord(vkRecord);
Result.FInterface := TVal.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.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.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.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 := '';
- 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('[%d]>', [series.Kind.ToString, series.Items.Count]);
+ Result := Format('[%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('[%d]>', [series.Kind.ToString, series.Count]);
end;
- vkVoid: Result := '';
- vkMethod: Result := '';
- vkGeneric:
+ Ord(vkVoid): Result := '';
+ Ord(vkMethod): Result := '';
+ Ord(vkGeneric):
// Getting meaningful type information for vkGeneric is not easily possible
// without storing additional RTTI, as the specific type of T in TVal is lost.
+{$ifdef DEBUG}
+ Result := '<' + String(PTypeInfo(TDataValue.IVal(FInterface).GetTypeHandle).Name) + '>';
+{$else}
Result := '';
+{$endif}
+ Ord(vkLazy): Result := Format('', [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.