unit Myc.Ast.Evaluator; interface uses System.SysUtils, System.Classes, System.Generics.Collections, Myc.Data.Scalar, Myc.Data.Value, Myc.Data.Keyword, Myc.Ast.Nodes, Myc.Ast.Scope, Myc.Ast; type EEvaluatorException = class(EAstException); TEvaluatorFactory = reference to function(const AScope: IExecutionScope): IEvaluatorVisitor; TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor) private FScope: IExecutionScope; protected function Visit(const Node: IAstNode): TDataValue; virtual; function CreateVisitorFactory: TEvaluatorFactory; virtual; // Nur noch die für die Ausführung relevanten Methoden function VisitConstant(const N: IConstantNode): TDataValue; virtual; function VisitIdentifier(const N: IIdentifierNode): TDataValue; virtual; function VisitKeyword(const N: IKeywordNode): TDataValue; virtual; function VisitIfExpression(const N: IIfExpressionNode): TDataValue; virtual; function VisitCondExpression(const N: ICondExpressionNode): TDataValue; virtual; function VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue; virtual; function VisitFunctionCall(const N: IFunctionCallNode): TDataValue; virtual; function VisitBlockExpression(const N: IBlockExpressionNode): TDataValue; virtual; function VisitExpressionList(const N: IExpressionList): TDataValue; virtual; function VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue; virtual; function VisitAssignment(const N: IAssignmentNode): TDataValue; virtual; function VisitIndexer(const N: IIndexerNode): TDataValue; virtual; function VisitMemberAccess(const N: IMemberAccessNode): TDataValue; virtual; function VisitRecordLiteral(const N: IRecordLiteralNode): TDataValue; virtual; function VisitCreateSeries(const N: ICreateSeriesNode): TDataValue; virtual; function VisitAddSeriesItem(const N: IAddSeriesItemNode): TDataValue; virtual; function VisitSeriesLength(const N: ISeriesLengthNode): TDataValue; virtual; function VisitRecurNode(const N: IRecurNode): TDataValue; virtual; function VisitPipe(const N: IPipeNode): TDataValue; virtual; function IsTruthy(const AValue: TDataValue): Boolean; inline; public constructor Create(const AScope: IExecutionScope); function Execute(const RootNode: IAstNode): TDataValue; class procedure HandleTCO(var ResultValue: TDataValue); static; property Scope: IExecutionScope read FScope; end; implementation uses System.TypInfo, System.Generics.Defaults, Myc.Data.Decimal, Myc.Data.Series, Myc.Data.Stream, Myc.Data.Stream.Pipes, Myc.Data.Scalar.JSON, Myc.Ast.Types; type TThunk = record Callee: TDataValue; Args: TArray; Recur: Boolean; constructor Create(const ACallee: TDataValue; const AArgs: TArray; ARecur: Boolean); end; constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray; ARecur: Boolean); begin Callee := ACallee; Args := AArgs; Recur := ARecur; end; constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope); begin inherited Create; FScope := AScope; end; function TEvaluatorVisitor.Visit(const Node: IAstNode): TDataValue; begin // Der Hot-Path: Direkter Dispatch ohne Umweg über ungenutzte Methoden. case Node.Kind of akConstant: Result := VisitConstant(Node.AsConstant); akIdentifier: Result := VisitIdentifier(Node.AsIdentifier); akKeyword: Result := VisitKeyword(Node.AsKeyword); akIfExpression: Result := VisitIfExpression(Node.AsIfExpression); akCondExpression: Result := VisitCondExpression(Node.AsCondExpression); akLambdaExpression: Result := VisitLambdaExpression(Node.AsLambdaExpression); akFunctionCall: Result := VisitFunctionCall(Node.AsFunctionCall); akBlockExpression: Result := VisitBlockExpression(Node.AsBlockExpression); akExpressionList: Result := VisitExpressionList(Node.AsExpressionList); akVariableDeclaration: Result := VisitVariableDeclaration(Node.AsVariableDeclaration); akAssignment: Result := VisitAssignment(Node.AsAssignment); akIndexer: Result := VisitIndexer(Node.AsIndexer); akMemberAccess: Result := VisitMemberAccess(Node.AsMemberAccess); akRecordLiteral: Result := VisitRecordLiteral(Node.AsRecordLiteral); akCreateSeries: Result := VisitCreateSeries(Node.AsCreateSeries); akAddSeriesItem: Result := VisitAddSeriesItem(Node.AsAddSeriesItem); akSeriesLength: Result := VisitSeriesLength(Node.AsSeriesLength); akRecur: Result := VisitRecurNode(Node.AsRecur); akPipe: Result := VisitPipe(Node.AsPipe); akMacroExpansion: Result := Visit(Node.AsMacroExpansion.ExpandedBody); akNop: Result := TDataValue.Void; else Result := TDataValue.Void; end; end; class procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue); begin while (ResultValue.Kind = vkGeneric) do begin var thunk := ResultValue.AsGeneric; var callee := thunk.Callee.AsMethod(); ResultValue := callee(thunk.Args); end; end; function TEvaluatorVisitor.Execute(const RootNode: IAstNode): TDataValue; begin if not Assigned(RootNode) then exit(TDataValue.Void); try Result := Visit(RootNode); HandleTCO(Result); except on E: EAstException do raise; on E: Exception do raise EEvaluatorException.Create('Runtime: ' + E.Message); end; end; function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean; begin if (AValue.Kind <> vkScalar) then exit(false); case AValue.AsScalar.Kind of TScalar.TKind.Ordinal, TScalar.TKind.Keyword, TScalar.TKind.Boolean: Result := AValue.AsScalar.Value.AsInt64 <> 0; TScalar.TKind.Float, TScalar.TKind.DateTime: Result := AValue.AsScalar.Value.AsDouble <> 0.0; else Result := false; end; end; function TEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory; begin Result := function(const AScope: IExecutionScope): IEvaluatorVisitor begin Result := TEvaluatorVisitor.Create(AScope); end; end; function TEvaluatorVisitor.VisitConstant(const N: IConstantNode): TDataValue; begin Result := N.Value; end; function TEvaluatorVisitor.VisitKeyword(const N: IKeywordNode): TDataValue; begin Result := TDataValue(TScalar.FromKeyword(N.Value)); end; function TEvaluatorVisitor.VisitIdentifier(const N: IIdentifierNode): TDataValue; begin Result := FScope[N.Address]; end; function TEvaluatorVisitor.VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue; var capturedCells: TArray; i: Integer; closureScope: IExecutionScope; visitorFactory: TEvaluatorFactory; begin if Length(N.Upvalues) > 0 then begin SetLength(capturedCells, Length(N.Upvalues)); for i := 0 to High(N.Upvalues) do capturedCells[i] := FScope.Capture(N.Upvalues[i]); end else capturedCells := nil; closureScope := if N.HasNestedLambdas then FScope else nil; visitorFactory := CreateVisitorFactory(); var descriptor := N.Descriptor; var params := N.Parameters; var [unsafe] closure: TDataValue.TFunc; closure := function(const ArgValues: TArray): TDataValue var lambdaScope: IExecutionScope; bodyVisitor: IAstVisitor; k: Integer; begin if (Length(ArgValues) <> params.Count) then raise EEvaluatorException.Create('Arg mismatch'); lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells); // Self-reference for recursion (Slot 0) lambdaScope.SetValues(TResolvedAddress.Create(akLocalOrParent, 0, 0), TDataValue(closure)); for k := 0 to params.Count - 1 do lambdaScope[params[k].Address] := ArgValues[k]; bodyVisitor := visitorFactory(lambdaScope); Result := bodyVisitor.Visit(N.Body); end; Result := TDataValue(closure); end; function TEvaluatorVisitor.VisitFunctionCall(const N: IFunctionCallNode): TDataValue; var calleeValue: TDataValue; argValues: TArray; i: Integer; begin if Assigned(N.StaticTarget) then begin SetLength(argValues, N.Arguments.Count); for i := 0 to N.Arguments.Count - 1 do argValues[i] := Visit(N.Arguments[i]); Result := N.StaticTarget(argValues); if not N.IsTailCall then HandleTCO(Result); end else begin calleeValue := Visit(N.Callee); if (calleeValue.Kind <> vkMethod) then raise EEvaluatorException.Create('Not a function'); SetLength(argValues, N.Arguments.Count); for i := 0 to N.Arguments.Count - 1 do argValues[i] := Visit(N.Arguments[i]); if N.IsTailCall then Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues, false)) else begin Result := (calleeValue.AsMethod)(argValues); HandleTCO(Result); end; end; end; function TEvaluatorVisitor.VisitRecurNode(const N: IRecurNode): TDataValue; var argValues: TArray; i: Integer; begin SetLength(argValues, N.Arguments.Count); for i := 0 to N.Arguments.Count - 1 do argValues[i] := Visit(N.Arguments[i]); // The "self" function is always at Slot 0 var callee := FScope[TResolvedAddress.Create(akLocalOrParent, 0, 0)]; Result := TDataValue.FromGeneric(TThunk.Create(callee, argValues, true)); end; function TEvaluatorVisitor.VisitBlockExpression(const N: IBlockExpressionNode): TDataValue; begin Result := Visit(N.Expressions); end; function TEvaluatorVisitor.VisitExpressionList(const N: IExpressionList): TDataValue; var i: Integer; begin Result := TDataValue.Void; for i := 0 to N.Count - 1 do Result := Visit(N[i]); end; function TEvaluatorVisitor.VisitIfExpression(const N: IIfExpressionNode): TDataValue; begin if IsTruthy(Visit(N.Condition)) then Result := Visit(N.ThenBranch) else if Assigned(N.ElseBranch) then Result := Visit(N.ElseBranch) else Result := TDataValue.Void; end; function TEvaluatorVisitor.VisitCondExpression(const N: ICondExpressionNode): TDataValue; var i: Integer; begin for i := 0 to High(N.Pairs) do if IsTruthy(Visit(N.Pairs[i].Condition)) then exit(Visit(N.Pairs[i].Branch)); Result := Visit(N.ElseBranch); end; function TEvaluatorVisitor.VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue; var ident: IIdentifierNode; begin if Assigned(N.Initializer) then Result := Visit(N.Initializer) else Result := TDataValue.Void; ident := N.Target.AsIdentifier; if N.IsBoxed then FScope.DefineBoxed(ident.Address.SlotIndex, Result) else FScope[ident.Address] := Result; end; function TEvaluatorVisitor.VisitAssignment(const N: IAssignmentNode): TDataValue; begin Result := Visit(N.Value); FScope[N.Target.AsIdentifier.Address] := Result; end; function TEvaluatorVisitor.VisitIndexer(const N: IIndexerNode): TDataValue; var base, idx: TDataValue; begin base := Visit(N.Base); if base.IsVoid then exit(TDataValue.Void); idx := Visit(N.Index); if (base.Kind = vkSeries) then Result := TDataValue(base.AsSeries.Items[Integer(idx.AsScalar.Value.AsInt64)]) else if (base.Kind = vkRecordSeries) then begin var rs := base.AsRecordSeries; var vals: TArray; SetLength(vals, rs.Def.Count); var i64 := idx.AsScalar.Value.AsInt64; for var k := 0 to rs.Def.Count - 1 do vals[k] := rs.Fields[rs.Def.Keywords[k]].Items[Integer(i64)].Value; Result := TDataValue.FromScalarRecord(TScalarRecord.Create(rs.Def, vals)); end else raise EEvaluatorException.Create('Indexer error'); end; function TEvaluatorVisitor.VisitMemberAccess(const N: IMemberAccessNode): TDataValue; var base: TDataValue; begin base := Visit(N.Base); if base.IsVoid then exit(TDataValue.Void); case base.Kind of vkRecordSeries: Result := TDataValue.FromSeries(base.AsRecordSeries.Fields[N.Member.Value]); vkScalarRecord: Result := TDataValue(base.AsScalarRecord.Fields[N.Member.Value]); vkRecord: Result := TDataValue(base.AsRecord.Fields[N.Member.Value]); vkStream: Result := TDataValue.FromSeries(base.AsStream.Series.Fields[N.Member.Value]); else raise EEvaluatorException.Create('Member error'); end; end; function TEvaluatorVisitor.VisitRecordLiteral(const N: IRecordLiteralNode): TDataValue; var i: Integer; begin if Assigned(N.ScalarDefinition) then begin var vals: TArray; SetLength(vals, N.Fields.Count); for i := 0 to N.Fields.Count - 1 do vals[i] := Visit(N.Fields[i].Value).AsScalar.Value; Result := TDataValue.FromScalarRecord(TScalarRecord.Create(N.ScalarDefinition, vals)); end else begin var fields: TArray>; SetLength(fields, N.Fields.Count); for i := 0 to N.Fields.Count - 1 do fields[i] := TPair.Create(N.Fields[i].Key.Value, Visit(N.Fields[i].Value)); Result := TDataValue.FromGenericRecord(TGenericRecord.Create(fields)); end; end; function TEvaluatorVisitor.VisitCreateSeries(const N: ICreateSeriesNode): TDataValue; begin if N.Definition.Trim.StartsWith('[') then Result := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(TRttiAstHelper.JsonToRecordDefinition(N.Definition))) else Result := TDataValue.FromSeries(TScalarSeries.Create(TScalar.StringToKind(N.Definition))); end; function TEvaluatorVisitor.VisitAddSeriesItem(const N: IAddSeriesItemNode): TDataValue; begin var lb: Int64 := -1; if Assigned(N.Lookback) then lb := Visit(N.Lookback).AsScalar.Value.AsInt64; FScope[N.Series.Address].AsRecordSeries.Add(Visit(N.Value).AsScalarRecord, lb); Result := TDataValue.Void; end; function TEvaluatorVisitor.VisitSeriesLength(const N: ISeriesLengthNode): TDataValue; begin var s := FScope[N.Series.Address]; var len := if s.Kind = vkSeries then s.AsSeries.Count else s.AsRecordSeries.RecordCount; Result := TDataValue(TScalar.FromInt64(len)); end; function TEvaluatorVisitor.VisitPipe(const N: IPipeNode): TDataValue; var i: Integer; inputNode: IPipeInputNode; sources: TArray; config: TPipeConfig; inputVal: TDataValue; sourceSeries: IScalarRecordSeries; lambdaFunc: TDataValue.TFunc; begin SetLength(sources, N.Inputs.Count); SetLength(config, N.Inputs.Count); for i := 0 to N.Inputs.Count - 1 do begin inputNode := N.Inputs[i]; inputVal := FScope[inputNode.StreamSource.Address]; if (inputVal.Kind <> vkStream) then raise EEvaluatorException.Create('Stream expected'); sources[i] := inputVal.AsStream; sourceSeries := sources[i].Series; var srcDef := sourceSeries.Def; var selectors := inputNode.Selectors; SetLength(config[i], selectors.Count); for var k := 0 to selectors.Count - 1 do begin var key := selectors[k].Value; var idx := srcDef.IndexOf(key); config[i][k] := TScalarRecordField.Create(key, srcDef[idx]); end; end; lambdaFunc := Visit(N.Transformation).AsMethod(); var outputDef := N.StaticType.Definition; var pipeAdapter: TPipeStream.TPipeLambda := function(const S: array of ISeries; out R: array of TScalar.TValue): Boolean var args: TArray; res: TDataValue; k: Integer; begin SetLength(args, Length(S)); for k := 0 to High(S) do args[k] := S[k].Items[0]; res := lambdaFunc(args); if res.IsVoid then exit(False); var rec := res.AsScalarRecord; for k := 0 to rec.Count - 1 do R[k] := rec.Items[k].Value; Result := True; end; Result := TDataValue.FromStream(TPipeStream.Create(config, outputDef, sources, pipeAdapter)); end; end.