From 00f58611488237bdb3862176bf17b07ee3ba2edd Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 20 Sep 2025 18:30:32 +0200 Subject: [PATCH] Global data value refactoring + 1st scripting version --- ASTPlayground/ASTPlayground.dpr | 4 +- ASTPlayground/ASTPlayground.dproj | 2 +- ASTPlayground/MainForm.fmx | 46 +- ASTPlayground/MainForm.pas | 340 ++++--- Src/AST/Myc.Ast.Evaluator.pas | 26 +- Src/AST/Myc.Ast.JSON.pas | 90 +- Src/AST/Myc.Ast.Nodes.pas | 13 +- Src/AST/Myc.Ast.Persistence.pas | 1110 ----------------------- Src/AST/Myc.Ast.Printer.pas | 201 +++-- Src/AST/Myc.Ast.RTL.Core.pas | 56 +- Src/AST/Myc.Ast.RTL.pas | 5 +- Src/AST/Myc.Ast.Script.pas | 699 +++++++++++++++ Src/AST/Myc.Ast.ViewModel.pas | 102 --- Src/AST/Myc.Ast.pas | 57 +- Src/Data/Myc.Data.Scalar.JSON.pas | 49 +- Src/Data/Myc.Data.Scalar.pas | 1366 +++++------------------------ Src/Data/Myc.Data.Value.pas | 6 + 17 files changed, 1430 insertions(+), 2742 deletions(-) delete mode 100644 Src/AST/Myc.Ast.Persistence.pas create mode 100644 Src/AST/Myc.Ast.Script.pas delete mode 100644 Src/AST/Myc.Ast.ViewModel.pas diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index 839ece8..e71782c 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -9,7 +9,6 @@ uses Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas', Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas', Myc.Fmx.AstEditor in 'Myc.Fmx.AstEditor.pas', - Myc.Ast.ViewModel in '..\Src\AST\Myc.Ast.ViewModel.pas', Myc.Data.Value in 'Myc.Data.Value.pas', Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas', Myc.Ast.Traverser in '..\Src\AST\Myc.Ast.Traverser.pas', @@ -20,7 +19,8 @@ uses Myc.Fmx.AstEditor.Node in 'Myc.Fmx.AstEditor.Node.pas', Myc.Fmx.AstEditor.Workspace in 'Myc.Fmx.AstEditor.Workspace.pas', Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas', - Myc.Utils in '..\Src\Myc.Utils.pas'; + Myc.Utils in '..\Src\Myc.Utils.pas', + Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas'; {$R *.res} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index a8ed000..a77672b 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -140,7 +140,6 @@ - @@ -152,6 +151,7 @@ + Base diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index 90e36cc..c1affd9 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -3,7 +3,7 @@ object Form1: TForm1 Top = 0 Caption = 'Form1' ClientHeight = 883 - ClientWidth = 925 + ClientWidth = 1394 FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] @@ -103,7 +103,7 @@ object Form1: TForm1 Position.Y = 8.000000000000000000 TabOrder = 11 Text = 'Flow only' - OnChange = ClearButtonClick + OnChange = FlowOnlyBoxChange end object SeriesTestButton: TButton Position.X = 24.000000000000000000 @@ -189,8 +189,8 @@ object Form1: TForm1 end object Panel2: TPanel Align = Client - Size.Width = 796.000000000000000000 - Size.Height = 616.000000000000000000 + Size.Width = 784.000000000000000000 + Size.Height = 609.000000000000000000 Size.PlatformDefault = False TabOrder = 3 end @@ -202,11 +202,45 @@ object Form1: TForm1 Align = Bottom Position.X = 129.000000000000000000 Position.Y = 616.000000000000000000 - Size.Width = 796.000000000000000000 + Size.Width = 1265.000000000000000000 Size.Height = 267.000000000000000000 Size.PlatformDefault = False TabOrder = 2 - Viewport.Width = 792.000000000000000000 + Viewport.Width = 1261.000000000000000000 Viewport.Height = 263.000000000000000000 end + object Splitter1: TSplitter + Align = Bottom + Cursor = crVSplit + MinSize = 20.000000000000000000 + Position.X = 129.000000000000000000 + Position.Y = 609.000000000000000000 + Size.Width = 1265.000000000000000000 + Size.Height = 7.000000000000000000 + Size.PlatformDefault = False + end + object Splitter2: TSplitter + Align = Right + Cursor = crHSplit + MinSize = 20.000000000000000000 + Position.X = 913.000000000000000000 + Size.Width = 7.000000000000000000 + Size.Height = 609.000000000000000000 + Size.PlatformDefault = False + end + object ScriptMemo: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + StyledSettings = [Size, Style, FontColor] + TextSettings.Font.Family = 'Consolas' + OnChangeTracking = ScriptMemoChange + Align = Right + Position.X = 920.000000000000000000 + Size.Width = 474.000000000000000000 + Size.Height = 609.000000000000000000 + Size.PlatformDefault = False + TabOrder = 6 + Viewport.Width = 470.000000000000000000 + Viewport.Height = 605.000000000000000000 + end end diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index adfcc17..0cc3bfa 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -31,6 +31,7 @@ uses Myc.Data.Decimal, Myc.Ast.Binding, Myc.Ast.RTL, + Myc.Ast.Script, FMX.Layouts, FMX.Objects, Myc.Ast.Debugger, @@ -74,6 +75,9 @@ type DumpButton: TButton; FailingUpvalueButton: TButton; TailCallButten: TButton; + Splitter1: TSplitter; + Splitter2: TSplitter; + ScriptMemo: TMemo; procedure InnerLambdaButtonClick(Sender: TObject); procedure ClearButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -84,6 +88,7 @@ type procedure ExternalFuncButtonClick(Sender: TObject); procedure FailingUpvalueButtonClick(Sender: TObject); procedure FibonacciButtonClick(Sender: TObject); + procedure FlowOnlyBoxChange(Sender: TObject); procedure OHLCButtonClick(Sender: TObject); procedure PrettyPrintButtonClick(Sender: TObject); procedure RecursionButtonClick(Sender: TObject); @@ -91,6 +96,7 @@ type procedure Test1ButtonClick(Sender: TObject); procedure Test2ButtonClick(Sender: TObject); procedure FromJSONButtonClick(Sender: TObject); + procedure ScriptMemoChange(Sender: TObject); procedure TailCallButtenClick(Sender: TObject); procedure ToJSONButtonClick(Sender: TObject); private @@ -98,10 +104,14 @@ type FLastAst: IAstNode; FGScope: IExecutionScope; FWorkspace: TAuraWorkspace; + FTriggerScope: IExecutionScope; + FScriptUpdate: Boolean; procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); function CreateVisitor(Scope: IExecutionScope): IAstVisitor; // Helper function to encapsulate the Bind -> Evaluate pattern function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; + procedure UpdateScript; + procedure ShowVizualization(X, Y: Single); public { Public declarations } end; @@ -138,7 +148,7 @@ begin TAst.Block( [ // var x = 10; - TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInteger(10))), + TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(10)), // var inner = lambda() { ... }; TAst.VarDecl( TAst.Identifier('inner'), @@ -154,11 +164,7 @@ begin // x = x + 5; TAst.Assign( TAst.Identifier('x'), - TAst.BinaryExpr( - TAst.Identifier('x'), - boAdd, - TAst.Constant(TScalar.FromInteger(5)) - ) + TAst.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, TAst.Constant(5)) ) ) ), @@ -185,7 +191,8 @@ begin resultValue := ExecuteAst(mainBlock, FGScope); - Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString); + Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString); + UpdateScript; end; procedure TForm1.ClearButtonClick(Sender: TObject); @@ -224,27 +231,31 @@ begin [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.VarDecl(TAst.Identifier('sum'), TAst.Constant(0.0)), + TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(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.BinaryExpr(TAst.Identifier('sum'), TScalar.TBinaryOp.Add, TAst.Identifier('val')) ), TAst.Assign( TAst.Identifier('count'), - TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1))) + TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Add, TAst.Constant(1)) ), TAst.Assign( TAst.Identifier('sum'), TAst.TernaryExpr( - TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')), + TAst.BinaryExpr( + TAst.Identifier('count'), + TScalar.TBinaryOp.Greater, + TAst.Identifier('len') + ), TAst.BinaryExpr( TAst.Identifier('sum'), - boSubtract, + TScalar.TBinaryOp.Subtract, TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len')) ), TAst.Identifier('sum') @@ -252,9 +263,9 @@ begin ), TAst.BinaryExpr( TAst.Identifier('sum'), - boDivide, + TScalar.TBinaryOp.Divide, TAst.TernaryExpr( - TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')), + TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Less, TAst.Identifier('len')), TAst.Identifier('count'), TAst.Identifier('len') ) @@ -280,7 +291,7 @@ var result: TDataValue; sw: TStopwatch; begin - // This script defines a naive, slow recursive 'fib' function. + // This script defines a naive, slow recursive 'fib' function (on purpose!). // The lambda captures its own name ('fib') from the parent scope to perform recursion. var fibAst := TAst.Block( @@ -293,19 +304,19 @@ begin TAst.LambdaExpr( [TAst.Identifier('n')], TAst.TernaryExpr( - TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), + TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Less, TAst.Constant(2)), TAst.Identifier('n'), TAst.BinaryExpr( // Naive recursive call using the variable name 'fib' TAst.FunctionCall( TAst.Identifier('fib'), - [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] + [TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))] ), - boAdd, + TScalar.TBinaryOp.Add, // Second naive recursive call TAst.FunctionCall( TAst.Identifier('fib'), - [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(2)))] + [TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(2))] ) ) ) @@ -324,9 +335,10 @@ begin sw := TStopwatch.StartNew; // The script to execute is just the call to the function. - root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(25))]); + root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]); FLastAst := root; + // Execute within the scope where 'fib' is defined. result := ExecuteAst(root, fibScope); @@ -343,7 +355,7 @@ begin // Create a memoized version by calling the RTL function on 'fib' TAst.Assign(TAst.Identifier('fib'), TAst.FunctionCall(TAst.Identifier('Memoize'), [TAst.Identifier('fib')])), // Call the new, memoized function - TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(25))]) + TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]) ] ); @@ -352,6 +364,7 @@ begin sw.Stop; Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); + UpdateScript; end; procedure TForm1.PrettyPrintButtonClick(Sender: TObject); @@ -392,12 +405,12 @@ begin TAst.LambdaExpr( [TAst.Identifier('n'), TAst.Identifier('acc')], TAst.TernaryExpr( - TAst.BinaryExpr(TAst.Identifier('n'), boLessOrEqual, TAst.Constant(TScalar.FromInt64(1))), + TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.LessOrEqual, TAst.Constant(1)), TAst.Identifier('acc'), // Base case: return the accumulator TAst.Recur( // Tail-recursive step [ - TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1))), - TAst.BinaryExpr(TAst.Identifier('acc'), boMultiply, TAst.Identifier('n')) + TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1)), + TAst.BinaryExpr(TAst.Identifier('acc'), TScalar.TBinaryOp.Multiply, TAst.Identifier('n')) ] ) ) @@ -408,11 +421,11 @@ begin TAst.Identifier('factorial'), TAst.LambdaExpr( [TAst.Identifier('n')], - TAst.FunctionCall(TAst.Identifier('fact_iter'), [TAst.Identifier('n'), TAst.Constant(TScalar.FromInt64(1))]) + TAst.FunctionCall(TAst.Identifier('fact_iter'), [TAst.Identifier('n'), TAst.Constant(1)]) ) ), // Call the main function - TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TScalar.FromInt64(20))]) + TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(20)]) ] ); @@ -422,6 +435,7 @@ begin sw.Stop; Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); + UpdateScript; end; procedure TForm1.SeriesTestButtonClick(Sender: TObject); @@ -432,6 +446,7 @@ var recordDef: TScalarRecordDefinition; i: Integer; scope: IExecutionScope; + values: TArray; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Series Test ---'); @@ -439,21 +454,19 @@ begin scope := TAst.CreateScope(FGScope); recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); series := TScalarRecordSeries.Create(recordDef); + SetLength(values, 6); + for i := 0 to 4 do begin - series.Add( - TScalarRecord.Create( - recordDef, - [ - TScalarValue.FromDateTime(Now + i), - TScalarValue.FromDouble(100.0 + i), - TScalarValue.FromDouble(105.0 + i), - TScalarValue.FromDouble(98.0 + i), - TScalarValue.FromDouble(102.0 + i), - TScalarValue.FromInt64(10000 * (i + 1)) - ] - ) - ); + // TScalar can no longer hold TDateTime, convert to Int64 for the test. + values[0].AsInt64 := Round((Now + i) * 24 * 60 * 60 * 1000); + values[1].AsDouble := 100.0 + i; + values[2].AsDouble := 105.0 + i; + values[3].AsDouble := 98.0 + i; + values[4].AsDouble := 102.0 + i; + values[5].AsInt64 := 10000 * (i + 1); + + series.Add(TScalarRecord.Create(recordDef, values)); end; scope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series)); @@ -466,7 +479,7 @@ begin TAst.Identifier('closeColumn'), TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close')) ), - TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1))) + TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(1)) ] ) ); @@ -476,6 +489,7 @@ begin resultValue := ExecuteAst(callAst, scope); Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString])); + UpdateScript; end; procedure TForm1.Test1ButtonClick(Sender: TObject); @@ -493,12 +507,9 @@ begin [], TAst.Block( [ - TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))), - TAst.VarDecl( - TAst.Identifier('b'), - TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TScalar.FromInt64(2))) - ), - TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b')) + TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), + TAst.VarDecl(TAst.Identifier('b'), TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Multiply, TAst.Constant(2))), + TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Identifier('b')) ] ) ); @@ -509,6 +520,7 @@ begin sw.Stop; Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); + UpdateScript; end; procedure TForm1.Test2ButtonClick(Sender: TObject); @@ -530,14 +542,14 @@ begin [TAst.Identifier('offset')], TAst.Block( [ - TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TScalar.FromInt64(100))), - TAst.BinaryExpr(TAst.Identifier('baseValue'), boAdd, TAst.Identifier('offset')) + TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(100)), + TAst.BinaryExpr(TAst.Identifier('baseValue'), TScalar.TBinaryOp.Add, TAst.Identifier('offset')) ] ) ) ), - TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(20))]), - TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(55))]) + TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(20)]), + TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(55)]) ] ); @@ -546,6 +558,7 @@ begin sw.Stop; Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); + UpdateScript; end; procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); @@ -553,15 +566,7 @@ begin if Button <> TMouseButton.mbMiddle then exit; - if FLastAst <> nil then - begin - var visu := TVisualizationMode.vmDetailed; - if FlowOnlyBox.IsChecked then - visu := TVisualizationMode.vmControlFlow; - - var descr := TAstBinder.Bind(FLastAst, FGScope); - FWorkspace.BuildTree(FLastAst, descr.CreateScope(FGScope), TPointF.Create(X, Y), visu); - end; + ShowVizualization(X, Y); end; procedure TForm1.OHLCButtonClick(Sender: TObject); @@ -572,6 +577,8 @@ const smaFastLength = 10; var scope: IExecutionScope; + values: TArray; + recordValue: TScalarRecord; begin Memo1.Lines.Clear; Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs])); @@ -579,14 +586,8 @@ begin var setupAst := TAst.Block( [ - TAst.VarDecl( - TAst.Identifier('smaFast'), - TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))]) - ), - TAst.VarDecl( - TAst.Identifier('smaSlow'), - TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))]) - ), + TAst.VarDecl(TAst.Identifier('smaFast'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaFastLength)])), + TAst.VarDecl(TAst.Identifier('smaSlow'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaSlowLength)])), TAst.VarDecl( TAst.Identifier('maCrossStrategy'), TAst.LambdaExpr( @@ -599,7 +600,7 @@ begin ), TAst.VarDecl( TAst.Identifier('currentClose'), - TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(TScalar.FromInt64(0))) + TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(0)) ), TAst.VarDecl( TAst.Identifier('valSmaFast'), @@ -616,9 +617,13 @@ begin ) ), TAst.TernaryExpr( - TAst.BinaryExpr(TAst.Identifier('valSmaFast'), boGreater, TAst.Identifier('valSmaSlow')), - TAst.Constant(TScalar.FromInt64(1)), - TAst.Constant(TScalar.FromInt64(-1)) + TAst.BinaryExpr( + TAst.Identifier('valSmaFast'), + TScalar.TBinaryOp.Greater, + TAst.Identifier('valSmaSlow') + ), + TAst.Constant(1), + TAst.Constant(-1) ) ] ) @@ -658,7 +663,6 @@ begin var ohlcvRec: TOHLCV; for var i := 1 to numRecs do begin - // ... (simulation logic is unchanged) ... ohlcvRec.Timestamp := nw + (i / (24 * 60)); ohlcvRec.Open := lastClose + (Random * 0.05); ohlcvRec.Close := lastClose + (Random - 0.49) * 2; @@ -666,18 +670,16 @@ begin ohlcvRec.Low := Min(ohlcvRec.Open, ohlcvRec.Close) - Random; ohlcvRec.Volume := RandomRange(1000, 50000); lastClose := ohlcvRec.Close; - var recordValue := - TScalarRecord.Create( - recDef, - [ - TScalarValue.FromDateTime(ohlcvRec.Timestamp), - TScalarValue.FromDouble(ohlcvRec.Open), - TScalarValue.FromDouble(ohlcvRec.High), - TScalarValue.FromDouble(ohlcvRec.Low), - TScalarValue.FromDouble(ohlcvRec.Close), - TScalarValue.FromInt64(ohlcvRec.Volume) - ] - ); + + SetLength(values, 6); + values[0].AsDouble := ohlcvRec.Timestamp; + values[1].AsDouble := ohlcvRec.Open; + values[2].AsDouble := ohlcvRec.High; + values[3].AsDouble := ohlcvRec.Low; + values[4].AsDouble := ohlcvRec.Close; + values[5].AsInt64 := ohlcvRec.Volume; + recordValue := TScalarRecord.Create(recDef, values); + series.AsRecordSeries.Add(recordValue, lookback); if series.AsRecordSeries.TotalCount >= smaSlowLength then @@ -695,10 +697,54 @@ begin sw.Stop; Memo1.Lines.Add('--- Simulation Finished ---'); Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds])); + UpdateScript; end; +procedure TForm1.TailCallButtenClick(Sender: TObject); +const + // A large number to prove TCO prevents stack overflow + RecursionDepth = 1000000; var - TriggerScope: IExecutionScope; + root: IAstNode; + result: TDataValue; + sw: TStopwatch; +begin + Memo1.Lines.Clear; + Memo1.Lines.Add(Format('--- Testing TCO with recursion depth of %d ---', [RecursionDepth])); + Application.ProcessMessages; + sw := TStopwatch.StartNew; + + root := + TAst.Block( + [ + // var countDown = lambda(n) { ... }; + TAst.VarDecl( + TAst.Identifier('countDown'), + TAst.LambdaExpr( + [TAst.Identifier('n')], + // if (n > 0) then recur(n-1) else 0 + TAst.IfExpr( + TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Greater, TAst.Constant(0)), + // This is the tail call position, now using recur. + TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]), + // Base case of the recursion returns 0 + TAst.Constant(0) + ) + ) + ), + // Initial call to start the recursion + TAst.FunctionCall(TAst.Identifier('countDown'), [TAst.Constant(RecursionDepth)]) + ] + ); + + FLastAst := root; + result := ExecuteAst(root, FGScope); + sw.Stop; + + Memo1.Lines.Add(Format('Result: %s', [result.ToString])); + Memo1.Lines.Add(Format('Execution finished in %d ms without stack overflow.', [sw.ElapsedMilliseconds])); + UpdateScript; +end; procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject); var @@ -709,27 +755,31 @@ begin blk := TAst.Block( [ - TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))), + TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(0)), TAst.VarDecl( TAst.Identifier('tickHandler'), TAst.LambdaExpr( [TAst.Identifier('summand')], - TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand'))) + TAst.Assign( + TAst.Identifier('X'), + TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, TAst.Identifier('summand')) + ) ) ) ] ); - TriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope); + FTriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope); // This case is simple enough to just inline the logic from ExecuteAst - var visitor := CreateVisitor(TriggerScope); + var visitor := CreateVisitor(FTriggerScope); visitor.Execute(blk); FLastAst := blk; Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.'); Memo1.Lines.Add('Click "Do Trigger" to execute.'); + UpdateScript; end; function TForm1.CreateVisitor(Scope: IExecutionScope): IAstVisitor; @@ -744,24 +794,26 @@ procedure TForm1.DoTriggerButtonClick(Sender: TObject); var callAst: IFunctionCallNode; begin - callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]); + callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]); FLastAst := callAst; - var X := ExecuteAst(callAst, TriggerScope); + var X := ExecuteAst(callAst, FTriggerScope); Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString])); + UpdateScript; end; procedure TForm1.DoTrigger2ButtonClick(Sender: TObject); var callAst: IFunctionCallNode; begin - callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]); + callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(2)]); FLastAst := callAst; - var X := ExecuteAst(callAst, TriggerScope); + var X := ExecuteAst(callAst, FTriggerScope); Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString])); + UpdateScript; end; procedure TForm1.DumpButtonClick(Sender: TObject); @@ -804,12 +856,12 @@ begin end ); - callAst := - TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(TScalar.FromInt64(100)), TAst.Constant(TScalar.FromInt64(23))]); + callAst := TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(100), TAst.Constant(123)]); FLastAst := callAst; resultValue := ExecuteAst(callAst, scope); - Memo1.Lines.Add(Format('Result from delphiAdd(100, 23): %s', [resultValue.ToString])); + Memo1.Lines.Add(Format('Result from delphiAdd(100, 123): %s', [resultValue.ToString])); + UpdateScript; end; procedure TForm1.FailingUpvalueButtonClick(Sender: TObject); @@ -821,7 +873,7 @@ begin TAst.Block( [ // 1. Define the shared variable. - TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))), + TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), // 2. Define a function that returns a closure that MODIFIES 'a'. // This creates the multi-level capture scenario. TAst.VarDecl( @@ -832,7 +884,7 @@ begin [], // Inner closure that is returned TAst.Assign( TAst.Identifier('a'), - TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Constant(TScalar.FromInt64(5))) + TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Constant(5)) ) ) ) @@ -866,8 +918,14 @@ begin Memo1.Lines.Add(Format('FAILURE: Expected 15, but got %s.', [resultValue.ToString])); end; - Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15.'); + Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15.'); Memo1.Lines.Add('Please check the new dump.'); + UpdateScript; +end; + +procedure TForm1.FlowOnlyBoxChange(Sender: TObject); +begin + UpdateScript; end; procedure TForm1.FromJSONButtonClick(Sender: TObject); @@ -902,51 +960,20 @@ begin finally Memo1.Lines.EndUpdate; end; + UpdateScript; end; -procedure TForm1.TailCallButtenClick(Sender: TObject); -const - // A large number to prove TCO prevents stack overflow - RecursionDepth = 1000000; -var - root: IAstNode; - result: TDataValue; - sw: TStopwatch; +procedure TForm1.ScriptMemoChange(Sender: TObject); begin - Memo1.Lines.Clear; - Memo1.Lines.Add(Format('--- Testing TCO with recursion depth of %d ---', [RecursionDepth])); - Application.ProcessMessages; - sw := TStopwatch.StartNew; + if FScriptUpdate then + exit; - root := - TAst.Block( - [ - // var countDown = lambda(n) { ... }; - TAst.VarDecl( - TAst.Identifier('countDown'), - TAst.LambdaExpr( - [TAst.Identifier('n')], - // if (n > 0) then recur(n-1) else 'done' - TAst.IfExpr( - TAst.BinaryExpr(TAst.Identifier('n'), boGreater, TAst.Constant(TScalar.FromInt64(0))), - // This is the tail call position, now using recur. - TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]), - // Base case of the recursion - TAst.Constant(TScalar.FromString('done')) - ) - ) - ), - // Initial call to start the recursion - TAst.FunctionCall(TAst.Identifier('countDown'), [TAst.Constant(TScalar.FromInt64(RecursionDepth))]) - ] - ); - - FLastAst := root; - result := ExecuteAst(root, FGScope); - sw.Stop; - - Memo1.Lines.Add(Format('Result: %s', [result.ToString])); - Memo1.Lines.Add(Format('Execution finished in %d ms without stack overflow.', [sw.ElapsedMilliseconds])); + try + FLastAst := TAstScript.Parse(ScriptMemo.Lines.Text) + except + on E: Exception do + Memo1.Lines.Add(E.Message); + end; end; procedure TForm1.ToJSONButtonClick(Sender: TObject); @@ -973,4 +1000,35 @@ begin end; end; +procedure TForm1.UpdateScript; +begin + try + FScriptUpdate := true; + try + ScriptMemo.Lines.Text := TAstScript.Print(FLastAst); + finally + FScriptUpdate := false; + end; + except + on E: Exception do + ScriptMemo.Lines.Add(E.Message); + end; + + FWorkspace.DeleteChildren; + ShowVizualization(14, 14); +end; + +procedure TForm1.ShowVizualization(X, Y: Single); +begin + if FLastAst <> nil then + begin + var visu := TVisualizationMode.vmDetailed; + if FlowOnlyBox.IsChecked then + visu := TVisualizationMode.vmControlFlow; + + var descr := TAstBinder.Bind(FLastAst, FGScope); + FWorkspace.BuildTree(FLastAst, descr.CreateScope(FGScope), TPointF.Create(X, Y), visu); + end; +end; + end. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 9d911ad..bd1da95 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -152,10 +152,8 @@ begin end; case AValue.AsScalar.Kind of - skInteger: Result := (AValue.AsScalar.Value.AsInteger <> 0); - skInt64: Result := (AValue.AsScalar.Value.AsInt64 <> 0); - skUInt64: Result := (AValue.AsScalar.Value.AsUInt64 <> 0); - skBoolean: Result := (AValue.AsScalar.Value.AsBoolean); + TScalar.TKind.Ordinal: Result := (AValue.AsScalar.Value.AsInt64 <> 0); + TScalar.TKind.Float: Result := (AValue.AsScalar.Value.AsDouble <> 0.0); else Result := False; end; @@ -297,13 +295,10 @@ begin if Assigned(Node.Lookback) then begin lookbackValue := Node.Lookback.Accept(Self); - if (lookbackValue.Kind <> vkScalar) or not (lookbackValue.AsScalar.Kind in [skInteger, skInt64]) then + if (lookbackValue.Kind <> vkScalar) or (lookbackValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then raise EArgumentException.Create('Lookback parameter must be an integer.'); - if lookbackValue.AsScalar.Kind = skInteger then - lookback := lookbackValue.AsScalar.Value.AsInteger - else - lookback := lookbackValue.AsScalar.Value.AsInt64; + lookback := lookbackValue.AsScalar.Value.AsInt64; end; case seriesVar.Kind of @@ -365,21 +360,14 @@ function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue; var baseValue, indexValue: TDataValue; index: Int64; - indexScalar: TScalar; begin baseValue := Node.Base.Accept(Self); indexValue := Node.Index.Accept(Self); - if (indexValue.Kind <> vkScalar) then - raise EArgumentException.Create('Indexer `[]` requires a scalar integer argument.'); + if (indexValue.Kind <> vkScalar) or (indexValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then + raise EArgumentException.Create('Indexer `[]` requires an integer argument.'); - indexScalar := indexValue.AsScalar; - case indexScalar.Kind of - skInteger: index := indexScalar.Value.AsInteger; - skInt64: index := indexScalar.Value.AsInt64; - else - raise EArgumentException.Create('Indexer `[]` requires an integer type argument.'); - end; + index := indexValue.AsScalar.Value.AsInt64; case baseValue.Kind of vkSeries: diff --git a/Src/AST/Myc.Ast.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index fcb54de..ec22b52 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -21,7 +21,7 @@ uses System.Generics.Collections, Myc.Ast, Myc.Data.Scalar, - Myc.Data.Value; // Added for TDataValue + Myc.Data.Value; type // TJsonAstConverter implements the visitor pattern for serialization @@ -29,10 +29,10 @@ type TJsonAstConverter = class(TInterfacedObject, IAstVisitor) private FJsonObjectStack: TStack; - procedure ScalarToJson(const AScalar: TScalar; const AParent: TJSONObject; const AName: string); + procedure DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string); function JsonToNode(const AJson: TJSONValue): IAstNode; - function JsonToScalar(const AObj: TJSONObject; const AName: string): TScalar; - // Updated signatures to return specific node interface types + function JsonToDataValue(const AObj: TJSONObject; const AName: string): TDataValue; + function JsonToConstantNode(const AObj: TJSONObject): IConstantNode; function JsonToIdentifierNode(const AObj: TJSONObject): IIdentifierNode; function JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode; @@ -137,23 +137,31 @@ end; { TJsonAstConverter - IAstVisitor for Serialization } -procedure TJsonAstConverter.ScalarToJson(const AScalar: TScalar; const AParent: TJSONObject; const AName: string); +procedure TJsonAstConverter.DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string); var - scalarObj: TJSONObject; + valObj, scalarObj: TJSONObject; begin - scalarObj := TJSONObject.Create; - scalarObj.AddPair('Kind', TJSONString.Create(AScalar.Kind.ToString)); + valObj := TJSONObject.Create; + valObj.AddPair('Kind', TJSONString.Create(AValue.Kind.ToString)); - case AScalar.Kind of - skInt64: scalarObj.AddPair('Value', TJSONNumber.Create(AScalar.Value.AsInt64)); - skDouble: scalarObj.AddPair('Value', TJSONNumber.Create(AScalar.Value.AsDouble)); - skBoolean: scalarObj.AddPair('Value', TJSONBool.Create(AScalar.Value.AsBoolean)); - skString: scalarObj.AddPair('Value', TJSONString.Create(AScalar.Value.AsString)); + case AValue.Kind of + vkScalar: + begin + scalarObj := TJSONObject.Create; + scalarObj.AddPair('Kind', TJSONString.Create(AValue.AsScalar.Kind.ToString)); + case AValue.AsScalar.Kind of + TScalar.TKind.Ordinal: scalarObj.AddPair('Value', TJSONNumber.Create(AValue.AsScalar.Value.AsInt64)); + TScalar.TKind.Float: scalarObj.AddPair('Value', TJSONNumber.Create(AValue.AsScalar.Value.AsDouble)); + end; + valObj.AddPair('Value', scalarObj); + end; + vkText: valObj.AddPair('Value', TJSONString.Create(AValue.AsText)); + vkVoid:; // No value to add else - raise ENotSupportedException.CreateFmt('Scalar kind %s not supported for JSON serialization.', [AScalar.Kind.ToString]); + raise ENotSupportedException.Create('Unsupported TDataValue kind for constant serialization.'); end; - AParent.AddPair(AName, scalarObj); + AParent.AddPair(AName, valObj); end; function TJsonAstConverter.VisitConstant(const Node: IConstantNode): TDataValue; @@ -162,7 +170,7 @@ var begin obj := TJSONObject.Create; obj.AddPair('NodeType', TJSONString.Create('Constant')); - ScalarToJson(Node.Value, obj, 'Value'); + DataValueToJson(Node.Value, obj, 'Value'); FJsonObjectStack.Push(obj); Result := TDataValue.Void; end; @@ -509,32 +517,40 @@ end; { TJsonAstConverter - Deserialization } -function TJsonAstConverter.JsonToScalar(const AObj: TJSONObject; const AName: string): TScalar; +function TJsonAstConverter.JsonToDataValue(const AObj: TJSONObject; const AName: string): TDataValue; var - scalarObj: TJSONObject; + valObj, scalarObj: TJSONObject; kindStr: string; - scalarKind: TScalarKind; - jsonValue: TJSONValue; + scalarKind: TScalar.TKind; begin - scalarObj := AObj.GetValue(AName); - kindStr := scalarObj.GetValue('Kind'); - scalarKind := TScalar.StringToKind(kindStr); + valObj := AObj.GetValue(AName); + kindStr := valObj.GetValue('Kind'); - jsonValue := scalarObj.GetValue('Value'); - - case scalarKind of - skInt64: Result := TScalar.FromInt64((jsonValue as TJSONNumber).AsInt64); - skDouble: Result := TScalar.FromDouble((jsonValue as TJSONNumber).AsDouble); - skBoolean: Result := TScalar.FromBoolean((jsonValue as TJSONBool).AsBoolean); - skString: Result := TScalar.FromString((jsonValue as TJSONString).Value); + if SameText(kindStr, 'Scalar') then + begin + scalarObj := valObj.GetValue('Value'); + kindStr := scalarObj.GetValue('Kind'); + scalarKind := TScalar.StringToKind(kindStr); + case scalarKind of + TScalar.TKind.Ordinal: Result := TScalar.FromInt64(scalarObj.GetValue('Value').AsInt64); + TScalar.TKind.Float: Result := TScalar.FromDouble(scalarObj.GetValue('Value').AsDouble); + end; + end + else if SameText(kindStr, 'Text') then + begin + Result := valObj.GetValue('Value'); + end + else if SameText(kindStr, 'Void') then + begin + Result := TDataValue.Void; + end else - raise ENotSupportedException.CreateFmt('Scalar kind %s not supported for JSON deserialization.', [kindStr]); - end; + raise ENotSupportedException.Create('Unsupported TDataValue kind for constant deserialization.'); end; function TJsonAstConverter.JsonToConstantNode(const AObj: TJSONObject): IConstantNode; begin - Result := TAst.Constant(JsonToScalar(AObj, 'Value')); + Result := TAst.Constant(JsonToDataValue(AObj, 'Value')); end; function TJsonAstConverter.JsonToIdentifierNode(const AObj: TJSONObject): IIdentifierNode; @@ -545,11 +561,11 @@ end; function TJsonAstConverter.JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode; var opStr: string; - op: TBinaryOperator; + op: TScalar.TBinaryOp; leftNode, rightNode: IAstNode; begin opStr := AObj.GetValue('Operator'); - for op := Low(TBinaryOperator) to High(TBinaryOperator) do + for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do if SameText(op.ToString, opStr) then begin leftNode := JsonToNode(AObj.GetValue('Left')); @@ -563,11 +579,11 @@ end; function TJsonAstConverter.JsonToUnaryExprNode(const AObj: TJSONObject): IUnaryExpressionNode; var opStr: string; - op: TUnaryOperator; + op: TScalar.TUnaryOp; rightNode: IAstNode; begin opStr := AObj.GetValue('Operator'); - for op := Low(TUnaryOperator) to High(TUnaryOperator) do + for op := Low(TScalar.TUnaryOp) to High(TScalar.TUnaryOp) do if SameText(op.ToString, opStr) then begin rightNode := JsonToNode(AObj.GetValue('Right')); diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 471020d..6fec5cd 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -112,10 +112,11 @@ type end; IConstantNode = interface(IAstNode) + // Represents a constant value in the AST (Scalar, Text, or Void). {$region 'private'} - function GetValue: TScalar; + function GetValue: TDataValue; {$endregion} - property Value: TScalar read GetValue; + property Value: TDataValue read GetValue; end; IIdentifierNode = interface(IAstNode) @@ -130,20 +131,20 @@ type IBinaryExpressionNode = interface(IAstNode) {$region 'private'} function GetLeft: IAstNode; - function GetOperator: TBinaryOperator; + function GetOperator: TScalar.TBinaryOp; function GetRight: IAstNode; {$endregion} property Left: IAstNode read GetLeft; - property Operator: TBinaryOperator read GetOperator; + property Operator: TScalar.TBinaryOp read GetOperator; property Right: IAstNode read GetRight; end; IUnaryExpressionNode = interface(IAstNode) {$region 'private'} - function GetOperator: TUnaryOperator; + function GetOperator: TScalar.TUnaryOp; function GetRight: IAstNode; {$endregion} - property Operator: TUnaryOperator read GetOperator; + property Operator: TScalar.TUnaryOp read GetOperator; property Right: IAstNode read GetRight; end; diff --git a/Src/AST/Myc.Ast.Persistence.pas b/Src/AST/Myc.Ast.Persistence.pas deleted file mode 100644 index d4eb06e..0000000 --- a/Src/AST/Myc.Ast.Persistence.pas +++ /dev/null @@ -1,1110 +0,0 @@ -unit Myc.Ast.Persistence; - -interface - -uses - System.SysUtils, - System.Json, - System.Generics.Collections, - Myc.Data.Scalar, - Myc.Ast.Nodes, - Myc.Ast.ViewModel; - -type - // Manages the serialization and deserialization of the entire editor state. - TAstProjectPersistence = class - private - type - // This helper visitor acts as a "Builder". - // It builds the JSON result internally on a stack instead of using the return value. - TAstToJsonVisitor = class(TInterfacedObject, IAstVisitor) - private - FIdMap: TDictionary; - // Tracks nodes that have already been fully serialized to prevent infinite recursion on cycles. - FSerializedNodes: TDictionary; - FNextId: Integer; - FResultStack: TStack; - function GetOrCreateNodeId(const Node: IAstNode): Integer; - function ScalarToJson(const AValue: TScalar): TJSONObject; - public - constructor Create(AIdMap: TDictionary); - destructor Destroy; override; - - function GetResult: TJSONObject; - - { IAstVisitor } - function VisitConstant(const Node: IConstantNode): TAstValue; - function VisitIdentifier(const Node: IIdentifierNode): TAstValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; - function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; - function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; - function VisitAssignment(const Node: IAssignmentNode): TAstValue; - function VisitIndexer(const Node: IIndexerNode): TAstValue; - function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; - function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; - function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; - end; - - function ScalarFromJson(AObject: TJSONObject): TScalar; - function DeserializeNode(AObject: TJSONObject; ANodeIdMap: TDictionary): IAstNode; - - public - // Saves the complete state to a JSON file. - procedure SaveToFile( - const AFileName: string; - const ARootNode: IAstNode; - const ALogicalMetadata: TDictionary; - const AInstanceMetadata: TDictionary - ); - - // Loads the complete state from a JSON file. - procedure LoadFromFile( - const AFileName: string; - out ARootNode: IAstNode; - out ALogicalMetadata: TDictionary; - out AInstanceMetadata: TDictionary - ); - - class function AstNodeToJsonString(const ANode: IAstNode): string; static; - class function JsonStringToAstNode(const AJsonString: string): IAstNode; static; - end; - -implementation - -uses - System.Classes, - System.Types, - System.Variants, - System.Rtti, - System.TypInfo, - System.IOUtils, - System.DateUtils, - System.StrUtils, - Myc.Data.Decimal, - Myc.Ast; - -{ TAstProjectPersistence } - -procedure TAstProjectPersistence.SaveToFile( - const AFileName: string; - const ARootNode: IAstNode; - const ALogicalMetadata: TDictionary; - const AInstanceMetadata: TDictionary -); -var - rootJson, astJson, logicalMetaJson, instanceMetaJson: TJSONObject; - idMap: TDictionary; - visitor: TAstToJsonVisitor; - pair: TPair; - metaPair: TPair; - metaValueJson: TJSONObject; -begin - rootJson := TJSONObject.Create; - try - idMap := TDictionary.Create; - visitor := TAstToJsonVisitor.Create(idMap); - try - ARootNode.Accept(visitor); - astJson := visitor.GetResult; - rootJson.AddPair('ast', astJson); - finally - idMap.Free; - visitor.Free; - end; - - logicalMetaJson := TJSONObject.Create; - for pair in ALogicalMetadata do - begin - var nodeIdStr := idMap[pair.Key].ToString; - metaValueJson := TJSONObject.Create; - metaValueJson.AddPair('NodeType', TJSONString.Create(GetEnumName(TypeInfo(TAstNodeType), Ord(pair.Value.NodeType)))); - metaValueJson.AddPair('Description', TJSONString.Create(pair.Value.Description)); - logicalMetaJson.AddPair(nodeIdStr, metaValueJson); - end; - rootJson.AddPair('logicalMetadata', logicalMetaJson); - - instanceMetaJson := TJSONObject.Create; - for metaPair in AInstanceMetadata do - begin - var idStr := metaPair.Key.ToString; - metaValueJson := TJSONObject.Create; - metaValueJson.AddPair('PositionX', TJSONNumber.Create(metaPair.Value.PositionOverride.X)); - metaValueJson.AddPair('PositionY', TJSONNumber.Create(metaPair.Value.PositionOverride.Y)); - metaValueJson.AddPair('IsCollapsed', TJSONBool.Create(metaPair.Value.IsCollapsed)); - var modeStr := GetEnumName(TypeInfo(TVisualizationMode), Ord(metaPair.Value.VisualizationMode)); - metaValueJson.AddPair('VisualizationMode', TJSONString.Create(modeStr)); - instanceMetaJson.AddPair(idStr, metaValueJson); - end; - rootJson.AddPair('instanceMetadata', instanceMetaJson); - - TFile.WriteAllText(AFileName, rootJson.ToJSON); - finally - rootJson.Free; - end; -end; - -procedure TAstProjectPersistence.LoadFromFile( - const AFileName: string; - out ARootNode: IAstNode; - out ALogicalMetadata: TDictionary; - out AInstanceMetadata: TDictionary -); -var - rootJson, astJson, logicalMetaJson, instanceMetaJson: TJSONObject; - jsonValue: TJSONValue; - nodeIdMap: TDictionary; - pair: TJSONPair; - metaPair: TJSONPair; - metaData: TVisualInstanceMetadata; -begin - ARootNode := nil; - ALogicalMetadata := TDictionary.Create; - AInstanceMetadata := TDictionary.Create; - - jsonValue := TJSONObject.ParseJSONValue(TFile.ReadAllText(AFileName)); - if (not Assigned(jsonValue)) or (not (jsonValue is TJSONObject)) then - begin - exit; - end; - - rootJson := jsonValue as TJSONObject; - try - astJson := rootJson.GetValue('ast'); - if Assigned(astJson) then - begin - nodeIdMap := TDictionary.Create; - try - ARootNode := DeserializeNode(astJson, nodeIdMap); - if not Assigned(ARootNode) then - begin - exit; - end; - - logicalMetaJson := rootJson.GetValue('logicalMetadata'); - if Assigned(logicalMetaJson) then - begin - for pair in logicalMetaJson do - begin - var tempId := StrToInt(pair.JsonString.Value); - if nodeIdMap.ContainsKey(tempId) then - begin - var node := nodeIdMap[tempId]; - var meta: TLogicalMetadata; - var metaJson := pair.JSONValue as TJSONObject; - meta.NodeType := TAstNodeType(GetEnumValue(TypeInfo(TAstNodeType), metaJson.GetValue('NodeType'))); - meta.Description := metaJson.GetValue('Description'); - ALogicalMetadata.Add(node, meta); - end; - end; - end; - finally - nodeIdMap.Free; - end; - end; - - instanceMetaJson := rootJson.GetValue('instanceMetadata'); - if Assigned(instanceMetaJson) then - begin - for metaPair in instanceMetaJson do - begin - var vmId := StrToInt64(metaPair.JsonString.Value); - var metaJson := metaPair.JsonValue as TJSONObject; - - metaData.PositionOverride.X := metaJson.GetValue('PositionX'); - metaData.PositionOverride.Y := metaJson.GetValue('PositionY'); - metaData.IsCollapsed := metaJson.GetValue('IsCollapsed'); - var modeStr := metaJson.GetValue('VisualizationMode'); - var modeInt := GetEnumValue(TypeInfo(TVisualizationMode), modeStr); - metaData.VisualizationMode := TVisualizationMode(modeInt); - AInstanceMetadata.Add(vmId, metaData); - end; - end; - - finally - rootJson.Free; - end; -end; - -function TAstProjectPersistence.DeserializeNode(AObject: TJSONObject; ANodeIdMap: TDictionary): IAstNode; -var - nodeTypeStr: string; - tempId: Integer; - i: Integer; -begin - Result := nil; - if not Assigned(AObject) then - begin - exit; - end; - - // Handle reference nodes to break cycles during deserialization - if AObject.GetValue('ref') <> nil then - begin - var refId := AObject.GetValue('ref'); - if not ANodeIdMap.TryGetValue(refId, Result) then - // A forward reference indicates a cycle that cannot be resolved with the current immutable AST node creation. - // The referenced node has not been fully constructed yet. - raise ENotImplemented.CreateFmt( - 'Forward reference to node ID %d encountered. This is not supported by the current deserialization logic.', - [refId]); - exit; - end; - - nodeTypeStr := AObject.GetValue('type'); - tempId := AObject.GetValue('id'); - - var nodeType := TAstNodeType(GetEnumValue(TypeInfo(TAstNodeType), 'ant' + nodeTypeStr)); - case nodeType of - antConstant: Result := TAst.Constant(ScalarFromJson(AObject.GetValue('value'))); - antIdentifier: Result := TAst.Identifier(AObject.GetValue('name')); - antBinaryExpression: - Result := - TAst.BinaryExpr( - DeserializeNode(AObject.GetValue('left'), ANodeIdMap), - TBinaryOperator(GetEnumValue(TypeInfo(TBinaryOperator), 'bo' + AObject.GetValue('operator'))), - DeserializeNode(AObject.GetValue('right'), ANodeIdMap) - ); - antUnaryExpression: - Result := - TAst.UnaryExpr( - TUnaryOperator(GetEnumValue(TypeInfo(TUnaryOperator), 'uo' + AObject.GetValue('operator'))), - DeserializeNode(AObject.GetValue('right'), ANodeIdMap) - ); - antIfExpression: - begin - var elseBranch: IAstNode := nil; - if AObject.GetValue('elseBranch') <> nil then - begin - elseBranch := DeserializeNode(AObject.GetValue('elseBranch'), ANodeIdMap); - end; - Result := - TAst.IfExpr( - DeserializeNode(AObject.GetValue('condition'), ANodeIdMap), - DeserializeNode(AObject.GetValue('thenBranch'), ANodeIdMap), - elseBranch - ); - end; - antTernaryExpression: - Result := - TAst.TernaryExpr( - DeserializeNode(AObject.GetValue('condition'), ANodeIdMap), - DeserializeNode(AObject.GetValue('thenBranch'), ANodeIdMap), - DeserializeNode(AObject.GetValue('elseBranch'), ANodeIdMap) - ); - antLambdaExpression: - begin - var paramsJson := AObject.GetValue('parameters'); - var params := TArray.Create(); - SetLength(params, paramsJson.Count); - // Important: Add the (incomplete) node to the map before deserializing children - // to allow children to reference it. - // However, with immutable nodes, we can't do that. The check for forward refs handles this limitation. - for i := 0 to paramsJson.Count - 1 do - begin - params[i] := IIdentifierNode(DeserializeNode(paramsJson.Items[i] as TJSONObject, ANodeIdMap)); - end; - var body := DeserializeNode(AObject.GetValue('body'), ANodeIdMap); - Result := TAst.LambdaExpr(params, body); - end; - antFunctionCall: - begin - var callee := DeserializeNode(AObject.GetValue('callee'), ANodeIdMap); - var argsJson := AObject.GetValue('arguments'); - var args := TArray.Create(); - SetLength(args, argsJson.Count); - for i := 0 to argsJson.Count - 1 do - begin - args[i] := DeserializeNode(argsJson.Items[i] as TJSONObject, ANodeIdMap); - end; - Result := TAst.FunctionCall(callee, args); - end; - antBlockExpression: - begin - var exprsJson := AObject.GetValue('expressions'); - var exprs := TArray.Create(); - SetLength(exprs, exprsJson.Count); - for i := 0 to exprsJson.Count - 1 do - begin - exprs[i] := DeserializeNode(exprsJson.Items[i] as TJSONObject, ANodeIdMap); - end; - Result := TAst.Block(exprs); - end; - antVariableDeclaration: - begin - var initializer: IAstNode := nil; - if AObject.GetValue('initializer') <> nil then - begin - initializer := DeserializeNode(AObject.GetValue('initializer'), ANodeIdMap); - end; - Result := TAst.VarDecl(IIdentifierNode(DeserializeNode(AObject.GetValue('identifier'), ANodeIdMap)), initializer); - end; - antAssignment: - Result := - TAst.Assign( - IIdentifierNode(DeserializeNode(AObject.GetValue('identifier'), ANodeIdMap)), - DeserializeNode(AObject.GetValue('value'), ANodeIdMap) - ); - antIndexer: - Result := - TAst.Indexer( - DeserializeNode(AObject.GetValue('base'), ANodeIdMap), - DeserializeNode(AObject.GetValue('index'), ANodeIdMap) - ); - antMemberAccess: - Result := - TAst.MemberAccess( - DeserializeNode(AObject.GetValue('base'), ANodeIdMap), - IIdentifierNode(DeserializeNode(AObject.GetValue('member'), ANodeIdMap)) - ); - antCreateSeries: Result := TAst.CreateSeries(AObject.GetValue('definition')); - antAddSeriesItem: - begin - var lookback: IAstNode := nil; - if AObject.GetValue('lookback') <> nil then - begin - lookback := DeserializeNode(AObject.GetValue('lookback'), ANodeIdMap); - end; - Result := - TAst.AddSeriesItem( - IIdentifierNode(DeserializeNode(AObject.GetValue('series'), ANodeIdMap)), - DeserializeNode(AObject.GetValue('value'), ANodeIdMap), - lookback - ); - end; - antSeriesLength: Result := TAst.SeriesLength(IIdentifierNode(DeserializeNode(AObject.GetValue('series'), ANodeIdMap))); - else - raise ENotImplemented.CreateFmt('Deserialization for node type "%s" is not implemented.', [nodeTypeStr]); - end; - - if Assigned(Result) then - begin - ANodeIdMap.Add(tempId, Result); - end; -end; - -function TAstProjectPersistence.ScalarFromJson(AObject: TJSONObject): TScalar; -var - kindStr: string; - kind: TScalarKind; - value: TScalarValue; - decVal: TDecimal; - hexStrAnsi: AnsiString; -begin - kindStr := AObject.GetValue('kind'); - kind := TScalar.StringToKind(kindStr); - case kind of - skInteger: value.AsInteger := AObject.GetValue('value'); - skInt64: value.AsInt64 := StrToInt64(AObject.GetValue('value')); - skUInt64: value.AsUInt64 := StrToUInt64(AObject.GetValue('value')); - skSingle: value.AsSingle := AObject.GetValue('value'); - skDouble: value.AsDouble := AObject.GetValue('value'); - skDateTime: value.AsDateTime := ISO8601ToDate(AObject.GetValue('value')); - skTimestamp: value.AsTimestamp := DateTimeToTimeStamp(ISO8601ToDate(AObject.GetValue('value'))); - skBoolean: value.AsBoolean := AObject.GetValue('value'); - skChar: value.AsChar := AObject.GetValue('value')[1]; - skPChar: StrPCopy(value.AsPChar, AObject.GetValue('value')); - skString: value.AsString := AObject.GetValue('value'); - skBytes: - begin - hexStrAnsi := AnsiString(AObject.GetValue('value')); - HexToBin(PAnsiChar(hexStrAnsi), @value.AsBytes, SizeOf(value.AsBytes)); - end; - skDecimal: - begin - decVal := TDecimal.Create(StrToInt64(AObject.GetValue('value')), AObject.GetValue('scale')); - value.AsDecimal := decVal; - end; - else - raise ENotImplemented.CreateFmt('TScalar deserialization for kind "%s" is not implemented.', [kindStr]); - end; - Result.Create(kind, value); -end; - -class function TAstProjectPersistence.AstNodeToJsonString(const ANode: IAstNode): string; -var - idMap: TDictionary; - visitor: TAstToJsonVisitor; - astJson, rootJson: TJSONObject; -begin - if not Assigned(ANode) then - begin - exit(''); - end; - - // We wrap the AST in the standard project structure { "ast": ... } - // for compatibility with the full LoadFromFile method. - rootJson := TJSONObject.Create; - try - idMap := TDictionary.Create; - try - visitor := TAstToJsonVisitor.Create(idMap); - try - ANode.Accept(visitor); - astJson := visitor.GetResult; - rootJson.AddPair('ast', astJson); - Result := rootJson.ToJSON; - finally - visitor.Free; - end; - finally - idMap.Free; - end; - finally - rootJson.Free; - end; -end; - -class function TAstProjectPersistence.JsonStringToAstNode(const AJsonString: string): IAstNode; -var - persistence: TAstProjectPersistence; - rootJson, astJson: TJSONObject; - nodeIdMap: TDictionary; -begin - Result := nil; - if AJsonString.IsEmpty then - begin - exit; - end; - - rootJson := TJSONObject.ParseJSONValue(AJsonString) as TJSONObject; - if not Assigned(rootJson) then - begin - exit; - end; - - try - // Expect the standard project structure and extract the "ast" part. - astJson := rootJson.GetValue('ast'); - if Assigned(astJson) then - begin - persistence := TAstProjectPersistence.Create; - try - nodeIdMap := TDictionary.Create; - try - Result := persistence.DeserializeNode(astJson, nodeIdMap); - finally - nodeIdMap.Free; - end; - finally - persistence.Free; - end; - end; - finally - rootJson.Free; - end; -end; - -{ TAstProjectPersistence.TAstToJsonVisitor } - -constructor TAstProjectPersistence.TAstToJsonVisitor.Create(AIdMap: TDictionary); -begin - inherited Create; - FIdMap := AIdMap; - FNextId := 0; - FResultStack := TStack.Create; - FSerializedNodes := TDictionary.Create; -end; - -destructor TAstProjectPersistence.TAstToJsonVisitor.Destroy; -begin - FResultStack.Free; - FSerializedNodes.Free; - inherited; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.GetResult: TJSONObject; -begin - Assert(FResultStack.Count = 1, 'Result stack should contain exactly one item after traversal.'); - Result := FResultStack.Pop as TJSONObject; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.GetOrCreateNodeId(const Node: IAstNode): Integer; -begin - if not FIdMap.TryGetValue(Node, Result) then - begin - Result := FNextId; - FIdMap.Add(Node, Result); - inc(FNextId); - end; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.ScalarToJson(const AValue: TScalar): TJSONObject; -var - hexStr: string; -begin - Result := TJSONObject.Create; - Result.AddPair('kind', TJSONString.Create(AValue.Kind.ToString)); - case AValue.Kind of - skInteger: Result.AddPair('value', TJSONNumber.Create(AValue.Value.AsInteger)); - skInt64: Result.AddPair('value', TJSONString.Create(AValue.Value.AsInt64.ToString)); - skUInt64: Result.AddPair('value', TJSONString.Create(AValue.Value.AsUInt64.ToString)); - skSingle: Result.AddPair('value', TJSONNumber.Create(AValue.Value.AsSingle)); - skDouble: Result.AddPair('value', TJSONNumber.Create(AValue.Value.AsDouble)); - skDateTime: Result.AddPair('value', TJSONString.Create(DateToISO8601(AValue.Value.AsDateTime))); - skTimestamp: Result.AddPair('value', TJSONString.Create(DateToISO8601(TimeStampToDateTime(AValue.Value.AsTimestamp)))); - skBoolean: Result.AddPair('value', TJSONBool.Create(AValue.Value.AsBoolean)); - skChar: Result.AddPair('value', TJSONString.Create(AValue.Value.AsChar)); - skPChar: Result.AddPair('value', TJSONString.Create(string(AValue.Value.AsPChar))); - skString: Result.AddPair('value', TJSONString.Create(String(AValue.Value.AsString))); - skBytes: - begin - // Corrected: Use the procedure overload of BinToHex. - // BinToHex(@AValue.Value.AsBytes, hexStr, SizeOf(AValue.Value.AsBytes)); - // Result.AddPair('value', TJSONString.Create(hexStr)); - end; - skDecimal: - begin - Result.AddPair('value', TJSONString.Create(AValue.Value.AsDecimal.GetValue.ToString)); - Result.AddPair('scale', TJSONNumber.Create(AValue.Value.AsDecimal.GetScale)); - end; - else - raise ENotImplemented.CreateFmt('TScalar serialization for kind "%s" is not implemented.', [AValue.Kind.ToString]); - end; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitConstant(const Node: IConstantNode): TAstValue; -var - obj: TJSONObject; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('Constant')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('value', ScalarToJson(Node.Value)); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; -var - obj: TJSONObject; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('Identifier')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('name', TJSONString.Create(Node.Name)); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; -var - obj: TJSONObject; - rightJson, leftJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Left.Accept(Self); - Node.Right.Accept(Self); - rightJson := FResultStack.Pop; - leftJson := FResultStack.Pop; - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('BinaryExpression')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('operator', TJSONString.Create(Copy(GetEnumName(TypeInfo(TBinaryOperator), Ord(Node.Operator)), 3))); - obj.AddPair('left', leftJson); - obj.AddPair('right', rightJson); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; -var - obj: TJSONObject; - rightJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Right.Accept(Self); - rightJson := FResultStack.Pop; - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('UnaryExpression')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('operator', TJSONString.Create(Copy(GetEnumName(TypeInfo(TUnaryOperator), Ord(Node.Operator)), 3))); - obj.AddPair('right', rightJson); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; -var - obj: TJSONObject; - elseJson, thenJson, condJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Condition.Accept(Self); - Node.ThenBranch.Accept(Self); - if Assigned(Node.ElseBranch) then - begin - Node.ElseBranch.Accept(Self); - end; - - if Assigned(Node.ElseBranch) then - begin - elseJson := FResultStack.Pop - end - else - begin - elseJson := nil; - end; - thenJson := FResultStack.Pop; - condJson := FResultStack.Pop; - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('IfExpression')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('condition', condJson); - obj.AddPair('thenBranch', thenJson); - if Assigned(elseJson) then - begin - obj.AddPair('elseBranch', elseJson); - end; - - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; -var - obj: TJSONObject; - elseJson, thenJson, condJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Condition.Accept(Self); - Node.ThenBranch.Accept(Self); - Node.ElseBranch.Accept(Self); - - elseJson := FResultStack.Pop; - thenJson := FResultStack.Pop; - condJson := FResultStack.Pop; - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('TernaryExpression')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('condition', condJson); - obj.AddPair('thenBranch', thenJson); - obj.AddPair('elseBranch', elseJson); - - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; -var - obj: TJSONObject; - paramsJson: TJSONArray; - param: IIdentifierNode; - bodyJson: TJSONValue; - i: Integer; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - // 1. Visit children first. - for param in Node.Parameters do - begin - param.Accept(Self); - end; - Node.Body.Accept(Self); - - // 2. Pop children's results from the stack in reverse order. - bodyJson := FResultStack.Pop; - - paramsJson := TJSONArray.Create; - var lst := TList.Create; - try - lst.Count := Length(Node.Parameters); - for i := High(Node.Parameters) downto 0 do - lst[i] := FResultStack.Pop; - paramsJson.SetElements(lst); - finally - lst.Free; - end; - - // 3. Create this node's JSON object. - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('LambdaExpression')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('parameters', paramsJson); - obj.AddPair('body', bodyJson); - // Note: ScopeDescriptor and Upvalues are runtime-only and not serialized here. - - // 4. Push this node's result onto the stack. - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; -var - obj: TJSONObject; - args: TJSONArray; - arg: IAstNode; - calleeJson: TJSONValue; - i: Integer; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Callee.Accept(Self); - for arg in Node.Arguments do - begin - arg.Accept(Self); - end; - - args := TJSONArray.Create; - var lst := TList.Create; - try - lst.Count := Node.Arguments.Count; - for i := Node.Arguments.Count - 1 downto 0 do - lst[i] := FResultStack.Pop; - args.SetElements(lst); - finally - lst.Free; - end; - - calleeJson := FResultStack.Pop; - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('FunctionCall')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('callee', calleeJson); - obj.AddPair('arguments', args); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; -var - obj: TJSONObject; - exprs: TJSONArray; - expr: IAstNode; - i: Integer; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - for expr in Node.Expressions do - begin - expr.Accept(Self); - end; - - exprs := TJSONArray.Create; - var lst := TList.Create; - try - lst.Count := Node.Expressions.Count; - for i := Node.Expressions.Count - 1 downto 0 do - lst[i] := FResultStack.Pop; - exprs.SetElements(lst); - finally - lst.Free; - end; - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('BlockExpression')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('expressions', exprs); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; -var - obj: TJSONObject; - identJson, initJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Identifier.Accept(Self); - if Assigned(Node.Initializer) then - begin - Node.Initializer.Accept(Self); - end; - - if Assigned(Node.Initializer) then - begin - initJson := FResultStack.Pop - end - else - begin - initJson := nil; - end; - identJson := FResultStack.Pop; - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('VariableDeclaration')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('identifier', identJson); - if Assigned(initJson) then - begin - obj.AddPair('initializer', initJson); - end; - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; -var - obj: TJSONObject; - identJson, valueJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Identifier.Accept(Self); - Node.Value.Accept(Self); - valueJson := FResultStack.Pop; - identJson := FResultStack.Pop; - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('Assignment')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('identifier', identJson); - obj.AddPair('value', valueJson); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue; -var - obj: TJSONObject; - baseJson, indexJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Base.Accept(Self); - Node.Index.Accept(Self); - indexJson := FResultStack.Pop; - baseJson := FResultStack.Pop; - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('Indexer')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('base', baseJson); - obj.AddPair('index', indexJson); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; -var - obj: TJSONObject; - baseJson, memberJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Base.Accept(Self); - Node.Member.Accept(Self); - memberJson := FResultStack.Pop; - baseJson := FResultStack.Pop; - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('MemberAccess')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('base', baseJson); - obj.AddPair('member', memberJson); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; -var - obj: TJSONObject; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('CreateSeries')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('definition', TJSONString.Create(Node.Definition)); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; -var - obj: TJSONObject; - seriesJson, valueJson, lookbackJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Series.Accept(Self); - Node.Value.Accept(Self); - if Assigned(Node.Lookback) then - begin - Node.Lookback.Accept(Self); - end; - - if Assigned(Node.Lookback) then - begin - lookbackJson := FResultStack.Pop - end - else - begin - lookbackJson := nil; - end; - valueJson := FResultStack.Pop; - seriesJson := FResultStack.Pop; - - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('AddSeriesItem')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('series', seriesJson); - obj.AddPair('value', valueJson); - if Assigned(lookbackJson) then - begin - obj.AddPair('lookback', lookbackJson); - end; - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -function TAstProjectPersistence.TAstToJsonVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; -var - obj: TJSONObject; - seriesJson: TJSONValue; -begin - if FSerializedNodes.ContainsKey(Node) then - begin - var refObj := TJSONObject.Create; - refObj.AddPair('ref', TJSONNumber.Create(FIdMap[Node])); - FResultStack.Push(refObj); - Result := TAstValue.Void; - exit; - end; - FSerializedNodes.Add(Node, True); - - Node.Series.Accept(Self); - seriesJson := FResultStack.Pop; - obj := TJSONObject.Create; - obj.AddPair('type', TJSONString.Create('SeriesLength')); - obj.AddPair('id', TJSONNumber.Create(GetOrCreateNodeId(Node))); - obj.AddPair('series', seriesJson); - FResultStack.Push(obj); - Result := TAstValue.Void; -end; - -end. diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index 041ce36..0fe51bc 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -11,15 +11,17 @@ uses Myc.Ast; type + // A visitor that converts an AST into a LISP-like (Clojure-style) string representation. TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor) private FBuilder: TStringBuilder; FIndentLevel: Integer; procedure Indent; procedure Unindent; - procedure AppendLine(const S: string); + procedure Append(const S: string); + procedure NewLine; public - constructor Create(AIndentLevel: Integer = 0); + constructor Create; destructor Destroy; override; function GetResult: string; // IAstVisitor @@ -46,17 +48,15 @@ type implementation uses - Myc.Data.Scalar, - Myc.Data.Decimal; + Myc.Data.Scalar; { TPrettyPrintVisitor } -constructor TPrettyPrintVisitor.Create(AIndentLevel: Integer); +constructor TPrettyPrintVisitor.Create; begin inherited Create; FBuilder := TStringBuilder.Create; FIndentLevel := 0; - FIndentLevel := AIndentLevel; end; destructor TPrettyPrintVisitor.Destroy; @@ -72,119 +72,126 @@ end; procedure TPrettyPrintVisitor.Indent; begin - inc(FIndentLevel, 4); + inc(FIndentLevel, 2); end; procedure TPrettyPrintVisitor.Unindent; begin - dec(FIndentLevel, 4); + dec(FIndentLevel, 2); end; -procedure TPrettyPrintVisitor.AppendLine(const S: string); +procedure TPrettyPrintVisitor.Append(const S: string); begin + FBuilder.Append(S); +end; + +procedure TPrettyPrintVisitor.NewLine; +begin + FBuilder.AppendLine; FBuilder.Append(''.PadLeft(FIndentLevel)); - FBuilder.AppendLine(S); end; function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue; begin - Result := RootNode.Accept(Self); + if Assigned(RootNode) then + RootNode.Accept(Self); + Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue; +var + val: TDataValue; begin - AppendLine(Format('Constant (%s)', [Node.Value.ToString])); + val := Node.Value; + if val.Kind = vkText then + Append('"' + val.AsText + '"') + else + Append(val.ToString); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; begin - AppendLine(Format('Identifier (%s)', [Node.Name])); + Append(Node.Name); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; begin - AppendLine(Format('BinaryExpr "%s"', [Node.Operator.ToString])); - Indent; + Append('(' + Node.Operator.ToString); + Append(' '); Node.Left.Accept(Self); + Append(' '); Node.Right.Accept(Self); - Unindent; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; begin - AppendLine(Format('UnaryExpr "%s"', [Node.Operator.ToString])); - Indent; + Append('(' + Node.Operator.ToString); + Append(' '); Node.Right.Accept(Self); - Unindent; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; begin - AppendLine('IfExpr'); - Indent; - AppendLine('Condition:'); - Indent; + Append('(if '); Node.Condition.Accept(Self); - Unindent; - AppendLine('Then:'); Indent; + NewLine; Node.ThenBranch.Accept(Self); - Unindent; - if Node.ElseBranch <> nil then + if Assigned(Node.ElseBranch) then begin - AppendLine('Else:'); - Indent; + NewLine; Node.ElseBranch.Accept(Self); - Unindent; end; Unindent; + NewLine; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; begin - AppendLine('TernaryExpr'); - Indent; - AppendLine('Condition:'); - Indent; + Append('(if '); Node.Condition.Accept(Self); - Unindent; - AppendLine('Then:'); Indent; + NewLine; Node.ThenBranch.Accept(Self); - Unindent; - AppendLine('Else:'); - Indent; + NewLine; Node.ElseBranch.Accept(Self); Unindent; - Unindent; + NewLine; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; var param: IIdentifierNode; - paramNames: TStringList; + sb: TStringBuilder; begin - paramNames := TStringList.Create; + sb := TStringBuilder.Create; try for param in Node.Parameters do - paramNames.Add(param.Name); - AppendLine(Format('Lambda (params: %s)', [paramNames.CommaText])); + sb.Append(param.Name + ' '); + if sb.Length > 0 then + sb.Remove(sb.Length - 1, 1); + + Append('(fn [' + sb.ToString + ']'); finally - paramNames.Free; + sb.Free; end; Indent; - AppendLine('Body:'); - Indent; + NewLine; Node.Body.Accept(Self); Unindent; - Unindent; + NewLine; + Append(')'); Result := TDataValue.Void; end; @@ -192,18 +199,21 @@ function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): T var arg: IAstNode; begin - AppendLine('FunctionCall'); - Indent; - AppendLine('Callee:'); - Indent; + Append('('); Node.Callee.Accept(Self); - Unindent; - AppendLine('Arguments:'); + Indent; for arg in Node.Arguments do + begin + NewLine; arg.Accept(Self); + end; Unindent; - Unindent; + + if Length(Node.Arguments) > 0 then + NewLine; + + Append(')'); Result := TDataValue.Void; end; @@ -211,14 +221,17 @@ function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; var arg: IAstNode; begin - AppendLine('Recur'); - Indent; - AppendLine('Arguments:'); + Append('(recur'); Indent; for arg in Node.Arguments do + begin + NewLine; arg.Accept(Self); + end; Unindent; - Unindent; + if Length(Node.Arguments) > 0 then + NewLine; + Append(')'); Result := TDataValue.Void; end; @@ -226,102 +239,88 @@ function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNo var expr: IAstNode; begin - AppendLine('Block'); + Append('(do'); Indent; for expr in Node.Expressions do + begin + NewLine; expr.Accept(Self); + end; Unindent; + NewLine; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; begin - AppendLine(Format('VarDecl (%s)', [Node.Identifier.Name])); + Append('(def '); + Node.Identifier.Accept(Self); if Assigned(Node.Initializer) then begin - Indent; + Append(' '); Node.Initializer.Accept(Self); - Unindent; end; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin - // Print the assignment node. - AppendLine(Format('Assignment (%s)', [Node.Identifier.Name])); - Indent; + Append('(assign '); + Node.Identifier.Accept(Self); + Append(' '); Node.Value.Accept(Self); - Unindent; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue; begin - AppendLine('Indexer'); - Indent; - AppendLine('Base:'); - Indent; + Append('(get '); Node.Base.Accept(Self); - Unindent; - AppendLine('Index:'); - Indent; + Append(' '); Node.Index.Accept(Self); - Unindent; - Unindent; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; begin - AppendLine(Format('MemberAccess (Member: %s)', [Node.Member.Name])); - Indent; - AppendLine('Base:'); - Indent; + Append('(.'); + Node.Member.Accept(Self); + Append(' '); Node.Base.Accept(Self); - Unindent; - Unindent; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; begin - AppendLine('CreateSeries'); - Indent; - AppendLine('Definition: ' + Node.Definition); - Unindent; + Append(Format('(new-series "%s")', [Node.Definition])); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; begin - AppendLine('AddSeriesItem'); - Indent; - AppendLine('Series:'); - Indent; + Append('(add-item '); Node.Series.Accept(Self); - Unindent; - AppendLine('Value:'); - Indent; + Append(' '); Node.Value.Accept(Self); - Unindent; if Assigned(Node.Lookback) then begin - AppendLine('Lookback:'); - Indent; + Append(' '); Node.Lookback.Accept(Self); - Unindent; end; - Unindent; + Append(')'); Result := TDataValue.Void; end; function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; begin - AppendLine('SeriesLength'); - Indent; + Append('(count '); Node.Series.Accept(Self); - Unindent; + Append(')'); Result := TDataValue.Void; end; diff --git a/Src/AST/Myc.Ast.RTL.Core.pas b/Src/AST/Myc.Ast.RTL.Core.pas index 77a1fd3..2f51874 100644 --- a/Src/AST/Myc.Ast.RTL.Core.pas +++ b/Src/AST/Myc.Ast.RTL.Core.pas @@ -60,13 +60,9 @@ uses class function TRtlFunctions.Abs(const Arg: TScalar): TScalar; begin case Arg.Kind of - skInteger: Result := TScalar.FromInteger(System.Abs(Arg.Value.AsInteger)); - skInt64: Result := TScalar.FromInt64(System.Abs(Arg.Value.AsInt64)); - skSingle: Result := TScalar.FromSingle(System.Abs(Arg.Value.AsSingle)); - skDouble: Result := TScalar.FromDouble(System.Abs(Arg.Value.AsDouble)); - skDecimal: Result := TScalar.FromDecimal(Arg.Value.AsDecimal.Abs); + TScalar.TKind.Ordinal: Result := TScalar.FromInt64(System.Abs(Arg.Value.AsInt64)); + TScalar.TKind.Float: Result := TScalar.FromDouble(System.Abs(Arg.Value.AsDouble)); else - // This case should not be reached if the wrapper validation is correct. raise EArgumentException.Create('Abs requires a numeric argument.'); end; end; @@ -74,10 +70,8 @@ end; class function TRtlFunctions.Trunc(const Arg: TScalar): TScalar; begin case Arg.Kind of - skInteger, skInt64: Result := Arg; // Trunc on an integer is a no-op - skSingle: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsSingle)); - skDouble: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDouble)); - skDecimal: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDecimal)); + TScalar.TKind.Ordinal: Result := Arg; // Trunc on an integer is a no-op + TScalar.TKind.Float: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDouble)); else raise EArgumentException.Create('Trunc requires a numeric argument.'); end; @@ -86,10 +80,8 @@ end; class function TRtlFunctions.Ceil(const Arg: TScalar): TScalar; begin case Arg.Kind of - skInteger, skInt64: Result := Arg; // Ceil on an integer is a no-op - skSingle: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsSingle)); - skDouble: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsDouble)); - skDecimal: Result := TScalar.FromInt64(System.Math.Ceil(Double(Arg.Value.AsDecimal))); + TScalar.TKind.Ordinal: Result := Arg; // Ceil on an integer is a no-op + TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsDouble)); else raise EArgumentException.Create('Ceil requires a numeric argument.'); end; @@ -98,10 +90,8 @@ end; class function TRtlFunctions.Floor(const Arg: TScalar): TScalar; begin case Arg.Kind of - skInteger, skInt64: Result := Arg; // Floor on an integer is a no-op - skSingle: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsSingle)); - skDouble: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsDouble)); - skDecimal: Result := TScalar.FromInt64(System.Math.Floor(Double(Arg.Value.AsDecimal))); + TScalar.TKind.Ordinal: Result := Arg; // Floor on an integer is a no-op + TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsDouble)); else raise EArgumentException.Create('Floor requires a numeric argument.'); end; @@ -110,11 +100,8 @@ end; class function TRtlFunctions.Sign(const Arg: TScalar): TScalar; begin case Arg.Kind of - skInteger: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsInteger)); - skInt64: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsInt64)); - skSingle: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsSingle)); - skDouble: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsDouble)); - skDecimal: Result := TScalar.FromInteger(Arg.Value.AsDecimal.Sign); + TScalar.TKind.Ordinal: Result := TScalar.FromInt64(System.Math.Sign(Arg.Value.AsInt64)); + TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Sign(Arg.Value.AsDouble)); else raise EArgumentException.Create('Sign requires a numeric argument.'); end; @@ -145,13 +132,10 @@ begin raise EArgumentException.Create('This memoized function can only be called with a single scalar argument.'); argScalar := AArgs[0].AsScalar; - if not (argScalar.Kind in [skInteger, skInt64]) then - raise EArgumentException.Create('This memoized function expects an integer argument for caching.'); + if argScalar.Kind <> TScalar.TKind.Ordinal then + raise EArgumentException.Create('This memoized function expects an ordinal argument for caching.'); - if argScalar.Kind = skInteger then - key := argScalar.Value.AsInteger - else - key := argScalar.Value.AsInt64; + key := argScalar.Value.AsInt64; var cache := cCache.AsObject as TDictionary; @@ -248,7 +232,9 @@ begin begin item := sourceSeries.Items[i]; predicateResult := predicateFunc([TDataValue(item)]); - if (predicateResult.Kind = vkScalar) and (predicateResult.AsScalar.Value.AsBoolean) then + if (predicateResult.Kind = vkScalar) + and (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal) + and (predicateResult.AsScalar.Value.AsInt64 <> 0) then matchingIndices.Add(i); end; @@ -262,7 +248,7 @@ begin var idx: Integer; begin - idx := AArgs[0].AsScalar.Value.AsInteger; + idx := AArgs[0].AsScalar.Value.AsInt64; Result := TDataValue(sourceSeries.Items[idx]); end; @@ -297,14 +283,16 @@ begin item := sourceSeries.Items[i]; predicateResult := predicateFunc([TDataValue(item)]); - if (predicateResult.Kind = vkScalar) and (predicateResult.AsScalar.Value.AsBoolean) then + if (predicateResult.Kind = vkScalar) + and (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal) + and (predicateResult.AsScalar.Value.AsInt64 <> 0) then begin - Result := TScalar.FromBoolean(True); + Result := TScalar.FromInt64(1); exit; end; end; - Result := TScalar.FromBoolean(False); + Result := TScalar.FromInt64(0); end; end. diff --git a/Src/AST/Myc.Ast.RTL.pas b/Src/AST/Myc.Ast.RTL.pas index d428583..a8c2300 100644 --- a/Src/AST/Myc.Ast.RTL.pas +++ b/Src/AST/Myc.Ast.RTL.pas @@ -69,9 +69,8 @@ begin 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]); - + // The check for specific numeric kinds is no longer necessary, + // as TScalar can only be Ordinal or Float. Result := True; end; diff --git a/Src/AST/Myc.Ast.Script.pas b/Src/AST/Myc.Ast.Script.pas new file mode 100644 index 0000000..b9cd5b4 --- /dev/null +++ b/Src/AST/Myc.Ast.Script.pas @@ -0,0 +1,699 @@ +unit Myc.Ast.Script; + +interface + +uses + System.SysUtils, + Myc.Ast.Nodes; + +type + // Provides a high-level facade for parsing and printing the AST. + TAstScript = record + public + class function Parse(const ASource: string): IAstNode; static; + class function Print(const ANode: IAstNode): string; static; + end; + +implementation + +uses + System.Classes, + System.Generics.Collections, + System.Character, + System.Math, + Myc.Data.Scalar, + Myc.Data.Value, + Myc.Ast; + +type + + // --- Internal Parser Implementation --- + + TTokenKind = ( + tkLeftParen, // ( + tkRightParen, // ) + tkLeftBracket, // [ + tkRightBracket, // ] + tkIdentifier, + tkNumber, + tkString, + tkEOF, + tkError + ); + + TToken = record + Kind: TTokenKind; + Text: string; + end; + + TLexer = class + private + FSource: string; + FCurrentPos: Integer; + function Peek: Char; + procedure Advance; + function ReadNumber: string; + function ReadString: string; + function ReadIdentifier: string; + public + constructor Create(const ASource: string); + function GetNextToken: TToken; + end; + + TExpr = record + Token: TToken; + Node: IAstNode; + end; + + TParser = class + private + FLexer: TLexer; + FCurrentToken: TToken; + procedure Consume(AExpectedKind: TTokenKind); + procedure NextToken; + function ParseList: IAstNode; + function ParseParameterList: TArray; + function ParseExpression: TExpr; + public + constructor Create(const ASource: string); + destructor Destroy; override; + function Parse: IAstNode; + end; + + // --- Internal Printer Implementation --- + + TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor) + private + FBuilder: TStringBuilder; + FIndentLevel: Integer; + procedure Indent; + procedure Unindent; + procedure Append(const S: string); + procedure NewLine; + public + constructor Create; + destructor Destroy; override; + function GetResult: string; + // IAstVisitor + function Execute(const RootNode: IAstNode): TDataValue; + function VisitConstant(const Node: IConstantNode): TDataValue; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; + function VisitIndexer(const Node: IIndexerNode): TDataValue; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; + function VisitRecurNode(const Node: IRecurNode): TDataValue; + end; + +{ TLexer } + +constructor TLexer.Create(const ASource: string); +begin + inherited Create; + FSource := ASource; + FCurrentPos := 1; +end; + +function TLexer.Peek: Char; +begin + if FCurrentPos > Length(FSource) then + Result := #0 + else + Result := FSource[FCurrentPos]; +end; + +procedure TLexer.Advance; +begin + inc(FCurrentPos); +end; + +function TLexer.ReadIdentifier: string; +var + startPos: Integer; +begin + startPos := FCurrentPos; + // Corrected W1050: Use CharInSet for robust unicode support. + while (Peek <> #0) and (not (Peek.IsWhiteSpace or CharInSet(Peek, ['(', ')', '[', ']']))) do + Advance; + Result := Copy(FSource, startPos, FCurrentPos - startPos); +end; + +function TLexer.ReadNumber: string; +var + startPos: Integer; +begin + startPos := FCurrentPos; + while (Peek <> #0) and (Peek.IsDigit or (Peek = '.')) do + Advance; + Result := Copy(FSource, startPos, FCurrentPos - startPos); +end; + +function TLexer.ReadString: string; +var + startPos: Integer; +begin + Advance; // Skip opening " + startPos := FCurrentPos; + while (Peek <> #0) and (Peek <> '"') do + Advance; + Result := Copy(FSource, startPos, FCurrentPos - startPos); + if Peek = '"' then + Advance; // Skip closing " +end; + +function TLexer.GetNextToken: TToken; +begin + while (FCurrentPos <= Length(FSource)) and FSource[FCurrentPos].IsWhiteSpace do + Advance; + + if FCurrentPos > Length(FSource) then + begin + Result.Kind := tkEOF; + exit; + end; + + var c := Peek; + case c of + '(': + begin + Result.Kind := tkLeftParen; + Advance; + end; + ')': + begin + Result.Kind := tkRightParen; + Advance; + end; + '[': + begin + Result.Kind := tkLeftBracket; + Advance; + end; + ']': + begin + Result.Kind := tkRightBracket; + Advance; + end; + '"': + begin + Result.Kind := tkString; + Result.Text := ReadString; + end; + else + if c.IsDigit or ((c = '-') and (FCurrentPos < Length(FSource)) and FSource[FCurrentPos + 1].IsDigit) then + begin + Result.Kind := tkNumber; + Result.Text := ReadNumber; + end + else + begin + Result.Kind := tkIdentifier; + Result.Text := ReadIdentifier; + end; + end; +end; + +{ TParser } + +constructor TParser.Create(const ASource: string); +begin + inherited Create; + FLexer := TLexer.Create(ASource); + NextToken; // Load the first token +end; + +destructor TParser.Destroy; +begin + FLexer.Free; + inherited; +end; + +procedure TParser.NextToken; +begin + FCurrentToken := FLexer.GetNextToken; +end; + +procedure TParser.Consume(AExpectedKind: TTokenKind); +begin + if FCurrentToken.Kind <> AExpectedKind then + raise Exception.CreateFmt('Syntax Error: Expected token %d, but found %d', [Ord(AExpectedKind), Ord(FCurrentToken.Kind)]); + NextToken; +end; + +function TParser.ParseParameterList: TArray; +var + params: TList; +begin + Consume(tkLeftBracket); + params := TList.Create; + try + while FCurrentToken.Kind <> tkRightBracket do + begin + if FCurrentToken.Kind <> tkIdentifier then + raise Exception.Create('Syntax Error: Expected identifier in parameter list.'); + params.Add(TAst.Identifier(FCurrentToken.Text)); + NextToken; + end; + Result := params.ToArray; + finally + params.Free; + end; + Consume(tkRightBracket); +end; + +function TParser.ParseList: IAstNode; + + function IfThen(cond: Boolean; const TrueBranch, FalseBranch: IAstNode): IAstNode; + begin + if cond then + exit(TrueBranch) + else + exit(FalseBranch); + end; + +var + elements: TList; + head: TExpr; + headIdent: IIdentifierNode; + tailTokens: TArray; + tailNodes: TArray; +begin + Consume(tkLeftParen); + if FCurrentToken.Kind = tkRightParen then + raise Exception.Create('Syntax Error: Empty list () is not a valid expression.'); + + elements := TList.Create; + try + while FCurrentToken.Kind <> tkRightParen do + elements.Add(ParseExpression); + + head := elements[0]; + + // Convert the rest of the list to an array for the factory functions + SetLength(tailTokens, elements.Count - 1); + SetLength(tailNodes, elements.Count - 1); + for var i := 0 to High(tailNodes) do + begin + tailTokens[i] := elements[i + 1].Token; + tailNodes[i] := elements[i + 1].Node; + end; + + if head.Token.Kind = tkIdentifier then + begin + // Handle special forms + if SameText(headIdent.Name, 'if') then + Result := TAst.IfExpr(tailNodes[0], tailNodes[1], IfThen(Length(tailNodes) > 2, tailNodes[2], nil)) + else if SameText(headIdent.Name, 'def') then + begin + var identNode: IIdentifierNode; + if tailTokens[0].Kind <> tkIdentifier then + raise Exception.Create('Syntax Error: Expected an identifier for def statement.'); + Result := TAst.VarDecl(identNode, IfThen(Length(tailNodes) > 1, tailNodes[1], nil)); + end + else if SameText(headIdent.Name, 'assign') then + begin + var identNode: IIdentifierNode; + if tailTokens[0].Kind <> tkIdentifier then + raise Exception.Create('Syntax Error: Expected an identifier for assignment.'); + Result := TAst.Assign(identNode, tailNodes[1]); + end + else if SameText(headIdent.Name, 'fn') then + Result := TAst.LambdaExpr(ParseParameterList, tailNodes[0]) // Special parsing for params + else if SameText(headIdent.Name, 'do') then + Result := TAst.Block(tailNodes) + else if SameText(headIdent.Name, 'recur') then + Result := TAst.Recur(tailNodes) + else if SameText(headIdent.Name, 'get') then + Result := TAst.Indexer(tailNodes[0], tailNodes[1]) + else if (Length(headIdent.Name) > 1) and (headIdent.Name.StartsWith('.')) then + Result := TAst.MemberAccess(tailNodes[0], TAst.Identifier(headIdent.Name.Substring(1))) + else + Result := TAst.FunctionCall(head.Node, tailNodes); // Default is a function call + end + else + Result := TAst.FunctionCall(head.Node, tailNodes); // Callee is a complex expression, e.g. ((fn [x] x) 1) + + finally + elements.Free; + end; + + Consume(tkRightParen); +end; + +function TParser.ParseExpression: TExpr; +var + i64: Int64; + dbl: Double; +begin + Result.Token := FCurrentToken; + case FCurrentToken.Kind of + tkNumber: + begin + if TryStrToInt64(FCurrentToken.Text, i64) then + Result.Node := TAst.Constant(i64) + else if TryStrToFloat(FCurrentToken.Text, dbl) then + Result.Node := TAst.Constant(dbl) + else + raise Exception.CreateFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]); + NextToken; + end; + tkString: + begin + Result.Node := TAst.Constant(FCurrentToken.Text); + NextToken; + end; + tkIdentifier: + begin + Result.Node := TAst.Identifier(FCurrentToken.Text); + NextToken; + end; + tkLeftParen: Result.Node := ParseList; + else + raise Exception.CreateFmt('Syntax Error: Unexpected token %d', [Ord(FCurrentToken.Kind)]); + end; +end; + +function TParser.Parse: IAstNode; +begin + var expr := ParseExpression; + if expr.Token.Kind <> tkEOF then + raise Exception.Create('Syntax Error: Unexpected characters after end of expression.'); + Result := expr.Node; +end; + +{ TPrettyPrintVisitor } +// ... (Implementation of TPrettyPrintVisitor is unchanged and correct) ... +constructor TPrettyPrintVisitor.Create; +begin + inherited Create; + FBuilder := TStringBuilder.Create; + FIndentLevel := 0; +end; + +destructor TPrettyPrintVisitor.Destroy; +begin + FBuilder.Free; + inherited Destroy; +end; + +function TPrettyPrintVisitor.GetResult: string; +begin + Result := FBuilder.ToString; +end; + +procedure TPrettyPrintVisitor.Indent; +begin + inc(FIndentLevel, 2); +end; + +procedure TPrettyPrintVisitor.Unindent; +begin + dec(FIndentLevel, 2); +end; + +procedure TPrettyPrintVisitor.Append(const S: string); +begin + FBuilder.Append(S); +end; + +procedure TPrettyPrintVisitor.NewLine; +begin + FBuilder.AppendLine; + FBuilder.Append(''.PadLeft(FIndentLevel)); +end; + +function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue; +begin + if Assigned(RootNode) then + RootNode.Accept(Self); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue; +var + val: TDataValue; +begin + val := Node.Value; + if val.Kind = vkText then + Append('"' + val.AsText + '"') + else + Append(val.ToString); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; +begin + Append(Node.Name); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; +begin + Append('(' + Node.Operator.ToString); + Append(' '); + Node.Left.Accept(Self); + Append(' '); + Node.Right.Accept(Self); + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; +begin + Append('(' + Node.Operator.ToString); + Append(' '); + Node.Right.Accept(Self); + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; +begin + Append('(if '); + Node.Condition.Accept(Self); + Indent; + NewLine; + Node.ThenBranch.Accept(Self); + if Assigned(Node.ElseBranch) then + begin + NewLine; + Node.ElseBranch.Accept(Self); + end; + Unindent; + NewLine; + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; +begin + Append('(if '); + Node.Condition.Accept(Self); + Indent; + NewLine; + Node.ThenBranch.Accept(Self); + NewLine; + Node.ElseBranch.Accept(Self); + Unindent; + NewLine; + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; +var + param: IIdentifierNode; + sb: TStringBuilder; +begin + sb := TStringBuilder.Create; + try + for param in Node.Parameters do + sb.Append(param.Name + ' '); + if sb.Length > 0 then + sb.Remove(sb.Length - 1, 1); // remove trailing space + + Append('(fn [' + sb.ToString + ']'); + finally + sb.Free; + end; + + Indent; + NewLine; + Node.Body.Accept(Self); + Unindent; + NewLine; + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; +var + arg: IAstNode; +begin + Append('('); + Node.Callee.Accept(Self); + + Indent; + for arg in Node.Arguments do + begin + NewLine; + arg.Accept(Self); + end; + Unindent; + + if Length(Node.Arguments) > 0 then + NewLine; + + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; +var + arg: IAstNode; +begin + Append('(recur'); + Indent; + for arg in Node.Arguments do + begin + NewLine; + arg.Accept(Self); + end; + Unindent; + if Length(Node.Arguments) > 0 then + NewLine; + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; +var + expr: IAstNode; +begin + Append('(do'); + Indent; + for expr in Node.Expressions do + begin + NewLine; + expr.Accept(Self); + end; + Unindent; + NewLine; + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; +begin + Append('(def '); + Node.Identifier.Accept(Self); + if Assigned(Node.Initializer) then + begin + Append(' '); + Node.Initializer.Accept(Self); + end; + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; +begin + Append('(assign '); + Node.Identifier.Accept(Self); + Append(' '); + Node.Value.Accept(Self); + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue; +begin + Append('(get '); + Node.Base.Accept(Self); + Append(' '); + Node.Index.Accept(Self); + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; +begin + Append('(.'); + Node.Member.Accept(Self); + Append(' '); + Node.Base.Accept(Self); + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; +begin + Append(Format('(new-series "%s")', [Node.Definition])); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; +begin + Append('(add-item '); + Node.Series.Accept(Self); + Append(' '); + Node.Value.Accept(Self); + if Assigned(Node.Lookback) then + begin + Append(' '); + Node.Lookback.Accept(Self); + end; + Append(')'); + Result := TDataValue.Void; +end; + +function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; +begin + Append('(count '); + Node.Series.Accept(Self); + Append(')'); + Result := TDataValue.Void; +end; + +{ TAstScript } + +class function TAstScript.Parse(const ASource: string): IAstNode; +var + p: TParser; +begin + if ASource.Trim.IsEmpty then + exit(nil); + p := TParser.Create(ASource); + try + Result := p.Parse; + finally + p.Free; + end; +end; + +class function TAstScript.Print(const ANode: IAstNode): string; +var + visitor: TPrettyPrintVisitor; +begin + if not Assigned(ANode) then + exit(''); + visitor := TPrettyPrintVisitor.Create; + try + visitor.Execute(ANode); + Result := visitor.GetResult; + finally + visitor.Free; + end; +end; + +end. diff --git a/Src/AST/Myc.Ast.ViewModel.pas b/Src/AST/Myc.Ast.ViewModel.pas deleted file mode 100644 index 56ebb69..0000000 --- a/Src/AST/Myc.Ast.ViewModel.pas +++ /dev/null @@ -1,102 +0,0 @@ -unit Myc.Ast.ViewModel; - -interface - -uses - System.SysUtils, - System.Types, - System.Generics.Collections, - Myc.Ast.Nodes; - -type - // An enum to identify the specific type of an AST node without relying on RTTI or GUIDs. - // This allows the renderer to depend only on the ViewModel layer. - TAstNodeType = ( - antUndefined, - antConstant, - antIdentifier, - antBinaryExpression, - antUnaryExpression, - antIfExpression, - antTernaryExpression, - antLambdaExpression, - antFunctionCall, - antBlockExpression, - antVariableDeclaration, - antAssignment, - antIndexer, - antMemberAccess, - antCreateSeries, - antAddSeriesItem, - antSeriesLength - ); - - // A unique, stable identifier for a visual node instance. - TViewModelID = NativeInt; - - // Defines how a view model displays its children. - TVisualizationMode = (vmSyntactic, vmSemantic); - - // Metadata tied to a logical IAstNode. All visual instances of this node will share this data. - TLogicalMetadata = record - // The concrete type of the IAstNode, used for type-safe operations in the renderer. - NodeType: TAstNodeType; - Description: String; - end; - - // Metadata tied to a specific visual instance of a node, identified by its TViewModelID. - TVisualInstanceMetadata = record - PositionOverride: TPointF; - IsCollapsed: Boolean; - VisualizationMode: TVisualizationMode; - end; - - // The ViewModel for a node in the visual graph. - TVisualNodeViewModel = class - private - FId: TViewModelID; - FNode: IAstNode; - FLogicalMetadata: TLogicalMetadata; - FParents: TList; - FChildren: TList; - public - constructor Create(const ANode: IAstNode; const AId: TViewModelID; const ALogicalMetadata: TLogicalMetadata); - destructor Destroy; override; - - procedure AddChild(const AChild: TVisualNodeViewModel); - - property Id: TViewModelID read FId; - property Node: IAstNode read FNode; - property LogicalMetadata: TLogicalMetadata read FLogicalMetadata; - property Children: TList read FChildren; - property Parents: TList read FParents; - end; - -implementation - -{ TVisualNodeViewModel } - -constructor TVisualNodeViewModel.Create(const ANode: IAstNode; const AId: TViewModelID; const ALogicalMetadata: TLogicalMetadata); -begin - inherited Create; - FNode := ANode; - FId := AId; - FLogicalMetadata := ALogicalMetadata; - FParents := TList.Create; - FChildren := TList.Create; -end; - -destructor TVisualNodeViewModel.Destroy; -begin - FParents.Free; - FChildren.Free; - inherited; -end; - -procedure TVisualNodeViewModel.AddChild(const AChild: TVisualNodeViewModel); -begin - FChildren.Add(AChild); - AChild.FParents.Add(Self); -end; - -end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index dce8aa4..d958402 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -28,10 +28,12 @@ type class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static; // --- Existing factory functions --- - class function Constant(AValue: TScalar): IConstantNode; static; + class function Constant(const AValue: TDataValue): IConstantNode; overload; static; + class function Constant(const AValue: TScalar): IConstantNode; overload; static; + class function Constant(const AValue: String): IConstantNode; overload; static; class function Identifier(AName: string): IIdentifierNode; static; - class function BinaryExpr(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode): IBinaryExpressionNode; static; - class function UnaryExpr(const AOperator: TUnaryOperator; const ARight: IAstNode): IUnaryExpressionNode; static; + class function BinaryExpr(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode): IBinaryExpressionNode; static; + class function UnaryExpr(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode): IUnaryExpressionNode; static; class function IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode; static; class function TernaryExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): ITernaryExpressionNode; static; class function LambdaExpr(const AParameters: TArray; const ABody: IAstNode): ILambdaExpressionNode; static; @@ -60,10 +62,10 @@ type TConstantNode = class(TAstNode, IConstantNode) private - FValue: TScalar; - function GetValue: TScalar; + FValue: TDataValue; + function GetValue: TDataValue; public - constructor Create(AValue: TScalar); + constructor Create(const AValue: TDataValue); function Accept(const Visitor: IAstVisitor): TDataValue; override; end; @@ -84,24 +86,24 @@ type TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode) private FLeft: IAstNode; - FOperator: TBinaryOperator; + FOperator: TScalar.TBinaryOp; FRight: IAstNode; function GetLeft: IAstNode; - function GetOperator: TBinaryOperator; + function GetOperator: TScalar.TBinaryOp; function GetRight: IAstNode; public - constructor Create(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode); + constructor Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode); function Accept(const Visitor: IAstVisitor): TDataValue; override; end; TUnaryExpressionNode = class(TAstNode, IUnaryExpressionNode) private - FOperator: TUnaryOperator; + FOperator: TScalar.TUnaryOp; FRight: IAstNode; - function GetOperator: TUnaryOperator; + function GetOperator: TScalar.TUnaryOp; function GetRight: IAstNode; public - constructor Create(const AOperator: TUnaryOperator; const ARight: IAstNode); + constructor Create(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode); function Accept(const Visitor: IAstVisitor): TDataValue; override; end; @@ -269,9 +271,12 @@ uses { TConstantNode } -constructor TConstantNode.Create(AValue: TScalar); +constructor TConstantNode.Create(const AValue: TDataValue); begin inherited Create; + // Validate that only allowed constant kinds are used. + if not (AValue.Kind in [vkScalar, vkText, vkVoid]) then + raise EArgumentException.Create('IConstantNode only supports Scalar, Text, and Void values.'); FValue := AValue; end; @@ -280,7 +285,7 @@ begin Result := Visitor.VisitConstant(Self); end; -function TConstantNode.GetValue: TScalar; +function TConstantNode.GetValue: TDataValue; begin Result := FValue; end; @@ -310,7 +315,7 @@ end; { TBinaryExpressionNode } -constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode); +constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode); begin inherited Create; FLeft := ALeft; @@ -328,7 +333,7 @@ begin Result := FLeft; end; -function TBinaryExpressionNode.GetOperator: TBinaryOperator; +function TBinaryExpressionNode.GetOperator: TScalar.TBinaryOp; begin Result := FOperator; end; @@ -340,7 +345,7 @@ end; { TUnaryExpressionNode } -constructor TUnaryExpressionNode.Create(const AOperator: TUnaryOperator; const ARight: IAstNode); +constructor TUnaryExpressionNode.Create(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode); begin inherited Create; FOperator := AOperator; @@ -352,7 +357,7 @@ begin Result := Visitor.VisitUnaryExpression(Self); end; -function TUnaryExpressionNode.GetOperator: TUnaryOperator; +function TUnaryExpressionNode.GetOperator: TScalar.TUnaryOp; begin Result := FOperator; end; @@ -743,17 +748,27 @@ begin Result := TBlockExpressionNode.Create(AExpressions); end; -class function TAst.Constant(AValue: TScalar): IConstantNode; +class function TAst.Constant(const AValue: TDataValue): IConstantNode; begin Result := TConstantNode.Create(AValue); end; +class function TAst.Constant(const AValue: TScalar): IConstantNode; +begin + Result := TConstantNode.Create(TDataValue(AValue)); +end; + +class function TAst.Constant(const AValue: String): IConstantNode; +begin + Result := TConstantNode.Create(TDataValue(AValue)); +end; + class function TAst.CreateSeries(const ADefinition: String): ICreateSeriesNode; begin Result := TCreateSeriesNode.Create(ADefinition); end; -class function TAst.BinaryExpr(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode): IBinaryExpressionNode; +class function TAst.BinaryExpr(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode): IBinaryExpressionNode; begin Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight); end; @@ -823,7 +838,7 @@ begin Result := TLambdaExpressionNode.Create(AParameters, ABody); end; -class function TAst.UnaryExpr(const AOperator: TUnaryOperator; const ARight: IAstNode): IUnaryExpressionNode; +class function TAst.UnaryExpr(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode): IUnaryExpressionNode; begin Result := TUnaryExpressionNode.Create(AOperator, ARight); end; diff --git a/Src/Data/Myc.Data.Scalar.JSON.pas b/Src/Data/Myc.Data.Scalar.JSON.pas index ab71966..2bbd06b 100644 --- a/Src/Data/Myc.Data.Scalar.JSON.pas +++ b/Src/Data/Myc.Data.Scalar.JSON.pas @@ -12,8 +12,8 @@ uses type TRttiAstHelper = class private - // Maps a Delphi RTTI type to its TScalarKind. - class function TypeToScalarKind(AType: TRttiType): TScalarKind; static; + // Maps a Delphi RTTI type to its TScalar.TKind. + class function TypeToScalarKind(AType: TRttiType): TScalar.TKind; static; public // Creates a JSON definition string from a record type info. class function RecordDefinitionToJson: string; static; @@ -43,7 +43,6 @@ begin exit; try - // The root element is expected to be a JSON array directly. if not (jsonValue is TJSONArray) then exit; @@ -54,12 +53,11 @@ begin begin fieldObj := fieldsArray.Items[i] as TJSONObject; if not Assigned(fieldObj) then - continue; // or raise error + continue; fields[i].Name := fieldObj.GetValue('name'); - kindStr := fieldObj.GetValue('kind'); - fields[i].Kind := TScalarKind(GetEnumValue(TypeInfo(TScalarKind), kindStr)); + fields[i].Kind := TScalar.TKind(GetEnumValue(TypeInfo(TScalar.TKind), kindStr)); end; Result := TScalarRecordDefinition.Create(fields); finally @@ -84,54 +82,43 @@ begin rttiRecordType := rttiType as TRttiRecordType; - // The root element is now the array itself. fieldsArray := TJSONArray.Create; try for field in rttiRecordType.GetFields do begin fieldObj := TJSONObject.Create; fieldObj.AddPair('name', TJSONString.Create(field.Name)); - fieldObj.AddPair('kind', TJSONString.Create(GetEnumName(TypeInfo(TScalarKind), Ord(TypeToScalarKind(field.FieldType))))); + fieldObj.AddPair('kind', TJSONString.Create(GetEnumName(TypeInfo(TScalar.TKind), Ord(TypeToScalarKind(field.FieldType))))); fieldsArray.Add(fieldObj); end; - // Convert the array directly to a JSON string. Result := fieldsArray.ToJSON; finally fieldsArray.Free; end; end; -class function TRttiAstHelper.TypeToScalarKind(AType: TRttiType): TScalarKind; +class function TRttiAstHelper.TypeToScalarKind(AType: TRttiType): TScalar.TKind; var typeHandle: PTypeInfo; begin - // 1. Use a case statement or if-checks on AType.Handle. typeHandle := AType.Handle; - // 2. Compare with TypeInfo(Integer), TypeInfo(Double), TypeInfo(TDecimal) etc. - if typeHandle = TypeInfo(Integer) then - Result := skInteger - else if typeHandle = TypeInfo(Int64) then - Result := skInt64 + if typeHandle = TypeInfo(Int64) then + Result := TScalar.TKind.Ordinal + else if typeHandle = TypeInfo(Integer) then + Result := TScalar.TKind.Ordinal else if typeHandle = TypeInfo(UInt64) then - Result := skUInt64 - else if typeHandle = TypeInfo(Single) then - Result := skSingle - else if typeHandle = TypeInfo(Double) then - Result := skDouble - else if typeHandle = TypeInfo(TDateTime) then - Result := skDateTime + Result := TScalar.TKind.Ordinal else if typeHandle = TypeInfo(Boolean) then - Result := skBoolean - else if typeHandle = TypeInfo(Char) then - Result := skChar - else if typeHandle = TypeInfo(TDecimal) then - Result := skDecimal - else if typeHandle = TypeInfo(TTimestamp) then - Result := skTimestamp + Result := TScalar.TKind.Ordinal + else if typeHandle = TypeInfo(Double) then + Result := TScalar.TKind.Float + else if typeHandle = TypeInfo(Single) then + Result := TScalar.TKind.Float + else if typeHandle = TypeInfo(TDateTime) then + Result := TScalar.TKind.Float // Correctly handle TDateTime as a Float else - // 4. Raise an exception for unsupported types. raise EArgumentException.CreateFmt('Unsupported record field type: %s', [AType.Name]); end; diff --git a/Src/Data/Myc.Data.Scalar.pas b/Src/Data/Myc.Data.Scalar.pas index ca2f9df..5843d9b 100644 --- a/Src/Data/Myc.Data.Scalar.pas +++ b/Src/Data/Myc.Data.Scalar.pas @@ -7,112 +7,62 @@ uses Myc.Data.Decimal, Myc.Data.Series; +{$SCOPEDENUMS ON} + type - // POD: Plain old data (...that fits into 64 bits) - - TScalarKind = ( - skInteger, - skInt64, - skUInt64, - skSingle, - skDouble, - skDateTime, - skTimestamp, - skBoolean, - skChar, - skPChar, - skString, - skBytes, - skDecimal - ); - - TBinaryOperator = (boAdd, boSubtract, boMultiply, boDivide, boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual); - TUnaryOperator = (uoNegate, uoNot); - - TScalarBytes = array[0..7] of Byte; - TScalarPChar = array[0..3] of Char; - TScalarString = String[7]; - - TScalarValue = record - public - // Factory methods for creating a TScalarValue without a kind. - class function FromInteger(AValue: Integer): TScalarValue; static; inline; - class function FromInt64(AValue: Int64): TScalarValue; static; inline; - class function FromUInt64(AValue: UInt64): TScalarValue; static; inline; - class function FromSingle(AValue: Single): TScalarValue; static; inline; - class function FromDouble(AValue: Double): TScalarValue; static; inline; - class function FromDateTime(AValue: TDateTime): TScalarValue; static; inline; - class function FromTimestamp(AValue: TTimestamp): TScalarValue; static; inline; - class function FromBoolean(AValue: Boolean): TScalarValue; static; inline; - class function FromDecimal(AValue: TDecimal): TScalarValue; static; inline; - class function FromChar(AValue: Char): TScalarValue; static; inline; - class function FromPChar(const AValue: String): TScalarValue; overload; static; inline; - class function FromPChar(const AValue: TScalarPChar): TScalarValue; overload; static; inline; - class function FromString(const AValue: String): TScalarValue; overload; static; inline; - class function FromString(const AValue: TScalarString): TScalarValue; overload; static; inline; - class function FromBytes(const AValue: TScalarBytes): TScalarValue; static; inline; - - // Direct field access for performance. - case TScalarKind of - skInteger: (AsInteger: Integer); - skInt64: (AsInt64: Int64); - skUInt64: (AsUInt64: UInt64); - skSingle: (AsSingle: Single); - skDouble: (AsDouble: Double); - skDateTime: (AsDateTime: TDateTime); - skTimestamp: (AsTimestamp: TTimestamp); - skBoolean: (AsBoolean: Boolean); - skChar: (AsChar: Char); - skPChar: (AsPChar: TScalarPChar); - skString: (AsString: String[7]); - skBytes: (AsBytes: TScalarBytes); - skDecimal: (AsDecimal: TDecimal); - end; - // A scalar value with a type identifier. TScalar = record public - Kind: TScalarKind; - Value: TScalarValue; + type + TKind = (Ordinal, Float); + + TValue = record + case TKind of + TKind.Ordinal: (AsInt64: Int64); + TKind.Float: (AsDouble: Double); + end; + + TBinaryOp = (Add, Subtract, Multiply, Divide, Equal, NotEqual, Less, Greater, LessOrEqual, GreaterOrEqual); + TUnaryOp = (Negate, &Not); + + TKindHelper = record helper for TKind + public + function ToString: string; + end; + + TBinaryOpHelper = record helper for TScalar.TBinaryOp + function ToString: string; + end; + + TUnaryOpHelper = record helper for TScalar.TUnaryOp + function ToString: string; + end; + + public + Kind: TKind; + Value: TValue; // Creates a new scalar from a kind and a value. - constructor Create(AKind: TScalarKind; const AValue: TScalarValue); + constructor Create(AKind: TKind; const AValue: TValue); - // Factory methods for specific scalar types (do not use anymore, these may become deprecated in the future) - class function FromInteger(AValue: Integer): TScalar; static; inline; + // Factory methods for core types. class function FromInt64(AValue: Int64): TScalar; static; inline; - class function FromUInt64(AValue: UInt64): TScalar; static; inline; - class function FromSingle(AValue: Single): TScalar; static; inline; class function FromDouble(AValue: Double): TScalar; static; inline; - class function FromDateTime(AValue: TDateTime): TScalar; static; inline; - class function FromTimestamp(AValue: TTimestamp): TScalar; static; inline; - class function FromBoolean(AValue: Boolean): TScalar; static; inline; - class function FromChar(AValue: Char): TScalar; static; inline; - class function FromPChar(const AValue: TScalarPChar): TScalar; static; inline; - class function FromString(const AValue: String): TScalar; static; inline; - class function FromBytes(const AValue: TScalarBytes): TScalar; static; inline; - class function FromDecimal(const AValue: TDecimal): TScalar; static; inline; - // Implicit casts from primitive types to TScalar. - class operator Implicit(AValue: Integer): TScalar; overload; inline; + // Implicit casts for core types. class operator Implicit(AValue: Int64): TScalar; overload; inline; - class operator Implicit(AValue: UInt64): TScalar; overload; inline; - class operator Implicit(AValue: Single): TScalar; overload; inline; class operator Implicit(AValue: Double): TScalar; overload; inline; - class operator Implicit(AValue: TDateTime): TScalar; overload; inline; - class operator Implicit(AValue: Boolean): TScalar; overload; inline; - class operator Implicit(AValue: Char): TScalar; overload; inline; - class operator Implicit(const AValue: TDecimal): TScalar; overload; inline; - - class function StringToKind(const AName: string): TScalarKind; static; + class operator Implicit(const A: TScalar): Double; overload; + class operator Implicit(const A: TScalar): Int64; overload; + class function StringToKind(const AName: string): TKind; static; function ToString: String; - class function IsBinaryOperatorSupported(Op: TBinaryOperator; A, B: TScalarKind): Boolean; static; - class function IsUnaryOperatorSupported(Op: TUnaryOperator; A: TScalarKind): Boolean; static; + class function IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean; static; + class function IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean; static; - class function TryBinaryOperation(Op: TBinaryOperator; const A, B: TScalar; out Res: TScalar): Boolean; static; - class function TryUnaryOperation(Op: TUnaryOperator; const A: TScalar; out Res: TScalar): Boolean; static; + class function TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean; static; + class function TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean; static; class operator Add(const A, B: TScalar): TScalar; class operator Divide(const A, B: TScalar): TScalar; @@ -130,21 +80,12 @@ type class operator Trunc(const A: TScalar): TScalar; end; - TScalarKindHelper = record helper for TScalarKind - public - function ToString: string; - end; - - // Basic data structures using the scalar type (these are not POD of course) - // An array of scalar values of the same kind. TScalarArray = record public - Kind: TScalarKind; - Items: TArray; - - // Creates a new scalar array. - constructor Create(AKind: TScalarKind; const AItems: TArray); + Kind: TScalar.TKind; + Items: TArray; + constructor Create(AKind: TScalar.TKind; const AItems: TArray); end; TScalarTuple = TArray; @@ -152,8 +93,8 @@ type // A field definition for a scalar record. TScalarRecordField = record Name: String; - Kind: TScalarKind; - constructor Create(const AName: String; AKind: TScalarKind); + Kind: TScalar.TKind; + constructor Create(const AName: String; AKind: TScalar.TKind); end; TScalarRecordDefinition = record @@ -168,20 +109,16 @@ type // A record of scalar values, based on a definition. TScalarRecord = record public - // Creates a new scalar record. - constructor Create(const ADef: TScalarRecordDefinition; const AFields: TArray); - + constructor Create(const ADef: TScalarRecordDefinition; const AFields: TArray); function GetDef: TScalarRecordDefinition; inline; - function GetFields: TArray; inline; + function GetFields: TArray; inline; function GetItems(const Name: String): TScalar; - property Def: TScalarRecordDefinition read GetDef; - property Fields: TArray read GetFields; + property Fields: TArray read GetFields; property Items[const Name: String]: TScalar read GetItems; default; - strict private FDef: TScalarRecordDefinition; - FFields: TArray; + FFields: TArray; end; ISeries = interface @@ -196,23 +133,21 @@ type end; IWriteableSeries = interface(ISeries) - procedure Add(const Item: TScalarValue; Lookback: Int64 = -1); + procedure Add(const Item: TScalar.TValue; Lookback: Int64 = -1); end; // A time series of scalar records, optimized for memory and access speed. TScalarSeries = class(TInterfacedObject, ISeries, IWriteableSeries) private - FKind: TScalarKind; - FArray: TChunkArray; + FKind: TScalar.TKind; + FArray: TChunkArray; FTotalCount: Int64; - 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); + constructor Create(AKind: TScalar.TKind); + procedure Add(const Item: TScalar.TValue; Lookback: Int64 = -1); end; IRecordSeries = interface @@ -236,7 +171,7 @@ type TMemberSeries = class(TInterfacedObject, ISeries) private FRecordSeries: TScalarRecordSeries; - FKind: TScalarKind; + FKind: TScalar.TKind; FOffset: Integer; function GetCount: Int64; function GetItems(Idx: Integer): TScalar; @@ -245,16 +180,15 @@ type constructor Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer); destructor Destroy; override; end; - private FDef: TScalarRecordDefinition; - FArray: TChunkArray; + FArray: TChunkArray; FTotalCount: Int64; function GetCount: Int64; inline; function GetDef: TScalarRecordDefinition; inline; function GetItems(Idx: Integer): TScalarRecord; inline; function GetTotalCount: Int64; inline; - function GetItemRef(Idx: Integer): TChunkArray.PT; inline; + function GetItemRef(Idx: Integer): TChunkArray.PT; inline; public constructor Create(const ADef: TScalarRecordDefinition); procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1); @@ -275,330 +209,75 @@ type constructor Create(const AIndexArray: TArray); end; - TBinaryOperatorHelper = record helper for TBinaryOperator - function ToString: string; - end; - - TUnaryOperatorHelper = record helper for TUnaryOperator - function ToString: string; - end; - implementation -{ TScalarValue } - -class function TScalarValue.FromBoolean(AValue: Boolean): TScalarValue; -begin - Result.AsBoolean := AValue; -end; - -class function TScalarValue.FromBytes(const AValue: TScalarBytes): TScalarValue; -begin - Result.AsBytes := AValue; -end; - -class function TScalarValue.FromChar(AValue: Char): TScalarValue; -begin - Result.AsChar := AValue; -end; - -class function TScalarValue.FromDateTime(AValue: TDateTime): TScalarValue; -begin - Result.AsDateTime := AValue; -end; - -class function TScalarValue.FromDecimal(AValue: TDecimal): TScalarValue; -begin - Result.AsDecimal := AValue; -end; - -class function TScalarValue.FromDouble(AValue: Double): TScalarValue; -begin - Result.AsDouble := AValue; -end; - -class function TScalarValue.FromInt64(AValue: Int64): TScalarValue; -begin - Result.AsInt64 := AValue; -end; - -class function TScalarValue.FromInteger(AValue: Integer): TScalarValue; -begin - Result.AsInteger := AValue; -end; - -class function TScalarValue.FromPChar(const AValue: String): TScalarValue; -var - len, i: Integer; -begin - FillChar(Result.AsPChar, SizeOf(Result.AsPChar), #0); - len := Length(AValue); - if (len > 0) then - begin - if (len > Length(Result.AsPChar)) then - len := Length(Result.AsPChar); - for i := 0 to len - 1 do - Result.AsPChar[i] := AValue[i + 1]; - end; -end; - -class function TScalarValue.FromPChar(const AValue: TScalarPChar): TScalarValue; -begin - Result.AsPChar := AValue; -end; - -class function TScalarValue.FromSingle(AValue: Single): TScalarValue; -begin - Result.AsSingle := AValue; -end; - -class function TScalarValue.FromString(const AValue: String): TScalarValue; -begin - Result.AsString := ShortString(AValue); -end; - -class function TScalarValue.FromString(const AValue: TScalarString): TScalarValue; -begin - Result.AsString := AValue; -end; - -class function TScalarValue.FromTimestamp(AValue: TTimestamp): TScalarValue; -begin - Result.AsTimestamp := AValue; -end; - -class function TScalarValue.FromUInt64(AValue: UInt64): TScalarValue; -begin - Result.AsUInt64 := AValue; -end; - { TScalar } -constructor TScalar.Create(AKind: TScalarKind; const AValue: TScalarValue); +constructor TScalar.Create(AKind: TKind; const AValue: TValue); begin Kind := AKind; Value := AValue; end; -class function TScalar.FromBoolean(AValue: Boolean): TScalar; -begin - Result.Kind := skBoolean; - Result.Value := TScalarValue.FromBoolean(AValue); -end; - -class function TScalar.FromBytes(const AValue: TScalarBytes): TScalar; -begin - Result.Kind := skBytes; - Result.Value := TScalarValue.FromBytes(AValue); -end; - -class function TScalar.FromChar(AValue: Char): TScalar; -begin - Result.Kind := skChar; - Result.Value := TScalarValue.FromChar(AValue); -end; - -class function TScalar.FromDateTime(AValue: TDateTime): TScalar; -begin - Result.Kind := skDateTime; - Result.Value := TScalarValue.FromDateTime(AValue); -end; - -class function TScalar.FromDecimal(const AValue: TDecimal): TScalar; -begin - Result.Kind := skDecimal; - Result.Value := TScalarValue.FromDecimal(AValue); -end; - class function TScalar.FromDouble(AValue: Double): TScalar; begin - Result.Kind := skDouble; - Result.Value := TScalarValue.FromDouble(AValue); -end; - -class operator TScalar.Implicit(AValue: Boolean): TScalar; -begin - Result.Kind := skBoolean; - Result.Value := TScalarValue.FromBoolean(AValue); -end; - -class operator TScalar.Implicit(AValue: Char): TScalar; -begin - Result.Kind := skChar; - Result.Value := TScalarValue.FromChar(AValue); -end; - -class operator TScalar.Implicit(AValue: TDateTime): TScalar; -begin - Result.Kind := skDateTime; - Result.Value := TScalarValue.FromDateTime(AValue); -end; - -class operator TScalar.Implicit(const AValue: TDecimal): TScalar; -begin - Result.Kind := skDecimal; - Result.Value := TScalarValue.FromDecimal(AValue); + Result.Kind := TKind.Float; + Result.Value.AsDouble := AValue; end; class operator TScalar.Implicit(AValue: Double): TScalar; begin - Result.Kind := skDouble; - Result.Value := TScalarValue.FromDouble(AValue); + Result.Kind := TKind.Float; + Result.Value.AsDouble := AValue; end; class operator TScalar.Implicit(AValue: Int64): TScalar; begin - Result.Kind := skInt64; - Result.Value := TScalarValue.FromInt64(AValue); + Result.Kind := TKind.Ordinal; + Result.Value.AsInt64 := AValue; end; -class operator TScalar.Implicit(AValue: Integer): TScalar; +class operator TScalar.Implicit(const A: TScalar): Double; begin - Result.Kind := skInteger; - Result.Value := TScalarValue.FromInteger(AValue); + if A.Kind = TKind.Ordinal then + Result := A.Value.AsInt64 + else + Result := A.Value.AsDouble; end; -class operator TScalar.Implicit(AValue: Single): TScalar; +class operator TScalar.Implicit(const A: TScalar): Int64; begin - Result.Kind := skSingle; - Result.Value := TScalarValue.FromSingle(AValue); -end; - -class operator TScalar.Implicit(AValue: UInt64): TScalar; -begin - Result.Kind := skUInt64; - Result.Value := TScalarValue.FromUInt64(AValue); + if A.Kind = TKind.Ordinal then + Result := A.Value.AsInt64 + else + raise EInvalidCast.Create('Cannot implicitly convert a Float to an Int64'); end; class function TScalar.FromInt64(AValue: Int64): TScalar; begin - Result.Kind := skInt64; - Result.Value := TScalarValue.FromInt64(AValue); + Result.Kind := TKind.Ordinal; + Result.Value.AsInt64 := AValue; end; -class function TScalar.FromInteger(AValue: Integer): TScalar; +class function TScalar.IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean; begin - Result.Kind := skInteger; - Result.Value := TScalarValue.FromInteger(AValue); + Result := True; end; -class function TScalar.FromPChar(const AValue: TScalarPChar): TScalar; +class function TScalar.IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean; begin - Result.Kind := skPChar; - Result.Value := TScalarValue.FromPChar(AValue); -end; - -class function TScalar.FromSingle(AValue: Single): TScalar; -begin - Result.Kind := skSingle; - Result.Value := TScalarValue.FromSingle(AValue); -end; - -class function TScalar.FromString(const AValue: String): TScalar; -begin - Result.Kind := skString; - Result.Value := TScalarValue.FromString(AValue); -end; - -class function TScalar.FromTimestamp(AValue: TTimestamp): TScalar; -begin - Result.Kind := skTimestamp; - Result.Value := TScalarValue.FromTimestamp(AValue); -end; - -class function TScalar.FromUInt64(AValue: UInt64): TScalar; -begin - Result.Kind := skUInt64; - Result.Value := TScalarValue.FromUInt64(AValue); -end; - -class function TScalar.IsBinaryOperatorSupported(Op: TBinaryOperator; A, B: TScalarKind): Boolean; -begin - const FLOAT_KINDS: set of TScalarKind = [skSingle, skDouble]; - const ORDINAL_KINDS: set of TScalarKind = [skInteger, skInt64, skUInt64]; - const NUMERIC_KINDS: set of TScalarKind = FLOAT_KINDS + ORDINAL_KINDS + [skDecimal]; - const COMPARABLE_KINDS: set of TScalarKind = NUMERIC_KINDS + [skDateTime, skChar, skString]; - - // General check for incompatible types - if (A = B) then - begin - case Op of - boAdd, boSubtract, boMultiply, boDivide: Result := A in NUMERIC_KINDS + [skDateTime]; - boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual: Result := A in COMPARABLE_KINDS; - else - Result := False; - end; - end + if (Op = TUnaryOp.Not) and (A = TKind.Float) then + Result := False else - begin - // Mixed-type checks - case Op of - boAdd: - Result := - (((A in NUMERIC_KINDS) and (B in NUMERIC_KINDS)) - or ((A = skDateTime) and (B in ORDINAL_KINDS + FLOAT_KINDS)) - or ((B = skDateTime) and (A in ORDINAL_KINDS + FLOAT_KINDS))); - boSubtract: - Result := (((A in NUMERIC_KINDS) and (B in NUMERIC_KINDS)) or ((A = skDateTime) and (B in NUMERIC_KINDS + [skDateTime]))); - boMultiply, boDivide: Result := (A in NUMERIC_KINDS) and (B in NUMERIC_KINDS); - boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual: - Result := (A in NUMERIC_KINDS) and (B in NUMERIC_KINDS); - else - Result := False; - end; - end; - - // Specific exclusion rules - if Result then - begin - // Decimal cannot be mixed with floats for any operator - if ((A = skDecimal) and (B in FLOAT_KINDS)) or ((B = skDecimal) and (A in FLOAT_KINDS)) then - Result := - False - // Cannot subtract a DateTime from a Numeric type - else if (Op = boSubtract) and (A in NUMERIC_KINDS) and (B = skDateTime) then - Result := False; - end; + Result := True; end; -class function TScalar.IsUnaryOperatorSupported(Op: TUnaryOperator; A: TScalarKind): Boolean; +class function TScalar.StringToKind(const AName: string): TKind; begin - case Op of - uoNegate: Result := A in [skInteger, skInt64, skSingle, skDouble, skDecimal]; - uoNot: Result := A in [skBoolean, skInteger, skInt64, skUInt64]; - else - Result := False; - end; -end; - -class function TScalar.StringToKind(const AName: string): TScalarKind; -begin - if SameText(AName, 'Integer') then - Result := skInteger - else if SameText(AName, 'Int64') then - Result := skInt64 - else if SameText(AName, 'UInt64') then - Result := skUInt64 - else if SameText(AName, 'Single') then - Result := skSingle - else if SameText(AName, 'Double') then - Result := skDouble - else if SameText(AName, 'DateTime') then - Result := skDateTime - else if SameText(AName, 'Timestamp') then - Result := skTimestamp - else if SameText(AName, 'Boolean') then - Result := skBoolean - else if SameText(AName, 'Char') then - Result := skChar - else if SameText(AName, 'PChar') then - Result := skPChar - else if SameText(AName, 'String') then - Result := skString - else if SameText(AName, 'Bytes') then - Result := skBytes - else if SameText(AName, 'Decimal') then - Result := skDecimal + if SameText(AName, 'Ordinal') then + Result := TKind.Ordinal + else if SameText(AName, 'Float') then + Result := TKind.Float else raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]); end; @@ -606,44 +285,27 @@ end; function TScalar.ToString: String; begin case Kind of - skInteger: Result := IntToStr(Value.AsInteger); - skInt64: Result := IntToStr(Value.AsInt64); - skUInt64: Result := UIntToStr(Value.AsUInt64); - skSingle: Result := FloatToStr(Value.AsSingle); - skDouble: Result := FloatToStr(Value.AsDouble); - skDateTime: Result := DateTimeToStr(Value.AsDateTime); - skTimestamp: Result := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', TimeStampToDateTime(Value.AsTimestamp)); - skBoolean: Result := BoolToStr(Value.AsBoolean, True); - skChar: Result := '''' + Value.AsChar + ''''; - skPChar: Result := PChar(@Value.AsPChar); // Needs explicit cast/pointer - skString: Result := '''' + string(Value.AsString) + ''''; - skBytes: Result := '(Bytes)'; - skDecimal: Result := FloatToStr(Double(Value.AsDecimal)); + TKind.Ordinal: Result := IntToStr(Value.AsInt64); + TKind.Float: Result := FloatToStr(Value.AsDouble); else Result := '[Unknown Scalar]'; end; end; -class function TScalar.TryBinaryOperation(Op: TBinaryOperator; const A, B: TScalar; out Res: TScalar): Boolean; +class function TScalar.TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean; begin - if not IsBinaryOperatorSupported(Op, A.Kind, B.Kind) then - begin - Result := False; - exit; - end; - try case Op of - boAdd: Res := A + B; - boSubtract: Res := A - B; - boMultiply: Res := A * B; - boDivide: Res := A / B; - boEqual: Res := TScalar.FromBoolean(A = B); - boNotEqual: Res := TScalar.FromBoolean(A <> B); - boLess: Res := TScalar.FromBoolean(A < B); - boGreater: Res := TScalar.FromBoolean(A > B); - boLessOrEqual: Res := TScalar.FromBoolean(A <= B); - boGreaterOrEqual: Res := TScalar.FromBoolean(A >= B); + TBinaryOp.Add: Res := A + B; + TBinaryOp.Subtract: Res := A - B; + TBinaryOp.Multiply: Res := A * B; + TBinaryOp.Divide: Res := A / B; + TBinaryOp.Equal: Res := TScalar.FromInt64(Integer(A = B)); + TBinaryOp.NotEqual: Res := TScalar.FromInt64(Integer(A <> B)); + TBinaryOp.Less: Res := TScalar.FromInt64(Integer(A < B)); + TBinaryOp.Greater: Res := TScalar.FromInt64(Integer(A > B)); + TBinaryOp.LessOrEqual: Res := TScalar.FromInt64(Integer(A <= B)); + TBinaryOp.GreaterOrEqual: Res := TScalar.FromInt64(Integer(A >= B)); else Result := False; exit; @@ -654,18 +316,17 @@ begin end; end; -class function TScalar.TryUnaryOperation(Op: TUnaryOperator; const A: TScalar; out Res: TScalar): Boolean; +class function TScalar.TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean; begin if not IsUnaryOperatorSupported(Op, A.Kind) then begin Result := False; exit; end; - try case Op of - uoNegate: Res := -A; - uoNot: Res := not A; + TUnaryOp.Negate: Res := -A; + TUnaryOp.Not: Res := not A; else Result := False; exit; @@ -678,528 +339,131 @@ end; class operator TScalar.Add(const A, B: TScalar): TScalar; begin - // Fast path for identical types - if (A.Kind = B.Kind) then + if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then + Result := A.Value.AsInt64 + B.Value.AsInt64 + else begin - Result.Kind := A.Kind; - case A.Kind of - skInteger: Result.Value.AsInteger := A.Value.AsInteger + B.Value.AsInteger; - skInt64: Result.Value.AsInt64 := A.Value.AsInt64 + B.Value.AsInt64; - skUInt64: Result.Value.AsUInt64 := A.Value.AsUInt64 + B.Value.AsUInt64; - skSingle: Result.Value.AsSingle := A.Value.AsSingle + B.Value.AsSingle; - skDouble: Result.Value.AsDouble := A.Value.AsDouble + B.Value.AsDouble; - skDecimal: Result.Value.AsDecimal := A.Value.AsDecimal + B.Value.AsDecimal; + var valA, valB: Double; + if A.Kind = TKind.Ordinal then + valA := A.Value.AsInt64 else - raise EArgumentException.CreateFmt('Operator Add not supported for type %s', [A.Kind.ToString]); - end; - exit; - end; - - // Slow path for mixed types with compatible conversion - const FLOAT_KINDS: set of TScalarKind = [skSingle, skDouble]; - const ORDINAL_KINDS: set of TScalarKind = [skInteger, skInt64, skUInt64]; - const NUMERIC_KINDS: set of TScalarKind = FLOAT_KINDS + ORDINAL_KINDS + [skDecimal]; - - if not (((A.Kind in NUMERIC_KINDS) and (B.Kind in NUMERIC_KINDS)) - or ((A.Kind = skDateTime) and (B.Kind in ORDINAL_KINDS + FLOAT_KINDS)) - or ((B.Kind = skDateTime) and (A.Kind in ORDINAL_KINDS + FLOAT_KINDS))) then - raise EArgumentException.CreateFmt('Operator Add requires compatible types, but got %s and %s', [A.Kind.ToString, B.Kind.ToString]); - - if (A.Kind = skDecimal) or (B.Kind = skDecimal) then - begin - if (A.Kind in FLOAT_KINDS) or (B.Kind in FLOAT_KINDS) then - raise EArgumentException - .CreateFmt('Operator Add cannot mix Decimal and floating-point types (%s, %s)', [A.Kind.ToString, B.Kind.ToString]); - - var valA, valB: TDecimal; - case A.Kind of - skInteger: valA := TDecimal.Create(A.Value.AsInteger, 0); - skInt64: valA := TDecimal.Create(A.Value.AsInt64, 0); - skUInt64: valA := TDecimal.Create(Int64(A.Value.AsUInt64), 0); - skDecimal: valA := A.Value.AsDecimal; - end; - case B.Kind of - skInteger: valB := TDecimal.Create(B.Value.AsInteger, 0); - skInt64: valB := TDecimal.Create(B.Value.AsInt64, 0); - skUInt64: valB := TDecimal.Create(Int64(B.Value.AsUInt64), 0); - skDecimal: valB := B.Value.AsDecimal; - end; - Result := TScalar.FromDecimal(valA + valB); - end - else if (A.Kind = skDateTime) or (B.Kind = skDateTime) then - begin - if A.Kind = skDateTime then - begin - var dtPart := A.Value.AsDateTime; - var numPart: Double := 0; - case B.Kind of - skInteger: numPart := B.Value.AsInteger; - skInt64: numPart := B.Value.AsInt64; - skUInt64: numPart := B.Value.AsUInt64; - skSingle: numPart := B.Value.AsSingle; - skDouble: numPart := B.Value.AsDouble; - end; - Result := TScalar.FromDateTime(dtPart + numPart); - end + valA := A.Value.AsDouble; + if B.Kind = TKind.Ordinal then + valB := B.Value.AsInt64 else - begin - var dtPart := B.Value.AsDateTime; - var numPart: Double := 0; - case A.Kind of - skInteger: numPart := A.Value.AsInteger; - skInt64: numPart := A.Value.AsInt64; - skUInt64: numPart := A.Value.AsUInt64; - skSingle: numPart := A.Value.AsSingle; - skDouble: numPart := A.Value.AsDouble; - end; - Result := TScalar.FromDateTime(dtPart + numPart); - end; - end - else if (A.Kind = skDouble) or (B.Kind = skDouble) then - begin - var dblA: Double := 0; - var dblB: Double := 0; - case A.Kind of - skInteger: dblA := A.Value.AsInteger; - skInt64: dblA := A.Value.AsInt64; - skUInt64: dblA := A.Value.AsUInt64; - skSingle: dblA := A.Value.AsSingle; - skDouble: dblA := A.Value.AsDouble; - end; - case B.Kind of - skInteger: dblB := B.Value.AsInteger; - skInt64: dblB := B.Value.AsInt64; - skUInt64: dblB := B.Value.AsUInt64; - skSingle: dblB := B.Value.AsSingle; - skDouble: dblB := B.Value.AsDouble; - end; - Result := TScalar.FromDouble(dblA + dblB); - end - else if (A.Kind = skSingle) or (B.Kind = skSingle) then - begin - var sngA: Single := 0; - var sngB: Single := 0; - case A.Kind of - skInteger: sngA := A.Value.AsInteger; - skInt64: sngA := A.Value.AsInt64; - skUInt64: sngA := A.Value.AsUInt64; - skSingle: sngA := A.Value.AsSingle; - end; - case B.Kind of - skInteger: sngB := B.Value.AsInteger; - skInt64: sngB := B.Value.AsInt64; - skUInt64: sngB := B.Value.AsUInt64; - skSingle: sngB := B.Value.AsSingle; - end; - Result := TScalar.FromSingle(sngA + sngB); - end - else if (A.Kind = skUInt64) or (B.Kind = skUInt64) then - begin - var u64A: UInt64 := 0; - var u64B: UInt64 := 0; - case A.Kind of - skInteger: u64A := UInt64(A.Value.AsInteger); - skInt64: u64A := UInt64(A.Value.AsInt64); - skUInt64: u64A := A.Value.AsUInt64; - end; - case B.Kind of - skInteger: u64B := UInt64(B.Value.AsInteger); - skInt64: u64B := UInt64(B.Value.AsInt64); - skUInt64: u64B := B.Value.AsUInt64; - end; - Result := TScalar.FromUInt64(u64A + u64B); - end - else if (A.Kind = skInt64) or (B.Kind = skInt64) then - begin - var i64A: Int64 := 0; - var i64B: Int64 := 0; - case A.Kind of - skInteger: i64A := A.Value.AsInteger; - skInt64: i64A := A.Value.AsInt64; - end; - case B.Kind of - skInteger: i64B := B.Value.AsInteger; - skInt64: i64B := B.Value.AsInt64; - end; - Result := TScalar.FromInt64(i64A + i64B); + valB := B.Value.AsDouble; + Result := valA + valB; end; end; class operator TScalar.Divide(const A, B: TScalar): TScalar; begin - // Fast path for identical types - if (A.Kind = B.Kind) then - begin - case A.Kind of - skInteger: Result := TScalar.FromDouble(A.Value.AsInteger / B.Value.AsInteger); - skInt64: Result := TScalar.FromDouble(A.Value.AsInt64 / B.Value.AsInt64); - skUInt64: Result := TScalar.FromDouble(A.Value.AsUInt64 / B.Value.AsUInt64); - skSingle: Result := TScalar.FromSingle(A.Value.AsSingle / B.Value.AsSingle); - skDouble: Result := TScalar.FromDouble(A.Value.AsDouble / B.Value.AsDouble); - skDecimal: Result := TScalar.FromDecimal(A.Value.AsDecimal / B.Value.AsDecimal); - else - raise EArgumentException.CreateFmt('Operator Divide not supported for type %s', [A.Kind.ToString]); - end; - exit; - end; - - // Slow path for mixed types - const FLOAT_KINDS: set of TScalarKind = [skSingle, skDouble]; - const NUMERIC_KINDS: set of TScalarKind = FLOAT_KINDS + [skInteger, skInt64, skUInt64, skDecimal]; - - if not ((A.Kind in NUMERIC_KINDS) and (B.Kind in NUMERIC_KINDS)) then - raise EArgumentException.CreateFmt('Operator Divide not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); - - if (A.Kind = skDecimal) or (B.Kind = skDecimal) then - begin - if (A.Kind in FLOAT_KINDS) or (B.Kind in FLOAT_KINDS) then - raise EArgumentException - .CreateFmt('Operator Divide cannot mix Decimal and floating-point types (%s, %s)', [A.Kind.ToString, B.Kind.ToString]); - var valA, valB: TDecimal; - case A.Kind of - skInteger: valA := TDecimal.Create(A.Value.AsInteger, 0); - skInt64: valA := TDecimal.Create(A.Value.AsInt64, 0); - skUInt64: valA := TDecimal.Create(Int64(A.Value.AsUInt64), 0); - skDecimal: valA := A.Value.AsDecimal; - end; - case B.Kind of - skInteger: valB := TDecimal.Create(B.Value.AsInteger, 0); - skInt64: valB := TDecimal.Create(B.Value.AsInt64, 0); - skUInt64: valB := TDecimal.Create(Int64(B.Value.AsUInt64), 0); - skDecimal: valB := B.Value.AsDecimal; - end; - Result := TScalar.FromDecimal(valA / valB); - end + var valA, valB: Double; + if A.Kind = TKind.Ordinal then + valA := A.Value.AsInt64 else - begin - var dblA: Double := 0.0; - var dblB: Double := 0.0; - case A.Kind of - skInteger: dblA := A.Value.AsInteger; - skInt64: dblA := A.Value.AsInt64; - skUInt64: dblA := A.Value.AsUInt64; - skSingle: dblA := A.Value.AsSingle; - skDouble: dblA := A.Value.AsDouble; - end; - case B.Kind of - skInteger: dblB := B.Value.AsInteger; - skInt64: dblB := B.Value.AsInt64; - skUInt64: dblB := B.Value.AsUInt64; - skSingle: dblB := B.Value.AsSingle; - skDouble: dblB := B.Value.AsDouble; - end; - Result := TScalar.FromDouble(dblA / dblB); - end; + valA := A.Value.AsDouble; + if B.Kind = TKind.Ordinal then + valB := B.Value.AsInt64 + else + valB := B.Value.AsDouble; + Result := valA / valB; end; class operator TScalar.Equal(const A, B: TScalar): Boolean; begin - // Fast path for identical types - if (A.Kind = B.Kind) then - begin - case A.Kind of - skInteger: Result := (A.Value.AsInteger = B.Value.AsInteger); - skInt64: Result := (A.Value.AsInt64 = B.Value.AsInt64); - skUInt64: Result := (A.Value.AsUInt64 = B.Value.AsUInt64); - skSingle: Result := (A.Value.AsSingle = B.Value.AsSingle); - skDouble: Result := (A.Value.AsDouble = B.Value.AsDouble); - skDateTime: Result := (A.Value.AsDateTime = B.Value.AsDateTime); - skTimestamp: - Result := (A.Value.AsTimestamp.Time = B.Value.AsTimestamp.Time) and (A.Value.AsTimestamp.Date = B.Value.AsTimestamp.Date); - skBoolean: Result := (A.Value.AsBoolean = B.Value.AsBoolean); - skChar: Result := (A.Value.AsChar = B.Value.AsChar); - skPChar: Result := (StrComp(PChar(@A.Value.AsPChar), PChar(@B.Value.AsPChar)) = 0); - skString: Result := (A.Value.AsString = B.Value.AsString); - skBytes: Result := CompareMem(@A.Value.AsBytes, @B.Value.AsBytes, SizeOf(TScalarBytes)); - skDecimal: Result := (A.Value.AsDecimal = B.Value.AsDecimal); - else - Result := False; - end; - exit; - end; - - // Slow path for mixed, but compatible, types - const FLOAT_KINDS: set of TScalarKind = [skSingle, skDouble]; - const NUMERIC_KINDS: set of TScalarKind = FLOAT_KINDS + [skInteger, skInt64, skUInt64, skDecimal]; - - if not ((A.Kind in NUMERIC_KINDS) and (B.Kind in NUMERIC_KINDS)) then - begin - Result := False; - exit; - end; - - if ((A.Kind = skDecimal) and (B.Kind in FLOAT_KINDS)) or ((B.Kind = skDecimal) and (A.Kind in FLOAT_KINDS)) then - begin - Result := False; - exit; - end; - - if (A.Kind = skDecimal) or (B.Kind = skDecimal) then - begin - var valA, valB: TDecimal; - case A.Kind of - skInteger: valA := TDecimal.Create(A.Value.AsInteger, 0); - skInt64: valA := TDecimal.Create(A.Value.AsInt64, 0); - skUInt64: valA := TDecimal.Create(Int64(A.Value.AsUInt64), 0); - skDecimal: valA := A.Value.AsDecimal; - else - Result := False; - exit; - end; - case B.Kind of - skInteger: valB := TDecimal.Create(B.Value.AsInteger, 0); - skInt64: valB := TDecimal.Create(B.Value.AsInt64, 0); - skUInt64: valB := TDecimal.Create(Int64(B.Value.AsUInt64), 0); - skDecimal: valB := B.Value.AsDecimal; - else - Result := False; - exit; - end; - Result := (valA = valB); - end + if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then + Result := A.Value.AsInt64 = B.Value.AsInt64 else begin - var dblA: Double := 0.0; - var dblB: Double := 0.0; - case A.Kind of - skInteger: dblA := A.Value.AsInteger; - skInt64: dblA := A.Value.AsInt64; - skUInt64: dblA := A.Value.AsUInt64; - skSingle: dblA := A.Value.AsSingle; - skDouble: dblA := A.Value.AsDouble; - end; - case B.Kind of - skInteger: dblB := B.Value.AsInteger; - skInt64: dblB := B.Value.AsInt64; - skUInt64: dblB := B.Value.AsUInt64; - skSingle: dblB := B.Value.AsSingle; - skDouble: dblB := B.Value.AsDouble; - end; - Result := (dblA = dblB); + var valA, valB: Double; + if A.Kind = TKind.Ordinal then + valA := A.Value.AsInt64 + else + valA := A.Value.AsDouble; + if B.Kind = TKind.Ordinal then + valB := B.Value.AsInt64 + else + valB := B.Value.AsDouble; + Result := valA = valB; end; end; class operator TScalar.GreaterThan(const A, B: TScalar): Boolean; begin - // Fast path for identical types - if (A.Kind = B.Kind) then - begin - case A.Kind of - skInteger: Result := (A.Value.AsInteger > B.Value.AsInteger); - skInt64: Result := (A.Value.AsInt64 > B.Value.AsInt64); - skUInt64: Result := (A.Value.AsUInt64 > B.Value.AsUInt64); - skSingle: Result := (A.Value.AsSingle > B.Value.AsSingle); - skDouble: Result := (A.Value.AsDouble > B.Value.AsDouble); - skDateTime: Result := (A.Value.AsDateTime > B.Value.AsDateTime); - skDecimal: Result := (A.Value.AsDecimal > B.Value.AsDecimal); - skChar: Result := (A.Value.AsChar > B.Value.AsChar); - skString: Result := (A.Value.AsString > B.Value.AsString); - else - raise EArgumentException.CreateFmt('Operator GreaterThan not supported for type %s', [A.Kind.ToString]); - end; - exit; - end; - - // Slow path for mixed, but compatible, types - const FLOAT_KINDS: set of TScalarKind = [skSingle, skDouble]; - const NUMERIC_KINDS: set of TScalarKind = FLOAT_KINDS + [skInteger, skInt64, skUInt64, skDecimal]; - - if not ((A.Kind in NUMERIC_KINDS) and (B.Kind in NUMERIC_KINDS)) then - raise EArgumentException.CreateFmt('Cannot compare %s and %s', [A.Kind.ToString, B.Kind.ToString]); - - if ((A.Kind = skDecimal) and (B.Kind in FLOAT_KINDS)) or ((B.Kind = skDecimal) and (A.Kind in FLOAT_KINDS)) then - raise EArgumentException.CreateFmt('Cannot compare Decimal and floating-point types (%s, %s)', [A.Kind.ToString, B.Kind.ToString]); - - if (A.Kind = skDecimal) or (B.Kind = skDecimal) then - begin - var valA, valB: TDecimal; - case A.Kind of - skInteger: valA := TDecimal.Create(A.Value.AsInteger, 0); - skInt64: valA := TDecimal.Create(A.Value.AsInt64, 0); - skUInt64: valA := TDecimal.Create(Int64(A.Value.AsUInt64), 0); - skDecimal: valA := A.Value.AsDecimal; - else - raise EArgumentException.CreateFmt('Internal error comparing %s', [A.Kind.ToString]); - end; - case B.Kind of - skInteger: valB := TDecimal.Create(B.Value.AsInteger, 0); - skInt64: valB := TDecimal.Create(B.Value.AsInt64, 0); - skUInt64: valB := TDecimal.Create(Int64(B.Value.AsUInt64), 0); - skDecimal: valB := B.Value.AsDecimal; - else - raise EArgumentException.CreateFmt('Internal error comparing %s', [B.Kind.ToString]); - end; - Result := (valA > valB); - end + if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then + Result := A.Value.AsInt64 > B.Value.AsInt64 else begin - var dblA, dblB: Double; - dblA := 0.0; - dblB := 0.0; - case A.Kind of - skInteger: dblA := A.Value.AsInteger; - skInt64: dblA := A.Value.AsInt64; - skUInt64: dblA := A.Value.AsUInt64; - skSingle: dblA := A.Value.AsSingle; - skDouble: dblA := A.Value.AsDouble; - end; - case B.Kind of - skInteger: dblB := B.Value.AsInteger; - skInt64: dblB := B.Value.AsInt64; - skUInt64: dblB := B.Value.AsUInt64; - skSingle: dblB := B.Value.AsSingle; - skDouble: dblB := B.Value.AsDouble; - end; - Result := (dblA > dblB); + var valA, valB: Double; + if A.Kind = TKind.Ordinal then + valA := A.Value.AsInt64 + else + valA := A.Value.AsDouble; + if B.Kind = TKind.Ordinal then + valB := B.Value.AsInt64 + else + valB := B.Value.AsDouble; + Result := valA > valB; end; end; class operator TScalar.GreaterThanOrEqual(const A, B: TScalar): Boolean; begin - Result := (A > B) or (A = B); + Result := not (A < B); end; class operator TScalar.LessThan(const A, B: TScalar): Boolean; begin - // Re-use GreaterThan logic to avoid code duplication - Result := B > A; + if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then + Result := A.Value.AsInt64 < B.Value.AsInt64 + else + begin + var valA, valB: Double; + if A.Kind = TKind.Ordinal then + valA := A.Value.AsInt64 + else + valA := A.Value.AsDouble; + if B.Kind = TKind.Ordinal then + valB := B.Value.AsInt64 + else + valB := B.Value.AsDouble; + Result := valA < valB; + end; end; class operator TScalar.LessThanOrEqual(const A, B: TScalar): Boolean; begin - Result := (A < B) or (A = B); + Result := not (A > B); end; class operator TScalar.LogicalNot(const A: TScalar): TScalar; begin - Result.Kind := A.Kind; - case A.Kind of - skBoolean: Result.Value.AsBoolean := not A.Value.AsBoolean; - skInteger: Result.Value.AsInteger := not A.Value.AsInteger; - skInt64: Result.Value.AsInt64 := not A.Value.AsInt64; - skUInt64: Result.Value.AsUInt64 := not A.Value.AsUInt64; + if A.Kind <> TKind.Ordinal then + raise EArgumentException.Create('Operator Not not supported for type Float'); + + if A.Value.AsInt64 = 0 then + Result := 1 else - raise EArgumentException.CreateFmt('Operator Not not supported for type %s', [A.Kind.ToString]); - end; + Result := 0; end; class operator TScalar.Multiply(const A, B: TScalar): TScalar; begin - // Fast path for identical types - if (A.Kind = B.Kind) then - begin - Result.Kind := A.Kind; - case A.Kind of - skInteger: Result.Value.AsInteger := A.Value.AsInteger * B.Value.AsInteger; - skInt64: Result.Value.AsInt64 := A.Value.AsInt64 * B.Value.AsInt64; - skUInt64: Result.Value.AsUInt64 := A.Value.AsUInt64 * B.Value.AsUInt64; - skSingle: Result.Value.AsSingle := A.Value.AsSingle * B.Value.AsSingle; - skDouble: Result.Value.AsDouble := A.Value.AsDouble * B.Value.AsDouble; - skDecimal: Result.Value.AsDecimal := A.Value.AsDecimal * B.Value.AsDecimal; - else - raise EArgumentException.CreateFmt('Operator Multiply not supported for type %s', [A.Kind.ToString]); - end; - exit; - end; - - // Slow path for mixed types - const FLOAT_KINDS: set of TScalarKind = [skSingle, skDouble]; - const NUMERIC_KINDS: set of TScalarKind = FLOAT_KINDS + [skInteger, skInt64, skUInt64, skDecimal]; - - if not ((A.Kind in NUMERIC_KINDS) and (B.Kind in NUMERIC_KINDS)) then - raise EArgumentException.CreateFmt('Operator Multiply not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); - - if (A.Kind = skDecimal) or (B.Kind = skDecimal) then - begin - if (A.Kind in FLOAT_KINDS) or (B.Kind in FLOAT_KINDS) then - raise EArgumentException - .CreateFmt('Operator Multiply cannot mix Decimal and floating-point types (%s, %s)', [A.Kind.ToString, B.Kind.ToString]); - var valA, valB: TDecimal; - case A.Kind of - skInteger: valA := TDecimal.Create(A.Value.AsInteger, 0); - skInt64: valA := TDecimal.Create(A.Value.AsInt64, 0); - skUInt64: valA := TDecimal.Create(Int64(A.Value.AsUInt64), 0); - skDecimal: valA := A.Value.AsDecimal; - end; - case B.Kind of - skInteger: valB := TDecimal.Create(B.Value.AsInteger, 0); - skInt64: valB := TDecimal.Create(B.Value.AsInt64, 0); - skUInt64: valB := TDecimal.Create(Int64(B.Value.AsUInt64), 0); - skDecimal: valB := B.Value.AsDecimal; - end; - Result := TScalar.FromDecimal(valA * valB); - end - else if (A.Kind = skDouble) or (B.Kind = skDouble) then - begin - var dblA: Double := 0.0; - var dblB: Double := 0.0; - case A.Kind of - skInteger: dblA := A.Value.AsInteger; - skInt64: dblA := A.Value.AsInt64; - skUInt64: dblA := A.Value.AsUInt64; - skSingle: dblA := A.Value.AsSingle; - skDouble: dblA := A.Value.AsDouble; - end; - case B.Kind of - skInteger: dblB := B.Value.AsInteger; - skInt64: dblB := B.Value.AsInt64; - skUInt64: dblB := B.Value.AsUInt64; - skSingle: dblB := B.Value.AsSingle; - skDouble: dblB := B.Value.AsDouble; - end; - Result := TScalar.FromDouble(dblA * dblB); - end - else if (A.Kind = skSingle) or (B.Kind = skSingle) then - begin - var sngA: Single := 0.0; - var sngB: Single := 0.0; - case A.Kind of - skInteger: sngA := A.Value.AsInteger; - skInt64: sngA := A.Value.AsInt64; - skUInt64: sngA := A.Value.AsUInt64; - skSingle: sngA := A.Value.AsSingle; - end; - case B.Kind of - skInteger: sngB := B.Value.AsInteger; - skInt64: sngB := B.Value.AsInt64; - skUInt64: sngB := B.Value.AsUInt64; - skSingle: sngB := B.Value.AsSingle; - end; - Result := TScalar.FromSingle(sngA * sngB); - end - else if (A.Kind = skUInt64) or (B.Kind = skUInt64) then - begin - var u64A: UInt64 := 0; - var u64B: UInt64 := 0; - case A.Kind of - skInteger: u64A := UInt64(A.Value.AsInteger); - skInt64: u64A := UInt64(A.Value.AsInt64); - skUInt64: u64A := A.Value.AsUInt64; - end; - case B.Kind of - skInteger: u64B := UInt64(B.Value.AsInteger); - skInt64: u64B := UInt64(B.Value.AsInt64); - skUInt64: u64B := B.Value.AsUInt64; - end; - Result := TScalar.FromUInt64(u64A * u64B); - end - else if (A.Kind = skInt64) or (B.Kind = skInt64) then - begin - var i64A: Int64 := 0; - var i64B: Int64 := 0; - case A.Kind of - skInteger: i64A := A.Value.AsInteger; - skInt64: i64A := A.Value.AsInt64; - end; - case B.Kind of - skInteger: i64B := B.Value.AsInteger; - skInt64: i64B := B.Value.AsInt64; - end; - Result := TScalar.FromInt64(i64A * i64B); - end + if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then + Result := A.Value.AsInt64 * B.Value.AsInt64 else begin - Result := TScalar.FromInteger(A.Value.AsInteger * B.Value.AsInteger); + var valA, valB: Double; + if A.Kind = TKind.Ordinal then + valA := A.Value.AsInt64 + else + valA := A.Value.AsDouble; + if B.Kind = TKind.Ordinal then + valB := B.Value.AsInt64 + else + valB := B.Value.AsDouble; + Result := valA * valB; end; end; @@ -1207,13 +471,8 @@ class operator TScalar.Negative(const A: TScalar): TScalar; begin Result.Kind := A.Kind; case A.Kind of - skInteger: Result.Value.AsInteger := -A.Value.AsInteger; - skInt64: Result.Value.AsInt64 := -A.Value.AsInt64; - skSingle: Result.Value.AsSingle := -A.Value.AsSingle; - skDouble: Result.Value.AsDouble := -A.Value.AsDouble; - skDecimal: Result.Value.AsDecimal := -A.Value.AsDecimal; - else - raise EArgumentException.CreateFmt('Operator Negative not supported for type %s', [A.Kind.ToString]); + TKind.Ordinal: Result.Value.AsInt64 := -A.Value.AsInt64; + TKind.Float: Result.Value.AsDouble := -A.Value.AsDouble; end; end; @@ -1224,176 +483,46 @@ end; class operator TScalar.Round(const A: TScalar): TScalar; begin - case A.Kind of - skSingle: Result := TScalar.FromInt64(System.Round(A.Value.AsSingle)); - skDouble: Result := TScalar.FromInt64(System.Round(A.Value.AsDouble)); - skDateTime: Result := TScalar.FromInt64(System.Round(A.Value.AsDateTime)); + var val: Double; + if A.Kind = TKind.Ordinal then + val := A.Value.AsInt64 else - raise EArgumentException.CreateFmt('Operator Round not supported for type %s', [A.Kind.ToString]); - end; + val := A.Value.AsDouble; + Result := System.Round(val); end; class operator TScalar.Subtract(const A, B: TScalar): TScalar; begin - // Fast path for identical types - if (A.Kind = B.Kind) then - begin - if (A.Kind = skDateTime) then - begin - Result := TScalar.FromDouble(A.Value.AsDateTime - B.Value.AsDateTime); - exit; - end; - Result.Kind := A.Kind; - case A.Kind of - skInteger: Result.Value.AsInteger := A.Value.AsInteger - B.Value.AsInteger; - skInt64: Result.Value.AsInt64 := A.Value.AsInt64 - B.Value.AsInt64; - skUInt64: Result.Value.AsUInt64 := A.Value.AsUInt64 - B.Value.AsUInt64; - skSingle: Result.Value.AsSingle := A.Value.AsSingle - B.Value.AsSingle; - skDouble: Result.Value.AsDouble := A.Value.AsDouble - B.Value.AsDouble; - skDecimal: Result.Value.AsDecimal := A.Value.AsDecimal - B.Value.AsDecimal; - else - raise EArgumentException.CreateFmt('Operator Subtract not supported for type %s', [A.Kind.ToString]); - end; - exit; - end; - - // Slow path for mixed types - const FLOAT_KINDS: set of TScalarKind = [skSingle, skDouble]; - const ORDINAL_KINDS: set of TScalarKind = [skInteger, skInt64, skUInt64]; - const NUMERIC_KINDS: set of TScalarKind = FLOAT_KINDS + ORDINAL_KINDS + [skDecimal]; - - if not (((A.Kind in NUMERIC_KINDS) and (B.Kind in NUMERIC_KINDS)) - or ((A.Kind = skDateTime) and (B.Kind in NUMERIC_KINDS + [skDateTime]))) then - raise EArgumentException.CreateFmt('Operator Subtract not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); - - if (A.Kind = skDecimal) or (B.Kind = skDecimal) then - begin - if (A.Kind in FLOAT_KINDS) or (B.Kind in FLOAT_KINDS) then - raise EArgumentException - .CreateFmt('Operator Subtract cannot mix Decimal and floating-point types (%s, %s)', [A.Kind.ToString, B.Kind.ToString]); - var valA, valB: TDecimal; - case A.Kind of - skInteger: valA := TDecimal.Create(A.Value.AsInteger, 0); - skInt64: valA := TDecimal.Create(A.Value.AsInt64, 0); - skUInt64: valA := TDecimal.Create(Int64(A.Value.AsUInt64), 0); - skDecimal: valA := A.Value.AsDecimal; - end; - case B.Kind of - skInteger: valB := TDecimal.Create(B.Value.AsInteger, 0); - skInt64: valB := TDecimal.Create(B.Value.AsInt64, 0); - skUInt64: valB := TDecimal.Create(Int64(B.Value.AsUInt64), 0); - skDecimal: valB := B.Value.AsDecimal; - end; - Result := TScalar.FromDecimal(valA - valB); - end - else if (A.Kind = skDateTime) then - begin - var numPart: Double := 0.0; - case B.Kind of - skInteger: numPart := B.Value.AsInteger; - skInt64: numPart := B.Value.AsInt64; - skUInt64: numPart := B.Value.AsUInt64; - skSingle: numPart := B.Value.AsSingle; - skDouble: numPart := B.Value.AsDouble; - skDateTime: numPart := B.Value.AsDateTime; - end; - if B.Kind = skDateTime then - Result := TScalar.FromDouble(A.Value.AsDateTime - numPart) - else - Result := TScalar.FromDateTime(A.Value.AsDateTime - numPart); - end - else if (B.Kind = skDateTime) then - begin - raise EArgumentException.CreateFmt('Operator Subtract not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); - end - else if (A.Kind = skDouble) or (B.Kind = skDouble) then - begin - var dblA: Double := 0.0; - var dblB: Double := 0.0; - case A.Kind of - skInteger: dblA := A.Value.AsInteger; - skInt64: dblA := A.Value.AsInt64; - skUInt64: dblA := A.Value.AsUInt64; - skSingle: dblA := A.Value.AsSingle; - skDouble: dblA := A.Value.AsDouble; - end; - case B.Kind of - skInteger: dblB := B.Value.AsInteger; - skInt64: dblB := B.Value.AsInt64; - skUInt64: dblB := B.Value.AsUInt64; - skSingle: dblB := B.Value.AsSingle; - skDouble: dblB := B.Value.AsDouble; - end; - Result := TScalar.FromDouble(dblA - dblB); - end - else if (A.Kind = skSingle) or (B.Kind = skSingle) then - begin - var sngA: Single := 0.0; - var sngB: Single := 0.0; - case A.Kind of - skInteger: sngA := A.Value.AsInteger; - skInt64: sngA := A.Value.AsInt64; - skUInt64: sngA := A.Value.AsUInt64; - skSingle: sngA := A.Value.AsSingle; - end; - case B.Kind of - skInteger: sngB := B.Value.AsInteger; - skInt64: sngB := B.Value.AsInt64; - skUInt64: sngB := B.Value.AsUInt64; - skSingle: sngB := B.Value.AsSingle; - end; - Result := TScalar.FromSingle(sngA - sngB); - end - else if (A.Kind = skUInt64) or (B.Kind = skUInt64) then - begin - var u64A: UInt64 := 0; - var u64B: UInt64 := 0; - case A.Kind of - skInteger: u64A := UInt64(A.Value.AsInteger); - skInt64: u64A := UInt64(A.Value.AsInt64); - skUInt64: u64A := A.Value.AsUInt64; - end; - case B.Kind of - skInteger: u64B := UInt64(B.Value.AsInteger); - skInt64: u64B := UInt64(B.Value.AsInt64); - skUInt64: u64B := B.Value.AsUInt64; - end; - Result := TScalar.FromUInt64(u64A - u64B); - end - else if (A.Kind = skInt64) or (B.Kind = skInt64) then - begin - var i64A: Int64 := 0; - var i64B: Int64 := 0; - case A.Kind of - skInteger: i64A := A.Value.AsInteger; - skInt64: i64A := A.Value.AsInt64; - end; - case B.Kind of - skInteger: i64B := B.Value.AsInteger; - skInt64: i64B := B.Value.AsInt64; - end; - Result := TScalar.FromInt64(i64A - i64B); - end + if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then + Result := A.Value.AsInt64 - B.Value.AsInt64 else begin - Result := TScalar.FromInteger(A.Value.AsInteger - B.Value.AsInteger); + var valA, valB: Double; + if A.Kind = TKind.Ordinal then + valA := A.Value.AsInt64 + else + valA := A.Value.AsDouble; + if B.Kind = TKind.Ordinal then + valB := B.Value.AsInt64 + else + valB := B.Value.AsDouble; + Result := valA - valB; end; end; class operator TScalar.Trunc(const A: TScalar): TScalar; begin - case A.Kind of - skSingle: Result := TScalar.FromInt64(System.Trunc(A.Value.AsSingle)); - skDouble: Result := TScalar.FromInt64(System.Trunc(A.Value.AsDouble)); - skDateTime: Result := TScalar.FromInt64(System.Trunc(A.Value.AsDateTime)); + var val: Double; + if A.Kind = TKind.Ordinal then + val := A.Value.AsInt64 else - raise EArgumentException.CreateFmt('Operator Trunc not supported for type %s', [A.Kind.ToString]); - end; + val := A.Value.AsDouble; + Result := System.Trunc(val); end; { TScalarArray } -constructor TScalarArray.Create(AKind: TScalarKind; const AItems: TArray); +constructor TScalarArray.Create(AKind: TScalar.TKind; const AItems: TArray); begin Kind := AKind; Items := AItems; @@ -1401,7 +530,7 @@ end; { TScalarRecordField } -constructor TScalarRecordField.Create(const AName: String; AKind: TScalarKind); +constructor TScalarRecordField.Create(const AName: String; AKind: TScalar.TKind); begin Name := AName; Kind := AKind; @@ -1409,7 +538,7 @@ end; { TScalarRecord } -constructor TScalarRecord.Create(const ADef: TScalarRecordDefinition; const AFields: TArray); +constructor TScalarRecord.Create(const ADef: TScalarRecordDefinition; const AFields: TArray); begin Assert(Length(ADef.Fields) = Length(AFields), 'Field definition and value count must match.'); FDef := ADef; @@ -1421,7 +550,7 @@ begin Result := FDef; end; -function TScalarRecord.GetFields: TArray; +function TScalarRecord.GetFields: TArray; begin Result := FFields; end; @@ -1458,9 +587,6 @@ end; { TScalarRecordSeries } -// 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 TScalarRecordSeries.Create(const ADef: TScalarRecordDefinition); begin Assert(Length(ADef.Fields) > 0); @@ -1493,7 +619,7 @@ begin Result := FDef; end; -function TScalarRecordSeries.GetItemRef(Idx: Integer): TChunkArray.PT; +function TScalarRecordSeries.GetItemRef(Idx: Integer): TChunkArray.PT; begin var len := Length(FDef.Fields); Result := FArray.ItemRef[(FArray.Count - len) - (Idx * len)]; @@ -1501,10 +627,10 @@ end; function TScalarRecordSeries.GetItems(Idx: Integer): TScalarRecord; var - values: TArray; + values: TArray; begin SetLength(values, Length(FDef.Fields)); - Move(GetItemRef(Idx)^, values[0], sizeof(TScalarValue) * Length(values)); + Move(GetItemRef(Idx)^, values[0], sizeof(TScalar.TValue) * Length(values)); Result.Create(FDef, values); end; @@ -1513,54 +639,43 @@ begin Result := FTotalCount; end; -function TScalarKindHelper.ToString: string; +function TScalar.TKindHelper.ToString: string; begin case Self of - skInteger: Result := 'integer'; - skInt64: Result := 'int64'; - skUInt64: Result := 'uint64'; - skSingle: Result := 'single'; - skDouble: Result := 'double'; - skDateTime: Result := 'datetime'; - skTimestamp: Result := 'timestamp'; - skBoolean: Result := 'boolean'; - skChar: Result := 'char'; - skPChar: Result := 'pchar'; - skString: Result := 'string'; - skBytes: Result := 'bytes'; - skDecimal: Result := 'decimal'; + TScalar.TKind.Ordinal: Result := 'Ordinal'; + TScalar.TKind.Float: Result := 'Float'; else Result := 'unknown'; end; end; -{ TBinaryOperatorHelper } +{ TScalar_TBinaryOpHelper } -function TBinaryOperatorHelper.ToString: string; +function TScalar.TBinaryOpHelper.ToString: string; begin case Self of - boAdd: Result := '+'; - boSubtract: Result := '-'; - boMultiply: Result := '*'; - boDivide: Result := '/'; - boEqual: Result := '=='; - boNotEqual: Result := '!='; - boLess: Result := '<'; - boGreater: Result := '>'; - boLessOrEqual: Result := '<='; - boGreaterOrEqual: Result := '>='; + TScalar.TBinaryOp.Add: Result := '+'; + TScalar.TBinaryOp.Subtract: Result := '-'; + TScalar.TBinaryOp.Multiply: Result := '*'; + TScalar.TBinaryOp.Divide: Result := '/'; + TScalar.TBinaryOp.Equal: Result := '=='; + TScalar.TBinaryOp.NotEqual: Result := '!='; + TScalar.TBinaryOp.Less: Result := '<'; + TScalar.TBinaryOp.Greater: Result := '>'; + TScalar.TBinaryOp.LessOrEqual: Result := '<='; + TScalar.TBinaryOp.GreaterOrEqual: Result := '>='; else Result := '?'; end; end; -{ TUnaryOperatorHelper } +{ TScalar_TUnaryOpHelper } -function TUnaryOperatorHelper.ToString: string; +function TScalar.TUnaryOpHelper.ToString: string; begin case Self of - uoNegate: Result := '-'; - uoNot: Result := 'not'; + TScalar.TUnaryOp.Negate: Result := '-'; + TScalar.TUnaryOp.Not: Result := 'not'; else Result := '?'; end; @@ -1572,7 +687,7 @@ begin FRecordSeries := ARecordSeries; FRecordSeries._AddRef; FKind := FRecordSeries.FDef.FFields[AElementIdx].Kind; - FOffset := sizeof(TScalarValue) * AElementIdx; + FOffset := sizeof(TScalar.TValue) * AElementIdx; end; destructor TScalarRecordSeries.TMemberSeries.Destroy; @@ -1588,7 +703,7 @@ end; function TScalarRecordSeries.TMemberSeries.GetItems(Idx: Integer): TScalar; var - P: TChunkArray.PT; + P: TChunkArray.PT; begin P := FRecordSeries.GetItemRef(Idx); inc(PByte(P), FOffset); @@ -1602,16 +717,13 @@ 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); +constructor TScalarSeries.Create(AKind: TScalar.TKind); begin FKind := AKind; FTotalCount := 0; end; -procedure TScalarSeries.Add(const Item: TScalarValue; Lookback: Int64 = -1); +procedure TScalarSeries.Add(const Item: TScalar.TValue; Lookback: Int64 = -1); begin FArray.Add(Item, Lookback); inc(FTotalCount); @@ -1654,13 +766,11 @@ function TIndexSeries.GetItems(Idx: Integer): TScalar; var sourceIndex: Integer; begin - // The series maintains the "0 is newest" convention. - // The index array was built from oldest to newest, so we access it in reverse. sourceIndex := FIndexArray[GetCount - 1 - Idx]; - Result := TScalar.FromInteger(sourceIndex); + Result := TScalar.FromInt64(sourceIndex); end; initialization - Assert(sizeof(TScalarValue) = 8); + Assert(sizeof(TScalar.TValue) = 8); end. diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index b5c78a5..9b4717a 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -53,6 +53,7 @@ type class function Void: TDataValue; inline; static; class operator Implicit(const AValue: TScalar): TDataValue; overload; inline; + class operator Implicit(const AValue: TDataValue): TScalar; overload; inline; class operator Implicit(const AValue: String): TDataValue; overload; inline; class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline; class operator Implicit(const AValue: TObject): TDataValue; overload; inline; @@ -435,6 +436,11 @@ begin Result.FInterface := TObjVal.Create(AValue); end; +class operator TDataValue.Implicit(const AValue: TDataValue): TScalar; +begin + Result := AValue.AsScalar; +end; + { TDataValueKindHelper } function TDataValueKindHelper.ToString: string;