Michael Schimmel
474 lines
17 KiB
ObjectPascal
474 lines
17 KiB
ObjectPascal
unit Myc.Ast.Evaluator;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.Generics.Collections,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Ast.Nodes,
|
|
Myc.Ast.Scope;
|
|
|
|
type
|
|
// A factory for creating visitors, primarily used by the debugger subsystem.
|
|
TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor;
|
|
|
|
// The standard AST evaluator for production use.
|
|
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
|
|
private
|
|
FScope: IExecutionScope;
|
|
protected
|
|
function IsTruthy(const AValue: TDataValue): Boolean; inline;
|
|
|
|
// Returns a closure that can create the correct type of visitor for a lambda's body.
|
|
function CreateVisitorFactory: TVisitorFactory; virtual;
|
|
|
|
property Scope: IExecutionScope read FScope;
|
|
public
|
|
constructor Create(const AScope: IExecutionScope);
|
|
|
|
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
|
|
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
|
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
|
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual;
|
|
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual;
|
|
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual;
|
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual;
|
|
function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual;
|
|
function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual;
|
|
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual;
|
|
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual;
|
|
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual;
|
|
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
|
|
end;
|
|
|
|
// Registers native Delphi functions into a scope.
|
|
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.TypInfo,
|
|
System.Generics.Defaults,
|
|
Myc.Data.Decimal,
|
|
Myc.Data.Series,
|
|
Myc.Data.Scalar.JSON;
|
|
|
|
// --- Native Functions Implementation ---
|
|
|
|
function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
jsonDef: string;
|
|
recordDef: TScalarRecordDefinition;
|
|
series: TScalarRecordSeries;
|
|
begin
|
|
if (Length(Args) <> 1) or (Args[0].Kind <> vkText) 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 := TDataValue.FromRecordSeries(series);
|
|
end;
|
|
|
|
// --- Registration Procedure ---
|
|
|
|
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
|
|
begin
|
|
AScope.Define('CreateRecordSeries', TDataValue(NativeCreateRecordSeries));
|
|
end;
|
|
|
|
{ TEvaluatorVisitor }
|
|
|
|
constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
|
|
begin
|
|
inherited Create;
|
|
Assert(Assigned(AScope));
|
|
FScope := AScope;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory;
|
|
begin
|
|
// The production visitor returns a factory that creates another production visitor.
|
|
Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
|
|
begin
|
|
if (AValue.Kind <> vkScalar) then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
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);
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
|
var
|
|
capturedCells: TArray<IValueCell>;
|
|
i: Integer;
|
|
sourceAddresses: TArray<TResolvedAddress>;
|
|
closureScope: IExecutionScope;
|
|
closureValue: TDataValue;
|
|
visitorFactory: TVisitorFactory;
|
|
begin
|
|
sourceAddresses := Node.Upvalues;
|
|
SetLength(capturedCells, Length(sourceAddresses));
|
|
for i := 0 to High(sourceAddresses) do
|
|
capturedCells[i] := FScope.Capture(sourceAddresses[i]);
|
|
|
|
if Node.HasNestedLambdas then
|
|
closureScope := FScope
|
|
else
|
|
closureScope := nil;
|
|
|
|
// Get the appropriate factory via virtual dispatch.
|
|
visitorFactory := CreateVisitorFactory();
|
|
|
|
var scopeDescriptor := Node.ScopeDescriptor;
|
|
var params := Node.Parameters;
|
|
|
|
closureValue :=
|
|
TDataValue.TFunc(
|
|
function(const ArgValues: TArray<TDataValue>): TDataValue
|
|
var
|
|
lambdaScope: IExecutionScope;
|
|
bodyVisitor: IAstVisitor;
|
|
i: Integer;
|
|
adr: TResolvedAddress;
|
|
begin
|
|
if (Length(ArgValues) <> Length(params)) then
|
|
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(params), Length(ArgValues)]);
|
|
|
|
lambdaScope := TExecutionScope.Create(closureScope, scopeDescriptor, capturedCells);
|
|
|
|
adr.Kind := akLocalOrParent;
|
|
adr.ScopeDepth := 0;
|
|
|
|
// Capture 'Self' (slot 0) for recursion.
|
|
adr.SlotIndex := 0;
|
|
lambdaScope[adr] := closureValue;
|
|
|
|
// Populate the actual parameters.
|
|
for i := 0 to High(ArgValues) do
|
|
begin
|
|
adr.SlotIndex := params[i].Address.SlotIndex;
|
|
lambdaScope[adr] := ArgValues[i];
|
|
end;
|
|
|
|
// Use the injected factory to create the visitor for the lambda's body.
|
|
bodyVisitor := visitorFactory(lambdaScope);
|
|
|
|
Result := Node.Body.Accept(bodyVisitor);
|
|
end
|
|
);
|
|
|
|
Result := closureValue;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
|
var
|
|
calleeValue: TDataValue;
|
|
begin
|
|
calleeValue := Node.Callee.Accept(Self);
|
|
|
|
if calleeValue.Kind <> vkMethod then
|
|
raise EArgumentException.Create('Expression is not invokable in this context.');
|
|
|
|
var argNodes := Node.Arguments;
|
|
case Length(argNodes) of
|
|
0: Result := (calleeValue.AsMethod)([]);
|
|
1: Result := (calleeValue.AsMethod)([argNodes[0].Accept(Self)]);
|
|
2: Result := (calleeValue.AsMethod)([argNodes[0].Accept(Self), argNodes[1].Accept(Self)]);
|
|
3: Result := (calleeValue.AsMethod)([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self)]);
|
|
4:
|
|
Result :=
|
|
(calleeValue.AsMethod)
|
|
([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self), argNodes[3].Accept(Self)]);
|
|
else
|
|
var argValues: TArray<TDataValue>;
|
|
SetLength(argValues, Length(argNodes));
|
|
for var i := 0 to High(argNodes) do
|
|
argValues[i] := argNodes[i].Accept(Self);
|
|
|
|
Result := (calleeValue.AsMethod)(argValues);
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
|
var
|
|
itemValue, lookbackValue, seriesVar: TDataValue;
|
|
lookback: Int64;
|
|
begin
|
|
seriesVar := FScope[Node.Series.Address];
|
|
itemValue := Node.Value.Accept(Self);
|
|
lookback := -1;
|
|
|
|
if Assigned(Node.Lookback) then
|
|
begin
|
|
lookbackValue := Node.Lookback.Accept(Self);
|
|
if (lookbackValue.Kind <> vkScalar) or not (lookbackValue.AsScalar.Kind in [skInteger, skInt64]) 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;
|
|
end;
|
|
|
|
case seriesVar.Kind of
|
|
vkSeries:
|
|
begin
|
|
if (itemValue.Kind <> vkScalar) then
|
|
raise EArgumentException.Create('Can only add scalar values to a TScalarSeries.');
|
|
|
|
with seriesVar.AsSeries do
|
|
begin
|
|
if (itemValue.AsScalar.Kind <> Kind) then
|
|
raise EArgumentException
|
|
.CreateFmt('Type mismatch: Cannot add %s to a series of %s.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]);
|
|
Add(itemValue.AsScalar.Value, lookback);
|
|
end;
|
|
end;
|
|
vkRecordSeries:
|
|
begin
|
|
if (itemValue.Kind <> vkRecord) then
|
|
raise EArgumentException.Create('Can only add record values to a TScalarRecordSeries.');
|
|
|
|
with seriesVar.AsRecordSeries do
|
|
begin
|
|
Add(itemValue.AsRecord, lookback);
|
|
end;
|
|
end;
|
|
else
|
|
raise EArgumentException.Create('"add" operation is only supported for series types.');
|
|
end;
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
|
begin
|
|
Result := Node.Value.Accept(Self);
|
|
FScope[Node.Identifier.Address] := Result;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
|
|
begin
|
|
Result := Node.Value;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
|
var
|
|
def: string;
|
|
begin
|
|
def := Node.Definition.Trim;
|
|
|
|
if def.StartsWith('[') then
|
|
begin
|
|
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
|
|
if Length(recordDef.Fields) = 0 then
|
|
raise EArgumentException.Create('Failed to parse record definition from JSON array.');
|
|
|
|
var recordSeries := TScalarRecordSeries.Create(recordDef);
|
|
Result := TDataValue.FromRecordSeries(recordSeries);
|
|
end
|
|
else
|
|
begin
|
|
var scalarKind := TScalar.StringToKind(def);
|
|
var scalarSeries := TScalarSeries.Create(scalarKind);
|
|
Result := TDataValue.FromSeries(scalarSeries);
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
|
begin
|
|
Result := FScope[Node.Address];
|
|
end;
|
|
|
|
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.');
|
|
|
|
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;
|
|
|
|
case baseValue.Kind of
|
|
vkSeries:
|
|
begin
|
|
with baseValue.AsSeries do
|
|
begin
|
|
if (index < 0) or (index >= TotalCount) then
|
|
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, TotalCount]);
|
|
Result := Items[Integer(index)];
|
|
end;
|
|
end;
|
|
vkRecordSeries:
|
|
begin
|
|
var 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]);
|
|
var recordValue := series.Items[Integer(index)];
|
|
Result := TDataValue.FromRecord(recordValue);
|
|
end;
|
|
vkMemberSeries:
|
|
begin
|
|
var memberSeries := baseValue.AsMemberSeries;
|
|
if (index < 0) or (index >= memberSeries.Count) then
|
|
raise EArgumentException
|
|
.CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]);
|
|
Result := memberSeries.Items[Integer(index)];
|
|
end;
|
|
else
|
|
raise EArgumentException.Create('Indexer `[]` is not supported for this value type.');
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
|
var
|
|
baseValue: TDataValue;
|
|
memberName: string;
|
|
begin
|
|
baseValue := Node.Base.Accept(Self);
|
|
memberName := Node.Member.Name;
|
|
|
|
case baseValue.Kind of
|
|
vkSeries:
|
|
begin
|
|
with baseValue.AsSeries do
|
|
begin
|
|
if SameText(memberName, 'Count') then
|
|
Result := TScalar.FromInt64(Count)
|
|
else if SameText(memberName, 'TotalCount') then
|
|
Result := TScalar.FromInt64(TotalCount)
|
|
else if SameText(memberName, 'Kind') then
|
|
Result := Kind.ToString
|
|
else
|
|
raise EArgumentException.CreateFmt('Member "%s" not found on TScalarSeries.', [memberName]);
|
|
end;
|
|
end;
|
|
vkRecordSeries: Result := TDataValue.FromMemberSeries(baseValue.AsRecordSeries.CreateMemberSeries(memberName));
|
|
vkRecord: Result := baseValue.AsRecord.Items[memberName];
|
|
else
|
|
raise EArgumentException.Create('Member access operator `.` is not supported for this value type.');
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
|
begin
|
|
if Assigned(Node.Initializer) then
|
|
Result := Node.Initializer.Accept(Self);
|
|
|
|
FScope[Node.Identifier.Address] := Result;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
|
var
|
|
leftValue, rightValue: TDataValue;
|
|
begin
|
|
leftValue := Node.Left.Accept(Self);
|
|
rightValue := Node.Right.Accept(Self);
|
|
|
|
if (leftValue.Kind <> vkScalar) or (rightValue.Kind <> vkScalar) then
|
|
raise ENotSupportedException.Create('Binary operations are only supported for scalar types.');
|
|
|
|
var res: TScalar;
|
|
if not TScalar.TryBinaryOperation(Node.Operator, leftValue.AsScalar, rightValue.AsScalar, res) then
|
|
raise ENotSupportedException.Create(
|
|
'Binary operation not supported for scalar types '
|
|
+ leftValue.AsScalar.Kind.ToString
|
|
+ ' and '
|
|
+ rightValue.AsScalar.Kind.ToString
|
|
+ ' .');
|
|
Result := res;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
|
var
|
|
rightValue: TDataValue;
|
|
begin
|
|
rightValue := Node.Right.Accept(Self);
|
|
|
|
if rightValue.Kind <> vkScalar then
|
|
raise ENotSupportedException.Create('Unary operations are only supported for scalar types.');
|
|
|
|
var res: TScalar;
|
|
if not TScalar.TryUnaryOperation(Node.Operator, rightValue.AsScalar, res) then
|
|
raise ENotSupportedException.Create('Unary operation not supported for scalar type' + rightValue.AsScalar.Kind.ToString + '.');
|
|
Result := res;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
|
begin
|
|
if IsTruthy(Node.Condition.Accept(Self)) then
|
|
Result := Node.ThenBranch.Accept(Self)
|
|
else if Assigned(Node.ElseBranch) then
|
|
Result := Node.ElseBranch.Accept(Self);
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
|
begin
|
|
if IsTruthy(Node.Condition.Accept(Self)) then
|
|
Result := Node.ThenBranch.Accept(Self)
|
|
else
|
|
Result := Node.ElseBranch.Accept(Self);
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
|
var
|
|
expression: IAstNode;
|
|
begin
|
|
Result := TDataValue.Void;
|
|
for expression in Node.Expressions do
|
|
Result := expression.Accept(Self);
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
|
var
|
|
seriesValue: TDataValue;
|
|
len: Int64;
|
|
begin
|
|
seriesValue := FScope[Node.Series.Address];
|
|
|
|
case seriesValue.Kind of
|
|
vkSeries: len := seriesValue.AsSeries.Count;
|
|
vkRecordSeries: len := seriesValue.AsRecordSeries.Count;
|
|
vkMemberSeries: len := seriesValue.AsMemberSeries.Count;
|
|
else
|
|
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
|
|
end;
|
|
|
|
Result := TScalar.FromInt64(len);
|
|
end;
|
|
|
|
end.
|