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;