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

Ast series indexer

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-02 16:58:52 +02:00
parent 375e64411b
commit a83bbf4f54
11 changed files with 734 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.dpr
+2 -1
View File
@@ -9,7 +9,8 @@ uses
Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas',
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas',
DraggablePanel in 'DraggablePanel.pas',
Myc.Ast.Visualizer in 'Myc.Ast.Visualizer.pas';
Myc.Ast.Visualizer in 'Myc.Ast.Visualizer.pas',
Myc.Ast.RttiUtils in 'Myc.Ast.RttiUtils.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+8 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName>
<TargetedPlatforms>2</TargetedPlatforms>
@@ -141,6 +141,7 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Scope.pas"/>
<DCCReference Include="DraggablePanel.pas"/>
<DCCReference Include="Myc.Ast.Visualizer.pas"/>
<DCCReference Include="Myc.Ast.RttiUtils.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@@ -190,6 +191,12 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win64\Release\ASTPlayground.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win64">
<RemoteName>ASTPlayground.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
ASTPlayground/MainForm.fmx
+11
View File
@@ -113,6 +113,17 @@ object Form1: TForm1
Text = 'Flow only'
OnChange = ClearButtonClick
end
object SeriesTestButton: TButton
Position.X = 24.000000000000000000
Position.Y = 152.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 14
Text = 'Series'
TextSettings.Trimming = None
OnClick = SeriesTestButtonClick
end
end
object Panel2: TPanel
Align = Client
ASTPlayground/MainForm.pas
+138 -13
View File
@@ -5,6 +5,7 @@ interface
uses
System.SysUtils,
System.Types,
System.TypInfo,
System.UITypes,
System.Classes,
System.Variants,
@@ -46,6 +47,7 @@ type
Panel2: TPanel;
ClearButton: TButton;
FlowOnlyBox: TCheckBox;
SeriesTestButton: TButton;
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CrerateTriggerExampleButtonClick(Sender: TObject);
@@ -55,6 +57,7 @@ type
procedure FibonacciButtonClick(Sender: TObject);
procedure PrettyPrintButtonClick(Sender: TObject);
procedure RecursionButtonClick(Sender: TObject);
procedure SeriesTestButtonClick(Sender: TObject);
procedure Test1ButtonClick(Sender: TObject);
procedure Test2ButtonClick(Sender: TObject);
private
@@ -74,6 +77,8 @@ implementation
uses
Myc.Ast.Scope,
Myc.Ast.RttiUtils,
Myc.Data.Decimal,
System.Diagnostics; // For TStopwatch
{$R *.fmx}
@@ -185,6 +190,7 @@ begin
Application.ProcessMessages; // Update UI before blocking
sw.Start;
{
root :=
TAst.Block(
[
@@ -215,7 +221,7 @@ begin
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(30))])
]
);
}
root :=
TAst.Block(
[
@@ -344,18 +350,15 @@ begin
[TAst.Identifier('n')],
TAst.Block(
[
TAst.Assign(
TAst.Identifier('Result'),
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.Constant(TScalar.FromInt64(1)),
TAst.BinaryExpr(
TAst.Identifier('n'),
boMultiply,
TAst.FunctionCall(
TAst.Identifier('factorial'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.Constant(TScalar.FromInt64(1)),
TAst.BinaryExpr(
TAst.Identifier('n'),
boMultiply,
TAst.FunctionCall(
TAst.Identifier('factorial'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
)
)
@@ -379,6 +382,128 @@ begin
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
end;
procedure TForm1.SeriesTestButtonClick(Sender: TObject);
type
// A test record to generate a definition from.
TOHLCV = record
Timestamp: TDateTime;
Open: Double;
High: Double;
Low: Double;
Close: Double;
Volume: Int64;
end;
var
jsonDef: string;
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
recordValue: TScalarRecord;
visitor: IAstVisitor;
ast: IAstNode;
resultValue: TAstValue;
resultRecord: TScalarRecord;
i: Integer;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---');
// --- 1. Arrange (in Delphi) ---
Memo1.Lines.Add('1. Arranging test data in Delphi...');
// Clear and prepare the global scope for the script.
FGScope.Clear;
RegisterNativeFunctions(FGScope);
// Generate JSON definition from our test record type.
jsonDef := TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV));
FGScope.SetValue('ohlcvDef', TAstValue.FromText(jsonDef));
Memo1.Lines.Add(' - Generated and injected JSON definition for TOHLCV.');
// Create a TScalarRecordSeries and populate it with some data.
recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef);
series := TScalarRecordSeries.Create(recordDef);
for i := 0 to 4 do
begin
recordValue :=
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))
]
);
series.Add(recordValue);
end;
// Inject the pre-populated series into the script's scope.
FGScope.SetValue('ohlcvSeries', TAstValue.FromRecordSeries(series));
Memo1.Lines.Add(Format(' - Created and injected a series with %d records.', [series.TotalCount]));
Memo1.Lines.Add('');
// --- 2. Act (in Script) ---
Memo1.Lines.Add('2. Executing script...');
// Create an AST that:
// a) Creates a new, empty series to test the native function.
// b) Accesses the 3rd element (index 2) of the pre-populated series.
// c) Returns the accessed record as the final result.
ast :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('newSeries'),
TAst.FunctionCall(TAst.Identifier('CreateRecordSeries'), [TAst.Identifier('ohlcvDef')])
),
TAst.Indexer(TAst.Identifier('ohlcvSeries'), TAst.Constant(TScalar.FromInt64(2)))
]
);
FLastAst := ast;
visitor := TEvaluatorVisitor.Create(FGScope);
resultValue := ast.Accept(visitor);
Memo1.Lines.Add(' - Script finished.');
Memo1.Lines.Add(Format(' - Script returned value of type: %s', [GetEnumName(TypeInfo(TAstValueKind), Ord(resultValue.Kind))]));
Memo1.Lines.Add('');
// --- 3. Assert (in Delphi) ---
Memo1.Lines.Add('3. Asserting results in Delphi...');
if (resultValue.Kind <> avkRecord) then
begin
Memo1.Lines.Add('TEST FAILED: Script did not return a record.');
exit;
end;
resultRecord := resultValue.AsRecord;
Memo1.Lines.Add(' - Result is a record, as expected.');
// Verify the 'Close' price of the 3rd record (index 2)
var closeValue := resultRecord.Items['Close'].Value.AsDouble;
var expectedClose := 102.0 + 2; // from the data generation loop for i=2
if (abs(closeValue - expectedClose) > 0.001) then
begin
Memo1.Lines.Add(Format('TEST FAILED: Expected Close price %f, but got %f.', [expectedClose, closeValue]));
exit;
end;
Memo1.Lines.Add(Format(' - Verified Close price: %f.', [closeValue]));
// Verify the 'Volume' of the 3rd record (index 2)
var volumeValue := resultRecord.Items['Volume'].Value.AsInt64;
var expectedVolume := 10000 * (2 + 1); // for i=2
if (volumeValue <> expectedVolume) then
begin
Memo1.Lines.Add(Format('TEST FAILED: Expected Volume %d, but got %d.', [expectedVolume, volumeValue]));
exit;
end;
Memo1.Lines.Add(Format(' - Verified Volume: %d.', [volumeValue]));
Memo1.Lines.Add('');
Memo1.Lines.Add('--- TEST PASSED ---');
end;
procedure TForm1.Test1ButtonClick(Sender: TObject);
var
scope: IExecutionScope;
ASTPlayground/Myc.Ast.RttiUtils.pas
+152
View File
@@ -0,0 +1,152 @@
unit Myc.Ast.RttiUtils;
interface
uses
System.SysUtils,
System.Rtti,
System.TypInfo,
Myc.Data.POD;
type
TRttiAstHelper = class
private
// Maps a Delphi RTTI type to its TScalarKind.
class function TypeToScalarKind(AType: TRttiType): TScalarKind; static;
public
// Creates a JSON definition string from a record type info.
class function RecordDefinitionToJson(ATypeInfo: PTypeInfo): string; static;
// Creates a record definition from a JSON string.
class function JsonToRecordDefinition(const AJson: string): TScalarRecordDefinition; static;
end;
implementation
uses
Myc.Data.Decimal,
System.JSON;
{ TRttiAstHelper }
class function TRttiAstHelper.JsonToRecordDefinition(const AJson: string): TScalarRecordDefinition;
var
jsonValue: TJSONValue;
rootObj: TJSONObject;
fieldsArray: TJSONArray;
i: Integer;
fieldObj: TJSONObject;
kindStr: string;
fields: TArray<TScalarRecordField>;
begin
jsonValue := TJSONObject.ParseJSONValue(AJson);
if not Assigned(jsonValue) then
exit;
try
if not (jsonValue is TJSONObject) then
exit;
rootObj := jsonValue as TJSONObject;
if not rootObj.TryGetValue<TJSONArray>('fields', fieldsArray) then
exit;
SetLength(fields, fieldsArray.Count);
for i := 0 to fieldsArray.Count - 1 do
begin
fieldObj := fieldsArray.Items[i] as TJSONObject;
if not Assigned(fieldObj) then
continue; // or raise error
fields[i].Name := fieldObj.GetValue<string>('name');
kindStr := fieldObj.GetValue<string>('kind');
fields[i].Kind := TScalarKind(GetEnumValue(TypeInfo(TScalarKind), kindStr));
end;
Result := TScalarRecordDefinition.Create(fields);
finally
jsonValue.Free;
end;
end;
class function TRttiAstHelper.RecordDefinitionToJson(ATypeInfo: PTypeInfo): string;
var
ctx: TRttiContext;
rttiType: TRttiType;
rttiRecordType: TRttiRecordType;
field: TRttiField;
rootObj: TJSONObject;
fieldsArray: TJSONArray;
fieldObj: TJSONObject;
begin
// 1. Create TRttiContext and get TRttiRecordType.
ctx := TRttiContext.Create;
rttiType := ctx.GetType(ATypeInfo);
if not (rttiType is TRttiRecordType) then
raise EArgumentException.Create('PTypeInfo provided is not a record type.');
rttiRecordType := rttiType as TRttiRecordType;
// 2. Create root TJSONObject and a TJSONArray for 'fields'.
rootObj := TJSONObject.Create;
try
fieldsArray := TJSONArray.Create;
rootObj.AddPair('fields', fieldsArray);
// 3. Loop through all fields of the record type.
for field in rttiRecordType.GetFields do
begin
// 4a. Create a TJSONObject for the field definition.
fieldObj := TJSONObject.Create;
// 4b. Add field name.
fieldObj.AddPair('name', TJSONString.Create(field.Name));
// 4c. Call TypeToScalarKind to get the type and add it.
fieldObj.AddPair('kind', TJSONString.Create(GetEnumName(TypeInfo(TScalarKind), Ord(TypeToScalarKind(field.FieldType)))));
// 4d. Add the field object to the 'fields' array.
fieldsArray.Add(fieldObj);
end;
// 5. Convert the root JSON object to a string and set it as Result.
Result := rootObj.ToJSON;
finally
rootObj.Free;
end;
end;
class function TRttiAstHelper.TypeToScalarKind(AType: TRttiType): TScalarKind;
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
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
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
else
// 4. Raise an exception for unsupported types.
raise EArgumentException.CreateFmt('Unsupported record field type: %s', [AType.Name]);
end;
end.
ASTPlayground/Myc.Ast.Visualizer.pas
+77 -28
View File
@@ -127,6 +127,7 @@ type
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
function VisitAssignment(const Node: IAssignmentNode): TAstValue;
function VisitIndexer(const Node: IIndexerNode): TAstValue;
end;
TAuraWorkspace = class(TStyledControl)
@@ -198,6 +199,7 @@ type
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
function VisitAssignment(const Node: IAssignmentNode): TAstValue;
function VisitIndexer(const Node: IIndexerNode): TAstValue;
end;
constructor TAstToTextVisitor.Create;
@@ -264,6 +266,15 @@ begin
Result := TAstValue.FromText(Node.Condition.Accept(Self).AsText);
end;
function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
var
baseStr, indexStr: string;
begin
baseStr := Node.Base.Accept(Self).AsText;
indexStr := Node.Index.Accept(Self).AsText;
Result := TAstValue.FromText(Format('%s[%s]', [baseStr, indexStr]));
end;
function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
var
i: Integer;
@@ -942,6 +953,46 @@ begin
Result := TAstValue.Void;
end;
function TAstToAuraNodeVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
var
details: String;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
var indexerNode := CreateNodeControl('Expression', details);
FLastResult.OutputPin := CreateOutput(indexerNode);
FinalizeNodeLayout(indexerNode);
end
else
begin
VisitOperatorNode(
[Node.Base, Node.Index],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
indexerNode: TAuraNode;
basePin, indexPin, outPin: TControl;
begin
indexerNode := BuildNodeControl('[]', '');
indexerNode.TitleFont.Size := 20;
basePin := CreateInput(indexerNode, 'Base');
indexPin := CreateInput(indexerNode, 'Index');
outPin := CreateOutput(indexerNode);
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, basePin));
if Assigned(InputResults[1].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[1].OutputPin, indexPin));
FinalizeNodeLayout(indexerNode);
Result.LayoutNode := indexerNode;
Result.OutputPin := outPin;
end
);
end;
Result := TAstValue.Void;
end;
function TAstToAuraNodeVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
var
paramStr: String;
@@ -1122,13 +1173,12 @@ end;
function TAstToAuraNodeVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
var
varDeclNode: TAuraNode;
outPin: TControl;
begin
var details: String;
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
varDeclNode := CreateNodeControl('VarDecl', details);
var varDeclNode := CreateNodeControl('VarDecl', details);
CreateEntry(varDeclNode);
CreateExit(varDeclNode, '');
FinalizeNodeLayout(varDeclNode);
@@ -1137,40 +1187,39 @@ begin
begin
if Assigned(Node.Initializer) then
begin
varDeclNode :=
VisitOperatorNode(
[Node.Initializer],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
varDeclNode: TAuraNode;
inputPin: TControl;
initializerResult: TAuraNodeResult;
outPin: TControl; // variable for the output pin
begin
initializerResult := InputResults[0];
varDeclNode := BuildNodeControl('VarDecl', Node.Identifier.Name);
VisitOperatorNode(
[Node.Initializer],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
varDeclNode: TAuraNode;
inputPin: TControl;
initializerResult: TAuraNodeResult;
outPin: TControl; // variable for the output pin
begin
initializerResult := InputResults[0];
varDeclNode := BuildNodeControl('VarDecl', Node.Identifier.Name);
CreateEntry(varDeclNode);
inputPin := CreateInput(varDeclNode, 'Value');
CreateExit(varDeclNode, '');
CreateEntry(varDeclNode);
inputPin := CreateInput(varDeclNode, 'Value');
CreateExit(varDeclNode, '');
// Create the output pin before finalizing the layout.
outPin := CreateOutput(varDeclNode);
// Create the output pin before finalizing the layout.
outPin := CreateOutput(varDeclNode);
if Assigned(initializerResult.OutputPin) then
FConnections.Add(TPinConnection.Create(initializerResult.OutputPin, inputPin));
if Assigned(initializerResult.OutputPin) then
FConnections.Add(TPinConnection.Create(initializerResult.OutputPin, inputPin));
// Now finalize, all pins are present.
FinalizeNodeLayout(varDeclNode);
Result.LayoutNode := varDeclNode;
Result.OutputPin := outPin;
end
);
// Now finalize, all pins are present.
FinalizeNodeLayout(varDeclNode);
Result.LayoutNode := varDeclNode;
Result.OutputPin := outPin;
end
);
end
else
begin
// Case without initializer is a simple sequential node.
varDeclNode := CreateNodeControl('VarDecl', Node.Identifier.Name);
var varDeclNode := CreateNodeControl('VarDecl', Node.Identifier.Name);
CreateEntry(varDeclNode);
CreateExit(varDeclNode, '');
// Create the output pin before finalizing the layout.
Src/AST/Myc.Ast.Evaluator.pas
+154 -22
View File
@@ -31,6 +31,7 @@ type
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; virtual;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; virtual;
function VisitAssignment(const Node: IAssignmentNode): TAstValue; virtual;
function VisitIndexer(const Node: IIndexerNode): TAstValue; virtual;
end;
// TDebugEvaluatorVisitor now overrides all visit methods for full tracing
@@ -59,17 +60,25 @@ type
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override;
function VisitAssignment(const Node: IAssignmentNode): TAstValue; override;
function VisitIndexer(const Node: IIndexerNode): TAstValue; override;
end;
// Registers all native core functions in the given scope.
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
implementation
uses
Myc.Data.Decimal,
Myc.Ast.Scope,
Myc.Ast.Printer;
Myc.Ast.Printer,
Myc.Ast.RttiUtils; // Added for JsonToRecordDefinition
type
// Concrete implementation of the IEvaluatorClosure interface, private to this unit.
// The signature for a native Delphi function callable from the script.
TNativeFunction = function(const Args: TArray<TAstValue>): TAstValue;
// Concrete implementation of the IEvaluatorClosure interface for script-defined functions.
TClosureValue = class(TInterfacedObject, IEvaluatorClosure)
private
FBody: IExpressionNode;
@@ -82,6 +91,50 @@ type
constructor Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; const AClosureScope: IExecutionScope);
end;
// Concrete implementation of IEvaluatorClosure for native Delphi functions.
TNativeClosure = class(TInterfacedObject, IEvaluatorClosure)
private
FMethod: TNativeFunction;
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
public
constructor Create(const AMethod: TNativeFunction);
property Method: TNativeFunction read FMethod;
end;
// --- Native Functions Implementation ---
function NativeCreateRecordSeries(const Args: TArray<TAstValue>): TAstValue;
var
jsonDef: string;
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
begin
if (Length(Args) <> 1) or (Args[0].Kind <> avkText) then
raise EArgumentException.Create('CreateRecordSeries requires one string argument.');
jsonDef := Args[0].AsText;
recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef);
if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON.');
series := TScalarRecordSeries.Create(recordDef);
Result := TAstValue.FromRecordSeries(series);
end;
// --- Registration Procedure ---
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
var
closure: IEvaluatorClosure;
begin
// Register CreateRecordSeries
closure := TNativeClosure.Create(NativeCreateRecordSeries);
AScope.SetValue('CreateRecordSeries', TAstValue.FromClosure(closure));
end;
{ TClosureValue }
constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; const AClosureScope: IExecutionScope);
@@ -107,6 +160,29 @@ begin
Result := FParameters;
end;
{ TNativeClosure }
constructor TNativeClosure.Create(const AMethod: TNativeFunction);
begin
inherited Create;
FMethod := AMethod;
end;
function TNativeClosure.GetBody: IExpressionNode;
begin
Result := nil;
end;
function TNativeClosure.GetClosureScope: IExecutionScope;
begin
Result := nil;
end;
function TNativeClosure.GetParameters: TArray<IIdentifierNode>;
begin
Result := nil;
end;
{ TEvaluatorVisitor }
constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
@@ -169,6 +245,40 @@ begin
raise EArgumentException.CreateFmt('Identifier not found: "%s"', [Node.Name]);
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
var
baseValue, indexValue: TAstValue;
series: TScalarRecordSeries;
rec: TScalarRecord;
index: Int64;
indexScalar: TScalar;
begin
baseValue := Node.Base.Accept(Self);
indexValue := Node.Index.Accept(Self);
if (baseValue.Kind <> avkRecordSeries) then
raise EArgumentException.Create('Indexer `[]` can only be applied to a RecordSeries.');
if (indexValue.Kind <> avkScalar) then
raise EArgumentException.Create('Indexer `[]` requires a scalar 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;
series := baseValue.AsRecordSeries;
if (index < 0) or (index >= series.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
rec := series.Items[Integer(index)];
Result := TAstValue.FromRecord(rec);
end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
var
varName: string;
@@ -192,41 +302,51 @@ end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
var
calleeValue: TAstValue;
arguments: TList<IExpressionNode>;
closure: IEvaluatorClosure;
i: Integer;
argValues: TArray<TAstValue>;
callScope: IExecutionScope;
innerVisitor: IAstVisitor;
i: Integer;
argValue: TAstValue;
begin
calleeValue := Node.Callee.Accept(Self);
arguments := Node.Arguments;
if calleeValue.Kind <> avkClosure then
raise EArgumentException.Create('Expression is not a callable closure.');
closure := calleeValue.AsClosure;
if (arguments.Count <> Length(closure.Parameters)) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), arguments.Count]);
callScope := TExecutionScope.Create(closure.ClosureScope);
for i := 0 to arguments.Count - 1 do
// Distinguish between native and script-defined closures.
if closure is TNativeClosure then
begin
argValue := arguments[i].Accept(Self);
callScope.SetValue(closure.Parameters[i].Name, argValue);
end;
// Native function call
SetLength(argValues, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
begin
argValues[i] := Node.Arguments[i].Accept(Self);
end;
Result := (closure as TNativeClosure).Method(argValues);
end
else if closure is TClosureValue then
begin
// Script function call (original logic)
if (Node.Arguments.Count <> Length(closure.Parameters)) then
raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]);
innerVisitor := Self.CreateVisitorForScope(callScope);
callScope := TExecutionScope.Create(closure.ClosureScope);
// Introduce 'Result' variable for imperative-style assignments within the closure.
callScope.SetValue('Result', TAstValue.Void);
for i := 0 to Node.Arguments.Count - 1 do
begin
argValues := [Node.Arguments[i].Accept(Self)];
callScope.SetValue(closure.Parameters[i].Name, argValues[0]);
end;
// The return value of the function is the value of its body expression.
// This supports both functional-style returns (direct value) and
// imperative-style returns (via an assignment, which also returns the value).
Result := closure.Body.Accept(innerVisitor);
innerVisitor := Self.CreateVisitorForScope(callScope);
callScope.SetValue('Result', TAstValue.Void);
Result := closure.Body.Accept(innerVisitor);
end
else
raise EArgumentException.Create('Unknown closure implementation type.');
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
@@ -475,6 +595,18 @@ begin
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
begin
AppendLine('Indexer {');
Indent;
try
Result := inherited VisitIndexer(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue;
begin
AppendLine('TernaryExpr{');
Src/AST/Myc.Ast.Nodes.pas
+50 -5
View File
@@ -20,8 +20,8 @@ type
function ToString: string;
end;
// Added avkText to represent a string value.
TAstValueKind = (avkUndefined, avkScalar, avkClosure, avkText);
// Added avkRecord to represent a TScalarRecord value.
TAstValueKind = (avkUndefined, avkScalar, avkClosure, avkText, avkRecordSeries, avkRecord);
// --- Forward Declarations to break cycles ---
IExecutionScope = interface;
@@ -40,6 +40,8 @@ type
IBlockExpressionNode = interface;
IVariableDeclarationNode = interface;
IAssignmentNode = interface;
// Added forward declaration for the new indexer node.
IIndexerNode = interface;
IEvaluatorClosure = interface;
// --- Concrete Type Definitions ---
@@ -59,7 +61,7 @@ type
private
type
IVal<T> = interface
['{70210CAF-0857-4BF1-8254-B8239A155A02}']
['{7D5AD675-A008-4007-B1A4-CF7A05749510}'] // needed, do not remove
function GetValue: T;
property Value: T read GetValue;
end;
@@ -84,9 +86,13 @@ type
class function FromScalar(const AValue: TScalar): TAstValue; static;
class function FromClosure(const AValue: IEvaluatorClosure): TAstValue; static;
class function FromText(const AValue: String): TAstValue; static;
class function FromRecordSeries(const AValue: TScalarRecordSeries): TAstValue; static;
class function FromRecord(const AValue: TScalarRecord): TAstValue; static;
function AsScalar: TScalar;
function AsClosure: IEvaluatorClosure;
function AsText: String;
function AsRecordSeries: TScalarRecordSeries;
function AsRecord: TScalarRecord;
function ToString: String;
property IsVoid: Boolean read GetIsVoid;
property Kind: TAstValueKind read GetKind;
@@ -105,19 +111,18 @@ type
end;
IAstVisitor = interface
['{A58B0A8E-F438-4217-A964-6E35624A9A4A}']
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;
// Added visitor method for the new ternary expression node.
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;
end;
IAstNode = interface(IInterface)
@@ -228,6 +233,16 @@ type
property Value: IExpressionNode read GetValue;
end;
// Represents an index access expression (e.g., series[index]).
IIndexerNode = interface(IExpressionNode)
{$region 'private'}
function GetBase: IExpressionNode;
function GetIndex: IExpressionNode;
{$endregion}
property Base: IExpressionNode read GetBase;
property Index: IExpressionNode read GetIndex;
end;
implementation
uses
@@ -261,6 +276,20 @@ begin
Result := IEvaluatorClosure(FInterface);
end;
function TAstValue.AsRecord: TScalarRecord;
begin
if (FKind <> avkRecord) then
raise EInvalidCast.Create('Cannot read value as Record.');
Result := (FInterface as IVal<TScalarRecord>).Value;
end;
function TAstValue.AsRecordSeries: TScalarRecordSeries;
begin
if (FKind <> avkRecordSeries) then
raise EInvalidCast.Create('Cannot read value as RecordSeries.');
Result := (FInterface as IVal<TScalarRecordSeries>).Value;
end;
function TAstValue.AsScalar: TScalar;
begin
if (FKind <> avkScalar) then
@@ -283,6 +312,20 @@ begin
Result.FScalar := Default(TScalar);
end;
class function TAstValue.FromRecord(const AValue: TScalarRecord): TAstValue;
begin
Result.FKind := avkRecord;
Result.FInterface := TVal<TScalarRecord>.Create(AValue);
Result.FScalar := Default(TScalar);
end;
class function TAstValue.FromRecordSeries(const AValue: TScalarRecordSeries): TAstValue;
begin
Result.FKind := avkRecordSeries;
Result.FInterface := TVal<TScalarRecordSeries>.Create(AValue);
Result.FScalar := Default(TScalar);
end;
class function TAstValue.FromScalar(const AValue: TScalar): TAstValue;
begin
Result.FKind := avkScalar;
@@ -313,6 +356,8 @@ begin
avkScalar: Result := FScalar.ToString;
avkClosure: Result := '<closure>';
avkText: Result := AsText;
avkRecordSeries: Result := '<record_series>';
avkRecord: Result := '<record>';
avkUndefined: Result := '<void>';
else
Result := '[Unknown AstValue]';
Src/AST/Myc.Ast.Printer.pas
+19 -2
View File
@@ -33,6 +33,7 @@ type
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
function VisitAssignment(const Node: IAssignmentNode): TAstValue;
function VisitIndexer(const Node: IIndexerNode): TAstValue;
end;
implementation
@@ -64,12 +65,12 @@ end;
procedure TPrettyPrintVisitor.Indent;
begin
inc(FIndentLevel, 2);
inc(FIndentLevel, 4);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
dec(FIndentLevel, 2);
dec(FIndentLevel, 4);
end;
procedure TPrettyPrintVisitor.AppendLine(const S: string);
@@ -225,4 +226,20 @@ begin
Result := TAstValue.Void;
end;
function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
begin
AppendLine('Indexer');
Indent;
AppendLine('Base:');
Indent;
Node.Base.Accept(Self);
Unindent;
AppendLine('Index:');
Indent;
Node.Index.Accept(Self);
Unindent;
Unindent;
Result := TAstValue.Void;
end;
end.
Src/AST/Myc.Ast.pas
+44
View File
@@ -33,6 +33,8 @@ type
class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode; static;
class function Assign(const AIdentifier: IIdentifierNode; const AValue: IExpressionNode): IAssignmentNode; static;
class function AssignResult(const AValue: IExpressionNode): IAssignmentNode; static;
// Added factory for the new indexer node.
class function Indexer(const ABase: IExpressionNode; const AIndex: IExpressionNode): IIndexerNode; static;
end;
implementation
@@ -183,6 +185,19 @@ type
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TIndexerNode }
// Concrete implementation for the indexer node.
TIndexerNode = class(TAstNode, IIndexerNode)
private
FBase: IExpressionNode;
FIndex: IExpressionNode;
function GetBase: IExpressionNode;
function GetIndex: IExpressionNode;
public
constructor Create(const ABase: IExpressionNode; const AIndex: IExpressionNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TConstantNode }
constructor TConstantNode.Create(AValue: TScalar);
@@ -467,6 +482,30 @@ begin
Result := FValue;
end;
{ TIndexerNode }
constructor TIndexerNode.Create(const ABase, AIndex: IExpressionNode);
begin
inherited Create;
FBase := ABase;
FIndex := AIndex;
end;
function TIndexerNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitIndexer(Self);
end;
function TIndexerNode.GetBase: IExpressionNode;
begin
Result := FBase;
end;
function TIndexerNode.GetIndex: IExpressionNode;
begin
Result := FIndex;
end;
{ TAst }
class function TAst.Assign(const AIdentifier: IIdentifierNode; const AValue: IExpressionNode): IAssignmentNode;
@@ -509,6 +548,11 @@ begin
Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch);
end;
class function TAst.Indexer(const ABase, AIndex: IExpressionNode): IIndexerNode;
begin
Result := TIndexerNode.Create(ABase, AIndex);
end;
class function TAst.TernaryExpr(const ACondition, AThenBranch, AElseBranch: IExpressionNode): ITernaryExpressionNode;
begin
Result := TTernaryExpressionNode.Create(ACondition, AThenBranch, AElseBranch);
Src/Data/Myc.Data.POD.pas
+79 -7
View File
@@ -114,7 +114,14 @@ type
constructor Create(const AName: String; AKind: TScalarKind);
end;
TScalarRecordDefinition = TArray<TScalarRecordField>;
TScalarRecordDefinition = record
private
FFields: TArray<TScalarRecordField>;
public
constructor Create(const AFields: TArray<TScalarRecordField>);
function IndexOf(const Name: String): Integer;
property Fields: TArray<TScalarRecordField> read FFields;
end;
// A record of scalar values, based on a definition.
TScalarRecord = record
@@ -152,6 +159,20 @@ type
FItems: TSeries<TScalarValue>;
end;
TScalarMemberSeries = record
private
FDef: TScalarRecordDefinition;
FArray: TChunkArray<TScalarValue>;
FElement: Integer;
function GetCount: Int64; inline;
function GetItems(Idx: Integer): TScalarValue;
public
constructor Create(const ADef: TScalarRecordDefinition; const AArray: TChunkArray<TScalarValue>; AElement: Integer);
property Count: Int64 read GetCount;
property Element: Integer read FElement;
property Items[Idx: Integer]: TScalarValue read GetItems; default;
end;
// A time series of scalar records, optimized for memory and access speed.
TScalarRecordSeries = record
private
@@ -163,6 +184,7 @@ type
public
constructor Create(const ADef: TScalarRecordDefinition);
procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1);
function CreateMemberSeries(const Field: String): TScalarMemberSeries;
property Def: TScalarRecordDefinition read GetDef;
property Items[Idx: Integer]: TScalarRecord read GetItems; default;
property TotalCount: Int64 read FTotalCount;
@@ -384,7 +406,7 @@ end;
constructor TScalarRecord.Create(const ADef: TScalarRecordDefinition; const AFields: TArray<TScalarValue>);
begin
Assert(Length(ADef) = Length(AFields), 'Field definition and value count must match.');
Assert(Length(ADef.Fields) = Length(AFields), 'Field definition and value count must match.');
FDef := ADef;
FFields := AFields;
end;
@@ -405,9 +427,9 @@ var
fieldDef: TScalarRecordField;
begin
// Find the index of the field by name (case-insensitive)
for i := 0 to Length(FDef) - 1 do
for i := 0 to High(FDef.Fields) do
begin
fieldDef := FDef[i];
fieldDef := FDef.Fields[i];
if (CompareText(fieldDef.Name, Name) = 0) then
begin
// Found it. Construct the TScalar result from the kind and value.
@@ -445,7 +467,7 @@ end;
constructor TScalarRecordSeries.Create(const ADef: TScalarRecordDefinition);
begin
Assert(Length(ADef) > 0);
Assert(Length(ADef.Fields) > 0);
FDef := ADef;
FArray := Default(TChunkArray<TScalarValue>);
FTotalCount := 0;
@@ -453,10 +475,19 @@ end;
procedure TScalarRecordSeries.Add(const Item: TScalarRecord; Lookback: Int64 = -1);
begin
FArray.Add(Item.Fields, Length(FDef) * Lookback);
FArray.Add(Item.Fields, Length(FDef.Fields) * Lookback);
inc(FTotalCount);
end;
function TScalarRecordSeries.CreateMemberSeries(const Field: String): TScalarMemberSeries;
begin
var elem := FDef.IndexOf(Field);
if elem < 0 then
raise EArgumentException.CreateFmt('Field "%s" not found in record definition.', [Field]);
Result := TScalarMemberSeries.Create(FDef, FArray, elem);
end;
function TScalarRecordSeries.GetDef: TScalarRecordDefinition;
begin
Result := FDef;
@@ -467,12 +498,53 @@ var
values: TArray<TScalarValue>;
fieldCount: Integer;
begin
fieldCount := Length(FDef);
fieldCount := Length(FDef.Fields);
SetLength(values, fieldCount);
Move(FArray.ItemRef[(FArray.Count - fieldCount) - (Idx * fieldCount)]^, values[0], sizeof(TScalarValue) * fieldCount);
Result.Create(FDef, values);
end;
constructor TScalarMemberSeries.Create(const ADef: TScalarRecordDefinition; const AArray: TChunkArray<TScalarValue>; AElement: Integer);
begin
FDef := ADef;
FArray := AArray;
FElement := AElement;
end;
function TScalarMemberSeries.GetCount: Int64;
begin
Result := FArray.Count;
end;
function TScalarMemberSeries.GetItems(Idx: Integer): TScalarValue;
var
values: TArray<TScalarValue>;
fieldCount: Integer;
begin
fieldCount := Length(FDef.Fields);
SetLength(values, fieldCount);
Result := FArray.ItemRef[(FArray.Count - fieldCount) - (Idx * fieldCount)]^;
end;
constructor TScalarRecordDefinition.Create(const AFields: TArray<TScalarRecordField>);
begin
FFields := AFields;
end;
function TScalarRecordDefinition.IndexOf(const Name: String): Integer;
var
i: Integer;
fieldDef: TScalarRecordField;
begin
// Find the index of the field by name (case-insensitive)
for i := 0 to High(FFields) do
if (CompareText(FFields[i].Name, Name) = 0) then
exit(i);
// If we get here, the field was not found.
raise EArgumentException.CreateFmt('Field "%s" not found in record definition.', [Name]);
end;
initialization
Assert(sizeof(TScalarValue) = 8);