From 2c55a120f1b898ed6fd59060229eb35b6a439155 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Thu, 18 Sep 2025 13:35:25 +0200 Subject: [PATCH] RTL and Data value refactoring and defered values --- ASTPlayground/ASTPlayground.dpr | 3 +- ASTPlayground/ASTPlayground.dproj | 3 +- ASTPlayground/MainForm.pas | 155 +++++++++----- Src/AST/Myc.Ast.Binding.pas | 7 +- Src/AST/Myc.Ast.Evaluator.pas | 38 ++-- Src/AST/Myc.Ast.RTL.pas | 133 ++++++++++++ Src/AST/Myc.Ast.Scope.pas | 63 ++++-- Src/AST/Myc.Ast.pas | 36 ++++ Src/Data/Myc.Data.Decimal.pas | 37 +++- Src/Data/Myc.Data.Scalar.pas | 332 ++++++++++++++--------------- Src/Data/Myc.Data.Value.pas | 341 ++++++++++++++++++++++-------- 11 files changed, 783 insertions(+), 365 deletions(-) create mode 100644 Src/AST/Myc.Ast.RTL.pas 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.