diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index 311c3c9..220bab0 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -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} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index a738789..11bb4be 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Debug + Release Win64 ASTPlayground 2 @@ -141,6 +141,7 @@ + Base @@ -190,6 +191,12 @@ true + + + ASTPlayground.exe + true + + 1 diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index 5dc8b52..a01f850 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -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 diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 0b382ac..6033b0a 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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; diff --git a/ASTPlayground/Myc.Ast.RttiUtils.pas b/ASTPlayground/Myc.Ast.RttiUtils.pas new file mode 100644 index 0000000..2b692f1 --- /dev/null +++ b/ASTPlayground/Myc.Ast.RttiUtils.pas @@ -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; +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('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('name'); + + kindStr := fieldObj.GetValue('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. diff --git a/ASTPlayground/Myc.Ast.Visualizer.pas b/ASTPlayground/Myc.Ast.Visualizer.pas index 4e73ca0..3b0e423 100644 --- a/ASTPlayground/Myc.Ast.Visualizer.pas +++ b/ASTPlayground/Myc.Ast.Visualizer.pas @@ -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. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 3a25f9a..bf1f9be 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -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; + + // 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; 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; + function GetClosureScope: IExecutionScope; + public + constructor Create(const AMethod: TNativeFunction); + property Method: TNativeFunction read FMethod; + end; + +// --- Native Functions Implementation --- + +function NativeCreateRecordSeries(const Args: TArray): 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; 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; +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; closure: IEvaluatorClosure; + i: Integer; + argValues: TArray; 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{'); diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 026b907..f76af6b 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -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 = 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).Value; +end; + +function TAstValue.AsRecordSeries: TScalarRecordSeries; +begin + if (FKind <> avkRecordSeries) then + raise EInvalidCast.Create('Cannot read value as RecordSeries.'); + Result := (FInterface as IVal).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.Create(AValue); + Result.FScalar := Default(TScalar); +end; + +class function TAstValue.FromRecordSeries(const AValue: TScalarRecordSeries): TAstValue; +begin + Result.FKind := avkRecordSeries; + Result.FInterface := TVal.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 := ''; avkText: Result := AsText; + avkRecordSeries: Result := ''; + avkRecord: Result := ''; avkUndefined: Result := ''; else Result := '[Unknown AstValue]'; diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index 6fa6f32..1f9adb9 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -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. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 689e38e..e2e3571 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -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); diff --git a/Src/Data/Myc.Data.POD.pas b/Src/Data/Myc.Data.POD.pas index 1573450..470665a 100644 --- a/Src/Data/Myc.Data.POD.pas +++ b/Src/Data/Myc.Data.POD.pas @@ -114,7 +114,14 @@ type constructor Create(const AName: String; AKind: TScalarKind); end; - TScalarRecordDefinition = TArray; + TScalarRecordDefinition = record + private + FFields: TArray; + public + constructor Create(const AFields: TArray); + function IndexOf(const Name: String): Integer; + property Fields: TArray read FFields; + end; // A record of scalar values, based on a definition. TScalarRecord = record @@ -152,6 +159,20 @@ type FItems: TSeries; end; + TScalarMemberSeries = record + private + FDef: TScalarRecordDefinition; + FArray: TChunkArray; + FElement: Integer; + function GetCount: Int64; inline; + function GetItems(Idx: Integer): TScalarValue; + public + constructor Create(const ADef: TScalarRecordDefinition; const AArray: TChunkArray; 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); 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); 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; 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; 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; + 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); +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);