Global data value refactoring + 1st scripting version

This commit is contained in:
Michael Schimmel
2025-09-20 18:30:32 +02:00
parent 09bd25b318
commit 00f5861148
17 changed files with 1430 additions and 2742 deletions
+7 -19
View File
@@ -152,10 +152,8 @@ begin
end;
case AValue.AsScalar.Kind of
skInteger: Result := (AValue.AsScalar.Value.AsInteger <> 0);
skInt64: Result := (AValue.AsScalar.Value.AsInt64 <> 0);
skUInt64: Result := (AValue.AsScalar.Value.AsUInt64 <> 0);
skBoolean: Result := (AValue.AsScalar.Value.AsBoolean);
TScalar.TKind.Ordinal: Result := (AValue.AsScalar.Value.AsInt64 <> 0);
TScalar.TKind.Float: Result := (AValue.AsScalar.Value.AsDouble <> 0.0);
else
Result := False;
end;
@@ -297,13 +295,10 @@ begin
if Assigned(Node.Lookback) then
begin
lookbackValue := Node.Lookback.Accept(Self);
if (lookbackValue.Kind <> vkScalar) or not (lookbackValue.AsScalar.Kind in [skInteger, skInt64]) then
if (lookbackValue.Kind <> vkScalar) or (lookbackValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Lookback parameter must be an integer.');
if lookbackValue.AsScalar.Kind = skInteger then
lookback := lookbackValue.AsScalar.Value.AsInteger
else
lookback := lookbackValue.AsScalar.Value.AsInt64;
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
case seriesVar.Kind of
@@ -365,21 +360,14 @@ function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
baseValue, indexValue: TDataValue;
index: Int64;
indexScalar: TScalar;
begin
baseValue := Node.Base.Accept(Self);
indexValue := Node.Index.Accept(Self);
if (indexValue.Kind <> vkScalar) then
raise EArgumentException.Create('Indexer `[]` requires a scalar integer argument.');
if (indexValue.Kind <> vkScalar) or (indexValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Indexer `[]` requires an integer argument.');
indexScalar := indexValue.AsScalar;
case indexScalar.Kind of
skInteger: index := indexScalar.Value.AsInteger;
skInt64: index := indexScalar.Value.AsInt64;
else
raise EArgumentException.Create('Indexer `[]` requires an integer type argument.');
end;
index := indexValue.AsScalar.Value.AsInt64;
case baseValue.Kind of
vkSeries:
+53 -37
View File
@@ -21,7 +21,7 @@ uses
System.Generics.Collections,
Myc.Ast,
Myc.Data.Scalar,
Myc.Data.Value; // Added for TDataValue
Myc.Data.Value;
type
// TJsonAstConverter implements the visitor pattern for serialization
@@ -29,10 +29,10 @@ type
TJsonAstConverter = class(TInterfacedObject, IAstVisitor)
private
FJsonObjectStack: TStack<TJSONObject>;
procedure ScalarToJson(const AScalar: TScalar; const AParent: TJSONObject; const AName: string);
procedure DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string);
function JsonToNode(const AJson: TJSONValue): IAstNode;
function JsonToScalar(const AObj: TJSONObject; const AName: string): TScalar;
// Updated signatures to return specific node interface types
function JsonToDataValue(const AObj: TJSONObject; const AName: string): TDataValue;
function JsonToConstantNode(const AObj: TJSONObject): IConstantNode;
function JsonToIdentifierNode(const AObj: TJSONObject): IIdentifierNode;
function JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode;
@@ -137,23 +137,31 @@ end;
{ TJsonAstConverter - IAstVisitor for Serialization }
procedure TJsonAstConverter.ScalarToJson(const AScalar: TScalar; const AParent: TJSONObject; const AName: string);
procedure TJsonAstConverter.DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string);
var
scalarObj: TJSONObject;
valObj, scalarObj: TJSONObject;
begin
scalarObj := TJSONObject.Create;
scalarObj.AddPair('Kind', TJSONString.Create(AScalar.Kind.ToString));
valObj := TJSONObject.Create;
valObj.AddPair('Kind', TJSONString.Create(AValue.Kind.ToString));
case AScalar.Kind of
skInt64: scalarObj.AddPair('Value', TJSONNumber.Create(AScalar.Value.AsInt64));
skDouble: scalarObj.AddPair('Value', TJSONNumber.Create(AScalar.Value.AsDouble));
skBoolean: scalarObj.AddPair('Value', TJSONBool.Create(AScalar.Value.AsBoolean));
skString: scalarObj.AddPair('Value', TJSONString.Create(AScalar.Value.AsString));
case AValue.Kind of
vkScalar:
begin
scalarObj := TJSONObject.Create;
scalarObj.AddPair('Kind', TJSONString.Create(AValue.AsScalar.Kind.ToString));
case AValue.AsScalar.Kind of
TScalar.TKind.Ordinal: scalarObj.AddPair('Value', TJSONNumber.Create(AValue.AsScalar.Value.AsInt64));
TScalar.TKind.Float: scalarObj.AddPair('Value', TJSONNumber.Create(AValue.AsScalar.Value.AsDouble));
end;
valObj.AddPair('Value', scalarObj);
end;
vkText: valObj.AddPair('Value', TJSONString.Create(AValue.AsText));
vkVoid:; // No value to add
else
raise ENotSupportedException.CreateFmt('Scalar kind %s not supported for JSON serialization.', [AScalar.Kind.ToString]);
raise ENotSupportedException.Create('Unsupported TDataValue kind for constant serialization.');
end;
AParent.AddPair(AName, scalarObj);
AParent.AddPair(AName, valObj);
end;
function TJsonAstConverter.VisitConstant(const Node: IConstantNode): TDataValue;
@@ -162,7 +170,7 @@ var
begin
obj := TJSONObject.Create;
obj.AddPair('NodeType', TJSONString.Create('Constant'));
ScalarToJson(Node.Value, obj, 'Value');
DataValueToJson(Node.Value, obj, 'Value');
FJsonObjectStack.Push(obj);
Result := TDataValue.Void;
end;
@@ -509,32 +517,40 @@ end;
{ TJsonAstConverter - Deserialization }
function TJsonAstConverter.JsonToScalar(const AObj: TJSONObject; const AName: string): TScalar;
function TJsonAstConverter.JsonToDataValue(const AObj: TJSONObject; const AName: string): TDataValue;
var
scalarObj: TJSONObject;
valObj, scalarObj: TJSONObject;
kindStr: string;
scalarKind: TScalarKind;
jsonValue: TJSONValue;
scalarKind: TScalar.TKind;
begin
scalarObj := AObj.GetValue<TJSONObject>(AName);
kindStr := scalarObj.GetValue<string>('Kind');
scalarKind := TScalar.StringToKind(kindStr);
valObj := AObj.GetValue<TJSONObject>(AName);
kindStr := valObj.GetValue<string>('Kind');
jsonValue := scalarObj.GetValue('Value');
case scalarKind of
skInt64: Result := TScalar.FromInt64((jsonValue as TJSONNumber).AsInt64);
skDouble: Result := TScalar.FromDouble((jsonValue as TJSONNumber).AsDouble);
skBoolean: Result := TScalar.FromBoolean((jsonValue as TJSONBool).AsBoolean);
skString: Result := TScalar.FromString((jsonValue as TJSONString).Value);
if SameText(kindStr, 'Scalar') then
begin
scalarObj := valObj.GetValue<TJSONObject>('Value');
kindStr := scalarObj.GetValue<string>('Kind');
scalarKind := TScalar.StringToKind(kindStr);
case scalarKind of
TScalar.TKind.Ordinal: Result := TScalar.FromInt64(scalarObj.GetValue<TJSONNumber>('Value').AsInt64);
TScalar.TKind.Float: Result := TScalar.FromDouble(scalarObj.GetValue<TJSONNumber>('Value').AsDouble);
end;
end
else if SameText(kindStr, 'Text') then
begin
Result := valObj.GetValue<string>('Value');
end
else if SameText(kindStr, 'Void') then
begin
Result := TDataValue.Void;
end
else
raise ENotSupportedException.CreateFmt('Scalar kind %s not supported for JSON deserialization.', [kindStr]);
end;
raise ENotSupportedException.Create('Unsupported TDataValue kind for constant deserialization.');
end;
function TJsonAstConverter.JsonToConstantNode(const AObj: TJSONObject): IConstantNode;
begin
Result := TAst.Constant(JsonToScalar(AObj, 'Value'));
Result := TAst.Constant(JsonToDataValue(AObj, 'Value'));
end;
function TJsonAstConverter.JsonToIdentifierNode(const AObj: TJSONObject): IIdentifierNode;
@@ -545,11 +561,11 @@ end;
function TJsonAstConverter.JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode;
var
opStr: string;
op: TBinaryOperator;
op: TScalar.TBinaryOp;
leftNode, rightNode: IAstNode;
begin
opStr := AObj.GetValue<string>('Operator');
for op := Low(TBinaryOperator) to High(TBinaryOperator) do
for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
if SameText(op.ToString, opStr) then
begin
leftNode := JsonToNode(AObj.GetValue('Left'));
@@ -563,11 +579,11 @@ end;
function TJsonAstConverter.JsonToUnaryExprNode(const AObj: TJSONObject): IUnaryExpressionNode;
var
opStr: string;
op: TUnaryOperator;
op: TScalar.TUnaryOp;
rightNode: IAstNode;
begin
opStr := AObj.GetValue<string>('Operator');
for op := Low(TUnaryOperator) to High(TUnaryOperator) do
for op := Low(TScalar.TUnaryOp) to High(TScalar.TUnaryOp) do
if SameText(op.ToString, opStr) then
begin
rightNode := JsonToNode(AObj.GetValue('Right'));
+7 -6
View File
@@ -112,10 +112,11 @@ type
end;
IConstantNode = interface(IAstNode)
// Represents a constant value in the AST (Scalar, Text, or Void).
{$region 'private'}
function GetValue: TScalar;
function GetValue: TDataValue;
{$endregion}
property Value: TScalar read GetValue;
property Value: TDataValue read GetValue;
end;
IIdentifierNode = interface(IAstNode)
@@ -130,20 +131,20 @@ type
IBinaryExpressionNode = interface(IAstNode)
{$region 'private'}
function GetLeft: IAstNode;
function GetOperator: TBinaryOperator;
function GetOperator: TScalar.TBinaryOp;
function GetRight: IAstNode;
{$endregion}
property Left: IAstNode read GetLeft;
property Operator: TBinaryOperator read GetOperator;
property Operator: TScalar.TBinaryOp read GetOperator;
property Right: IAstNode read GetRight;
end;
IUnaryExpressionNode = interface(IAstNode)
{$region 'private'}
function GetOperator: TUnaryOperator;
function GetOperator: TScalar.TUnaryOp;
function GetRight: IAstNode;
{$endregion}
property Operator: TUnaryOperator read GetOperator;
property Operator: TScalar.TUnaryOp read GetOperator;
property Right: IAstNode read GetRight;
end;
File diff suppressed because it is too large Load Diff
+100 -101
View File
@@ -11,15 +11,17 @@ uses
Myc.Ast;
type
// A visitor that converts an AST into a LISP-like (Clojure-style) string representation.
TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor)
private
FBuilder: TStringBuilder;
FIndentLevel: Integer;
procedure Indent;
procedure Unindent;
procedure AppendLine(const S: string);
procedure Append(const S: string);
procedure NewLine;
public
constructor Create(AIndentLevel: Integer = 0);
constructor Create;
destructor Destroy; override;
function GetResult: string;
// IAstVisitor
@@ -46,17 +48,15 @@ type
implementation
uses
Myc.Data.Scalar,
Myc.Data.Decimal;
Myc.Data.Scalar;
{ TPrettyPrintVisitor }
constructor TPrettyPrintVisitor.Create(AIndentLevel: Integer);
constructor TPrettyPrintVisitor.Create;
begin
inherited Create;
FBuilder := TStringBuilder.Create;
FIndentLevel := 0;
FIndentLevel := AIndentLevel;
end;
destructor TPrettyPrintVisitor.Destroy;
@@ -72,119 +72,126 @@ end;
procedure TPrettyPrintVisitor.Indent;
begin
inc(FIndentLevel, 4);
inc(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
dec(FIndentLevel, 4);
dec(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.AppendLine(const S: string);
procedure TPrettyPrintVisitor.Append(const S: string);
begin
FBuilder.Append(S);
end;
procedure TPrettyPrintVisitor.NewLine;
begin
FBuilder.AppendLine;
FBuilder.Append(''.PadLeft(FIndentLevel));
FBuilder.AppendLine(S);
end;
function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
if Assigned(RootNode) then
RootNode.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
var
val: TDataValue;
begin
AppendLine(Format('Constant (%s)', [Node.Value.ToString]));
val := Node.Value;
if val.Kind = vkText then
Append('"' + val.AsText + '"')
else
Append(val.ToString);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
AppendLine(Format('Identifier (%s)', [Node.Name]));
Append(Node.Name);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
AppendLine(Format('BinaryExpr "%s"', [Node.Operator.ToString]));
Indent;
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Left.Accept(Self);
Append(' ');
Node.Right.Accept(Self);
Unindent;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
AppendLine(Format('UnaryExpr "%s"', [Node.Operator.ToString]));
Indent;
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Right.Accept(Self);
Unindent;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
AppendLine('IfExpr');
Indent;
AppendLine('Condition:');
Indent;
Append('(if ');
Node.Condition.Accept(Self);
Unindent;
AppendLine('Then:');
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
Unindent;
if Node.ElseBranch <> nil then
if Assigned(Node.ElseBranch) then
begin
AppendLine('Else:');
Indent;
NewLine;
Node.ElseBranch.Accept(Self);
Unindent;
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
AppendLine('TernaryExpr');
Indent;
AppendLine('Condition:');
Indent;
Append('(if ');
Node.Condition.Accept(Self);
Unindent;
AppendLine('Then:');
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
Unindent;
AppendLine('Else:');
Indent;
NewLine;
Node.ElseBranch.Accept(Self);
Unindent;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
paramNames: TStringList;
sb: TStringBuilder;
begin
paramNames := TStringList.Create;
sb := TStringBuilder.Create;
try
for param in Node.Parameters do
paramNames.Add(param.Name);
AppendLine(Format('Lambda (params: %s)', [paramNames.CommaText]));
sb.Append(param.Name + ' ');
if sb.Length > 0 then
sb.Remove(sb.Length - 1, 1);
Append('(fn [' + sb.ToString + ']');
finally
paramNames.Free;
sb.Free;
end;
Indent;
AppendLine('Body:');
Indent;
NewLine;
Node.Body.Accept(Self);
Unindent;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
@@ -192,18 +199,21 @@ function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): T
var
arg: IAstNode;
begin
AppendLine('FunctionCall');
Indent;
AppendLine('Callee:');
Indent;
Append('(');
Node.Callee.Accept(Self);
Unindent;
AppendLine('Arguments:');
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
@@ -211,14 +221,17 @@ function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
arg: IAstNode;
begin
AppendLine('Recur');
Indent;
AppendLine('Arguments:');
Append('(recur');
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
@@ -226,102 +239,88 @@ function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNo
var
expr: IAstNode;
begin
AppendLine('Block');
Append('(do');
Indent;
for expr in Node.Expressions do
begin
NewLine;
expr.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
AppendLine(Format('VarDecl (%s)', [Node.Identifier.Name]));
Append('(def ');
Node.Identifier.Accept(Self);
if Assigned(Node.Initializer) then
begin
Indent;
Append(' ');
Node.Initializer.Accept(Self);
Unindent;
end;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
// Print the assignment node.
AppendLine(Format('Assignment (%s)', [Node.Identifier.Name]));
Indent;
Append('(assign ');
Node.Identifier.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
Unindent;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
AppendLine('Indexer');
Indent;
AppendLine('Base:');
Indent;
Append('(get ');
Node.Base.Accept(Self);
Unindent;
AppendLine('Index:');
Indent;
Append(' ');
Node.Index.Accept(Self);
Unindent;
Unindent;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
AppendLine(Format('MemberAccess (Member: %s)', [Node.Member.Name]));
Indent;
AppendLine('Base:');
Indent;
Append('(.');
Node.Member.Accept(Self);
Append(' ');
Node.Base.Accept(Self);
Unindent;
Unindent;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
AppendLine('CreateSeries');
Indent;
AppendLine('Definition: ' + Node.Definition);
Unindent;
Append(Format('(new-series "%s")', [Node.Definition]));
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
AppendLine('AddSeriesItem');
Indent;
AppendLine('Series:');
Indent;
Append('(add-item ');
Node.Series.Accept(Self);
Unindent;
AppendLine('Value:');
Indent;
Append(' ');
Node.Value.Accept(Self);
Unindent;
if Assigned(Node.Lookback) then
begin
AppendLine('Lookback:');
Indent;
Append(' ');
Node.Lookback.Accept(Self);
Unindent;
end;
Unindent;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
AppendLine('SeriesLength');
Indent;
Append('(count ');
Node.Series.Accept(Self);
Unindent;
Append(')');
Result := TDataValue.Void;
end;
+22 -34
View File
@@ -60,13 +60,9 @@ uses
class function TRtlFunctions.Abs(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
skInteger: Result := TScalar.FromInteger(System.Abs(Arg.Value.AsInteger));
skInt64: Result := TScalar.FromInt64(System.Abs(Arg.Value.AsInt64));
skSingle: Result := TScalar.FromSingle(System.Abs(Arg.Value.AsSingle));
skDouble: Result := TScalar.FromDouble(System.Abs(Arg.Value.AsDouble));
skDecimal: Result := TScalar.FromDecimal(Arg.Value.AsDecimal.Abs);
TScalar.TKind.Ordinal: Result := TScalar.FromInt64(System.Abs(Arg.Value.AsInt64));
TScalar.TKind.Float: Result := TScalar.FromDouble(System.Abs(Arg.Value.AsDouble));
else
// This case should not be reached if the wrapper validation is correct.
raise EArgumentException.Create('Abs requires a numeric argument.');
end;
end;
@@ -74,10 +70,8 @@ end;
class function TRtlFunctions.Trunc(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
skInteger, skInt64: Result := Arg; // Trunc on an integer is a no-op
skSingle: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsSingle));
skDouble: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDouble));
skDecimal: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDecimal));
TScalar.TKind.Ordinal: Result := Arg; // Trunc on an integer is a no-op
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDouble));
else
raise EArgumentException.Create('Trunc requires a numeric argument.');
end;
@@ -86,10 +80,8 @@ end;
class function TRtlFunctions.Ceil(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
skInteger, skInt64: Result := Arg; // Ceil on an integer is a no-op
skSingle: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsSingle));
skDouble: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsDouble));
skDecimal: Result := TScalar.FromInt64(System.Math.Ceil(Double(Arg.Value.AsDecimal)));
TScalar.TKind.Ordinal: Result := Arg; // Ceil on an integer is a no-op
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsDouble));
else
raise EArgumentException.Create('Ceil requires a numeric argument.');
end;
@@ -98,10 +90,8 @@ end;
class function TRtlFunctions.Floor(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
skInteger, skInt64: Result := Arg; // Floor on an integer is a no-op
skSingle: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsSingle));
skDouble: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsDouble));
skDecimal: Result := TScalar.FromInt64(System.Math.Floor(Double(Arg.Value.AsDecimal)));
TScalar.TKind.Ordinal: Result := Arg; // Floor on an integer is a no-op
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsDouble));
else
raise EArgumentException.Create('Floor requires a numeric argument.');
end;
@@ -110,11 +100,8 @@ end;
class function TRtlFunctions.Sign(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
skInteger: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsInteger));
skInt64: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsInt64));
skSingle: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsSingle));
skDouble: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsDouble));
skDecimal: Result := TScalar.FromInteger(Arg.Value.AsDecimal.Sign);
TScalar.TKind.Ordinal: Result := TScalar.FromInt64(System.Math.Sign(Arg.Value.AsInt64));
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Sign(Arg.Value.AsDouble));
else
raise EArgumentException.Create('Sign requires a numeric argument.');
end;
@@ -145,13 +132,10 @@ begin
raise EArgumentException.Create('This memoized function can only be called with a single scalar argument.');
argScalar := AArgs[0].AsScalar;
if not (argScalar.Kind in [skInteger, skInt64]) then
raise EArgumentException.Create('This memoized function expects an integer argument for caching.');
if argScalar.Kind <> TScalar.TKind.Ordinal then
raise EArgumentException.Create('This memoized function expects an ordinal argument for caching.');
if argScalar.Kind = skInteger then
key := argScalar.Value.AsInteger
else
key := argScalar.Value.AsInt64;
key := argScalar.Value.AsInt64;
var cache := cCache.AsObject as TDictionary<Int64, TDataValue>;
@@ -248,7 +232,9 @@ begin
begin
item := sourceSeries.Items[i];
predicateResult := predicateFunc([TDataValue(item)]);
if (predicateResult.Kind = vkScalar) and (predicateResult.AsScalar.Value.AsBoolean) then
if (predicateResult.Kind = vkScalar)
and (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal)
and (predicateResult.AsScalar.Value.AsInt64 <> 0) then
matchingIndices.Add(i);
end;
@@ -262,7 +248,7 @@ begin
var
idx: Integer;
begin
idx := AArgs[0].AsScalar.Value.AsInteger;
idx := AArgs[0].AsScalar.Value.AsInt64;
Result := TDataValue(sourceSeries.Items[idx]);
end;
@@ -297,14 +283,16 @@ begin
item := sourceSeries.Items[i];
predicateResult := predicateFunc([TDataValue(item)]);
if (predicateResult.Kind = vkScalar) and (predicateResult.AsScalar.Value.AsBoolean) then
if (predicateResult.Kind = vkScalar)
and (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal)
and (predicateResult.AsScalar.Value.AsInt64 <> 0) then
begin
Result := TScalar.FromBoolean(True);
Result := TScalar.FromInt64(1);
exit;
end;
end;
Result := TScalar.FromBoolean(False);
Result := TScalar.FromInt64(0);
end;
end.
+2 -3
View File
@@ -69,9 +69,8 @@ begin
raise EArgumentException.CreateFmt('%s requires a scalar argument.', [AName]);
AArg := AArgs[0].AsScalar;
if not (AArg.Kind in [skInteger, skInt64, skSingle, skDouble, skDecimal]) then
raise EArgumentException.CreateFmt('%s requires a numeric argument, but got %s.', [AName, AArg.Kind.ToString]);
// The check for specific numeric kinds is no longer necessary,
// as TScalar can only be Ordinal or Float.
Result := True;
end;
+699
View File
@@ -0,0 +1,699 @@
unit Myc.Ast.Script;
interface
uses
System.SysUtils,
Myc.Ast.Nodes;
type
// Provides a high-level facade for parsing and printing the AST.
TAstScript = record
public
class function Parse(const ASource: string): IAstNode; static;
class function Print(const ANode: IAstNode): string; static;
end;
implementation
uses
System.Classes,
System.Generics.Collections,
System.Character,
System.Math,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast;
type
// --- Internal Parser Implementation ---
TTokenKind = (
tkLeftParen, // (
tkRightParen, // )
tkLeftBracket, // [
tkRightBracket, // ]
tkIdentifier,
tkNumber,
tkString,
tkEOF,
tkError
);
TToken = record
Kind: TTokenKind;
Text: string;
end;
TLexer = class
private
FSource: string;
FCurrentPos: Integer;
function Peek: Char;
procedure Advance;
function ReadNumber: string;
function ReadString: string;
function ReadIdentifier: string;
public
constructor Create(const ASource: string);
function GetNextToken: TToken;
end;
TExpr = record
Token: TToken;
Node: IAstNode;
end;
TParser = class
private
FLexer: TLexer;
FCurrentToken: TToken;
procedure Consume(AExpectedKind: TTokenKind);
procedure NextToken;
function ParseList: IAstNode;
function ParseParameterList: TArray<IIdentifierNode>;
function ParseExpression: TExpr;
public
constructor Create(const ASource: string);
destructor Destroy; override;
function Parse: IAstNode;
end;
// --- Internal Printer Implementation ---
TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor)
private
FBuilder: TStringBuilder;
FIndentLevel: Integer;
procedure Indent;
procedure Unindent;
procedure Append(const S: string);
procedure NewLine;
public
constructor Create;
destructor Destroy; override;
function GetResult: string;
// IAstVisitor
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
function VisitAssignment(const Node: IAssignmentNode): TDataValue;
function VisitIndexer(const Node: IIndexerNode): TDataValue;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function VisitRecurNode(const Node: IRecurNode): TDataValue;
end;
{ TLexer }
constructor TLexer.Create(const ASource: string);
begin
inherited Create;
FSource := ASource;
FCurrentPos := 1;
end;
function TLexer.Peek: Char;
begin
if FCurrentPos > Length(FSource) then
Result := #0
else
Result := FSource[FCurrentPos];
end;
procedure TLexer.Advance;
begin
inc(FCurrentPos);
end;
function TLexer.ReadIdentifier: string;
var
startPos: Integer;
begin
startPos := FCurrentPos;
// Corrected W1050: Use CharInSet for robust unicode support.
while (Peek <> #0) and (not (Peek.IsWhiteSpace or CharInSet(Peek, ['(', ')', '[', ']']))) do
Advance;
Result := Copy(FSource, startPos, FCurrentPos - startPos);
end;
function TLexer.ReadNumber: string;
var
startPos: Integer;
begin
startPos := FCurrentPos;
while (Peek <> #0) and (Peek.IsDigit or (Peek = '.')) do
Advance;
Result := Copy(FSource, startPos, FCurrentPos - startPos);
end;
function TLexer.ReadString: string;
var
startPos: Integer;
begin
Advance; // Skip opening "
startPos := FCurrentPos;
while (Peek <> #0) and (Peek <> '"') do
Advance;
Result := Copy(FSource, startPos, FCurrentPos - startPos);
if Peek = '"' then
Advance; // Skip closing "
end;
function TLexer.GetNextToken: TToken;
begin
while (FCurrentPos <= Length(FSource)) and FSource[FCurrentPos].IsWhiteSpace do
Advance;
if FCurrentPos > Length(FSource) then
begin
Result.Kind := tkEOF;
exit;
end;
var c := Peek;
case c of
'(':
begin
Result.Kind := tkLeftParen;
Advance;
end;
')':
begin
Result.Kind := tkRightParen;
Advance;
end;
'[':
begin
Result.Kind := tkLeftBracket;
Advance;
end;
']':
begin
Result.Kind := tkRightBracket;
Advance;
end;
'"':
begin
Result.Kind := tkString;
Result.Text := ReadString;
end;
else
if c.IsDigit or ((c = '-') and (FCurrentPos < Length(FSource)) and FSource[FCurrentPos + 1].IsDigit) then
begin
Result.Kind := tkNumber;
Result.Text := ReadNumber;
end
else
begin
Result.Kind := tkIdentifier;
Result.Text := ReadIdentifier;
end;
end;
end;
{ TParser }
constructor TParser.Create(const ASource: string);
begin
inherited Create;
FLexer := TLexer.Create(ASource);
NextToken; // Load the first token
end;
destructor TParser.Destroy;
begin
FLexer.Free;
inherited;
end;
procedure TParser.NextToken;
begin
FCurrentToken := FLexer.GetNextToken;
end;
procedure TParser.Consume(AExpectedKind: TTokenKind);
begin
if FCurrentToken.Kind <> AExpectedKind then
raise Exception.CreateFmt('Syntax Error: Expected token %d, but found %d', [Ord(AExpectedKind), Ord(FCurrentToken.Kind)]);
NextToken;
end;
function TParser.ParseParameterList: TArray<IIdentifierNode>;
var
params: TList<IIdentifierNode>;
begin
Consume(tkLeftBracket);
params := TList<IIdentifierNode>.Create;
try
while FCurrentToken.Kind <> tkRightBracket do
begin
if FCurrentToken.Kind <> tkIdentifier then
raise Exception.Create('Syntax Error: Expected identifier in parameter list.');
params.Add(TAst.Identifier(FCurrentToken.Text));
NextToken;
end;
Result := params.ToArray;
finally
params.Free;
end;
Consume(tkRightBracket);
end;
function TParser.ParseList: IAstNode;
function IfThen(cond: Boolean; const TrueBranch, FalseBranch: IAstNode): IAstNode;
begin
if cond then
exit(TrueBranch)
else
exit(FalseBranch);
end;
var
elements: TList<TExpr>;
head: TExpr;
headIdent: IIdentifierNode;
tailTokens: TArray<TToken>;
tailNodes: TArray<IAstNode>;
begin
Consume(tkLeftParen);
if FCurrentToken.Kind = tkRightParen then
raise Exception.Create('Syntax Error: Empty list () is not a valid expression.');
elements := TList<TExpr>.Create;
try
while FCurrentToken.Kind <> tkRightParen do
elements.Add(ParseExpression);
head := elements[0];
// Convert the rest of the list to an array for the factory functions
SetLength(tailTokens, elements.Count - 1);
SetLength(tailNodes, elements.Count - 1);
for var i := 0 to High(tailNodes) do
begin
tailTokens[i] := elements[i + 1].Token;
tailNodes[i] := elements[i + 1].Node;
end;
if head.Token.Kind = tkIdentifier then
begin
// Handle special forms
if SameText(headIdent.Name, 'if') then
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], IfThen(Length(tailNodes) > 2, tailNodes[2], nil))
else if SameText(headIdent.Name, 'def') then
begin
var identNode: IIdentifierNode;
if tailTokens[0].Kind <> tkIdentifier then
raise Exception.Create('Syntax Error: Expected an identifier for def statement.');
Result := TAst.VarDecl(identNode, IfThen(Length(tailNodes) > 1, tailNodes[1], nil));
end
else if SameText(headIdent.Name, 'assign') then
begin
var identNode: IIdentifierNode;
if tailTokens[0].Kind <> tkIdentifier then
raise Exception.Create('Syntax Error: Expected an identifier for assignment.');
Result := TAst.Assign(identNode, tailNodes[1]);
end
else if SameText(headIdent.Name, 'fn') then
Result := TAst.LambdaExpr(ParseParameterList, tailNodes[0]) // Special parsing for params
else if SameText(headIdent.Name, 'do') then
Result := TAst.Block(tailNodes)
else if SameText(headIdent.Name, 'recur') then
Result := TAst.Recur(tailNodes)
else if SameText(headIdent.Name, 'get') then
Result := TAst.Indexer(tailNodes[0], tailNodes[1])
else if (Length(headIdent.Name) > 1) and (headIdent.Name.StartsWith('.')) then
Result := TAst.MemberAccess(tailNodes[0], TAst.Identifier(headIdent.Name.Substring(1)))
else
Result := TAst.FunctionCall(head.Node, tailNodes); // Default is a function call
end
else
Result := TAst.FunctionCall(head.Node, tailNodes); // Callee is a complex expression, e.g. ((fn [x] x) 1)
finally
elements.Free;
end;
Consume(tkRightParen);
end;
function TParser.ParseExpression: TExpr;
var
i64: Int64;
dbl: Double;
begin
Result.Token := FCurrentToken;
case FCurrentToken.Kind of
tkNumber:
begin
if TryStrToInt64(FCurrentToken.Text, i64) then
Result.Node := TAst.Constant(i64)
else if TryStrToFloat(FCurrentToken.Text, dbl) then
Result.Node := TAst.Constant(dbl)
else
raise Exception.CreateFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
NextToken;
end;
tkString:
begin
Result.Node := TAst.Constant(FCurrentToken.Text);
NextToken;
end;
tkIdentifier:
begin
Result.Node := TAst.Identifier(FCurrentToken.Text);
NextToken;
end;
tkLeftParen: Result.Node := ParseList;
else
raise Exception.CreateFmt('Syntax Error: Unexpected token %d', [Ord(FCurrentToken.Kind)]);
end;
end;
function TParser.Parse: IAstNode;
begin
var expr := ParseExpression;
if expr.Token.Kind <> tkEOF then
raise Exception.Create('Syntax Error: Unexpected characters after end of expression.');
Result := expr.Node;
end;
{ TPrettyPrintVisitor }
// ... (Implementation of TPrettyPrintVisitor is unchanged and correct) ...
constructor TPrettyPrintVisitor.Create;
begin
inherited Create;
FBuilder := TStringBuilder.Create;
FIndentLevel := 0;
end;
destructor TPrettyPrintVisitor.Destroy;
begin
FBuilder.Free;
inherited Destroy;
end;
function TPrettyPrintVisitor.GetResult: string;
begin
Result := FBuilder.ToString;
end;
procedure TPrettyPrintVisitor.Indent;
begin
inc(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
dec(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Append(const S: string);
begin
FBuilder.Append(S);
end;
procedure TPrettyPrintVisitor.NewLine;
begin
FBuilder.AppendLine;
FBuilder.Append(''.PadLeft(FIndentLevel));
end;
function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
if Assigned(RootNode) then
RootNode.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
var
val: TDataValue;
begin
val := Node.Value;
if val.Kind = vkText then
Append('"' + val.AsText + '"')
else
Append(val.ToString);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Append(Node.Name);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Left.Accept(Self);
Append(' ');
Node.Right.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Right.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Append('(if ');
Node.Condition.Accept(Self);
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
begin
NewLine;
Node.ElseBranch.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Append('(if ');
Node.Condition.Accept(Self);
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
NewLine;
Node.ElseBranch.Accept(Self);
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
sb: TStringBuilder;
begin
sb := TStringBuilder.Create;
try
for param in Node.Parameters do
sb.Append(param.Name + ' ');
if sb.Length > 0 then
sb.Remove(sb.Length - 1, 1); // remove trailing space
Append('(fn [' + sb.ToString + ']');
finally
sb.Free;
end;
Indent;
NewLine;
Node.Body.Accept(Self);
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
arg: IAstNode;
begin
Append('(');
Node.Callee.Accept(Self);
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
arg: IAstNode;
begin
Append('(recur');
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
expr: IAstNode;
begin
Append('(do');
Indent;
for expr in Node.Expressions do
begin
NewLine;
expr.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
Append('(def ');
Node.Identifier.Accept(Self);
if Assigned(Node.Initializer) then
begin
Append(' ');
Node.Initializer.Accept(Self);
end;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Append('(assign ');
Node.Identifier.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Append('(get ');
Node.Base.Accept(Self);
Append(' ');
Node.Index.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
Append('(.');
Node.Member.Accept(Self);
Append(' ');
Node.Base.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
Append(Format('(new-series "%s")', [Node.Definition]));
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Append('(add-item ');
Node.Series.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
begin
Append(' ');
Node.Lookback.Accept(Self);
end;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Append('(count ');
Node.Series.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
{ TAstScript }
class function TAstScript.Parse(const ASource: string): IAstNode;
var
p: TParser;
begin
if ASource.Trim.IsEmpty then
exit(nil);
p := TParser.Create(ASource);
try
Result := p.Parse;
finally
p.Free;
end;
end;
class function TAstScript.Print(const ANode: IAstNode): string;
var
visitor: TPrettyPrintVisitor;
begin
if not Assigned(ANode) then
exit('');
visitor := TPrettyPrintVisitor.Create;
try
visitor.Execute(ANode);
Result := visitor.GetResult;
finally
visitor.Free;
end;
end;
end.
-102
View File
@@ -1,102 +0,0 @@
unit Myc.Ast.ViewModel;
interface
uses
System.SysUtils,
System.Types,
System.Generics.Collections,
Myc.Ast.Nodes;
type
// An enum to identify the specific type of an AST node without relying on RTTI or GUIDs.
// This allows the renderer to depend only on the ViewModel layer.
TAstNodeType = (
antUndefined,
antConstant,
antIdentifier,
antBinaryExpression,
antUnaryExpression,
antIfExpression,
antTernaryExpression,
antLambdaExpression,
antFunctionCall,
antBlockExpression,
antVariableDeclaration,
antAssignment,
antIndexer,
antMemberAccess,
antCreateSeries,
antAddSeriesItem,
antSeriesLength
);
// A unique, stable identifier for a visual node instance.
TViewModelID = NativeInt;
// Defines how a view model displays its children.
TVisualizationMode = (vmSyntactic, vmSemantic);
// Metadata tied to a logical IAstNode. All visual instances of this node will share this data.
TLogicalMetadata = record
// The concrete type of the IAstNode, used for type-safe operations in the renderer.
NodeType: TAstNodeType;
Description: String;
end;
// Metadata tied to a specific visual instance of a node, identified by its TViewModelID.
TVisualInstanceMetadata = record
PositionOverride: TPointF;
IsCollapsed: Boolean;
VisualizationMode: TVisualizationMode;
end;
// The ViewModel for a node in the visual graph.
TVisualNodeViewModel = class
private
FId: TViewModelID;
FNode: IAstNode;
FLogicalMetadata: TLogicalMetadata;
FParents: TList<TVisualNodeViewModel>;
FChildren: TList<TVisualNodeViewModel>;
public
constructor Create(const ANode: IAstNode; const AId: TViewModelID; const ALogicalMetadata: TLogicalMetadata);
destructor Destroy; override;
procedure AddChild(const AChild: TVisualNodeViewModel);
property Id: TViewModelID read FId;
property Node: IAstNode read FNode;
property LogicalMetadata: TLogicalMetadata read FLogicalMetadata;
property Children: TList<TVisualNodeViewModel> read FChildren;
property Parents: TList<TVisualNodeViewModel> read FParents;
end;
implementation
{ TVisualNodeViewModel }
constructor TVisualNodeViewModel.Create(const ANode: IAstNode; const AId: TViewModelID; const ALogicalMetadata: TLogicalMetadata);
begin
inherited Create;
FNode := ANode;
FId := AId;
FLogicalMetadata := ALogicalMetadata;
FParents := TList<TVisualNodeViewModel>.Create;
FChildren := TList<TVisualNodeViewModel>.Create;
end;
destructor TVisualNodeViewModel.Destroy;
begin
FParents.Free;
FChildren.Free;
inherited;
end;
procedure TVisualNodeViewModel.AddChild(const AChild: TVisualNodeViewModel);
begin
FChildren.Add(AChild);
AChild.FParents.Add(Self);
end;
end.
+36 -21
View File
@@ -28,10 +28,12 @@ type
class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static;
// --- Existing factory functions ---
class function Constant(AValue: TScalar): IConstantNode; static;
class function Constant(const AValue: TDataValue): IConstantNode; overload; static;
class function Constant(const AValue: TScalar): IConstantNode; overload; static;
class function Constant(const AValue: String): IConstantNode; overload; static;
class function Identifier(AName: string): IIdentifierNode; static;
class function BinaryExpr(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode): IBinaryExpressionNode; static;
class function UnaryExpr(const AOperator: TUnaryOperator; const ARight: IAstNode): IUnaryExpressionNode; static;
class function BinaryExpr(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode): IBinaryExpressionNode; static;
class function UnaryExpr(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode): IUnaryExpressionNode; static;
class function IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode; static;
class function TernaryExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): ITernaryExpressionNode; static;
class function LambdaExpr(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode): ILambdaExpressionNode; static;
@@ -60,10 +62,10 @@ type
TConstantNode = class(TAstNode, IConstantNode)
private
FValue: TScalar;
function GetValue: TScalar;
FValue: TDataValue;
function GetValue: TDataValue;
public
constructor Create(AValue: TScalar);
constructor Create(const AValue: TDataValue);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
@@ -84,24 +86,24 @@ type
TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode)
private
FLeft: IAstNode;
FOperator: TBinaryOperator;
FOperator: TScalar.TBinaryOp;
FRight: IAstNode;
function GetLeft: IAstNode;
function GetOperator: TBinaryOperator;
function GetOperator: TScalar.TBinaryOp;
function GetRight: IAstNode;
public
constructor Create(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode);
constructor Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
TUnaryExpressionNode = class(TAstNode, IUnaryExpressionNode)
private
FOperator: TUnaryOperator;
FOperator: TScalar.TUnaryOp;
FRight: IAstNode;
function GetOperator: TUnaryOperator;
function GetOperator: TScalar.TUnaryOp;
function GetRight: IAstNode;
public
constructor Create(const AOperator: TUnaryOperator; const ARight: IAstNode);
constructor Create(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
@@ -269,9 +271,12 @@ uses
{ TConstantNode }
constructor TConstantNode.Create(AValue: TScalar);
constructor TConstantNode.Create(const AValue: TDataValue);
begin
inherited Create;
// Validate that only allowed constant kinds are used.
if not (AValue.Kind in [vkScalar, vkText, vkVoid]) then
raise EArgumentException.Create('IConstantNode only supports Scalar, Text, and Void values.');
FValue := AValue;
end;
@@ -280,7 +285,7 @@ begin
Result := Visitor.VisitConstant(Self);
end;
function TConstantNode.GetValue: TScalar;
function TConstantNode.GetValue: TDataValue;
begin
Result := FValue;
end;
@@ -310,7 +315,7 @@ end;
{ TBinaryExpressionNode }
constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode);
constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode);
begin
inherited Create;
FLeft := ALeft;
@@ -328,7 +333,7 @@ begin
Result := FLeft;
end;
function TBinaryExpressionNode.GetOperator: TBinaryOperator;
function TBinaryExpressionNode.GetOperator: TScalar.TBinaryOp;
begin
Result := FOperator;
end;
@@ -340,7 +345,7 @@ end;
{ TUnaryExpressionNode }
constructor TUnaryExpressionNode.Create(const AOperator: TUnaryOperator; const ARight: IAstNode);
constructor TUnaryExpressionNode.Create(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode);
begin
inherited Create;
FOperator := AOperator;
@@ -352,7 +357,7 @@ begin
Result := Visitor.VisitUnaryExpression(Self);
end;
function TUnaryExpressionNode.GetOperator: TUnaryOperator;
function TUnaryExpressionNode.GetOperator: TScalar.TUnaryOp;
begin
Result := FOperator;
end;
@@ -743,17 +748,27 @@ begin
Result := TBlockExpressionNode.Create(AExpressions);
end;
class function TAst.Constant(AValue: TScalar): IConstantNode;
class function TAst.Constant(const AValue: TDataValue): IConstantNode;
begin
Result := TConstantNode.Create(AValue);
end;
class function TAst.Constant(const AValue: TScalar): IConstantNode;
begin
Result := TConstantNode.Create(TDataValue(AValue));
end;
class function TAst.Constant(const AValue: String): IConstantNode;
begin
Result := TConstantNode.Create(TDataValue(AValue));
end;
class function TAst.CreateSeries(const ADefinition: String): ICreateSeriesNode;
begin
Result := TCreateSeriesNode.Create(ADefinition);
end;
class function TAst.BinaryExpr(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode): IBinaryExpressionNode;
class function TAst.BinaryExpr(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode): IBinaryExpressionNode;
begin
Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight);
end;
@@ -823,7 +838,7 @@ begin
Result := TLambdaExpressionNode.Create(AParameters, ABody);
end;
class function TAst.UnaryExpr(const AOperator: TUnaryOperator; const ARight: IAstNode): IUnaryExpressionNode;
class function TAst.UnaryExpr(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode): IUnaryExpressionNode;
begin
Result := TUnaryExpressionNode.Create(AOperator, ARight);
end;
+18 -31
View File
@@ -12,8 +12,8 @@ uses
type
TRttiAstHelper = class
private
// Maps a Delphi RTTI type to its TScalarKind.
class function TypeToScalarKind(AType: TRttiType): TScalarKind; static;
// Maps a Delphi RTTI type to its TScalar.TKind.
class function TypeToScalarKind(AType: TRttiType): TScalar.TKind; static;
public
// Creates a JSON definition string from a record type info.
class function RecordDefinitionToJson<T: record>: string; static;
@@ -43,7 +43,6 @@ begin
exit;
try
// The root element is expected to be a JSON array directly.
if not (jsonValue is TJSONArray) then
exit;
@@ -54,12 +53,11 @@ begin
begin
fieldObj := fieldsArray.Items[i] as TJSONObject;
if not Assigned(fieldObj) then
continue; // or raise error
continue;
fields[i].Name := fieldObj.GetValue<string>('name');
kindStr := fieldObj.GetValue<string>('kind');
fields[i].Kind := TScalarKind(GetEnumValue(TypeInfo(TScalarKind), kindStr));
fields[i].Kind := TScalar.TKind(GetEnumValue(TypeInfo(TScalar.TKind), kindStr));
end;
Result := TScalarRecordDefinition.Create(fields);
finally
@@ -84,54 +82,43 @@ begin
rttiRecordType := rttiType as TRttiRecordType;
// The root element is now the array itself.
fieldsArray := TJSONArray.Create;
try
for field in rttiRecordType.GetFields do
begin
fieldObj := TJSONObject.Create;
fieldObj.AddPair('name', TJSONString.Create(field.Name));
fieldObj.AddPair('kind', TJSONString.Create(GetEnumName(TypeInfo(TScalarKind), Ord(TypeToScalarKind(field.FieldType)))));
fieldObj.AddPair('kind', TJSONString.Create(GetEnumName(TypeInfo(TScalar.TKind), Ord(TypeToScalarKind(field.FieldType)))));
fieldsArray.Add(fieldObj);
end;
// Convert the array directly to a JSON string.
Result := fieldsArray.ToJSON;
finally
fieldsArray.Free;
end;
end;
class function TRttiAstHelper.TypeToScalarKind(AType: TRttiType): TScalarKind;
class function TRttiAstHelper.TypeToScalarKind(AType: TRttiType): TScalar.TKind;
var
typeHandle: PTypeInfo;
begin
// 1. Use a case statement or if-checks on AType.Handle.
typeHandle := AType.Handle;
// 2. Compare with TypeInfo(Integer), TypeInfo(Double), TypeInfo(TDecimal) etc.
if typeHandle = TypeInfo(Integer) then
Result := skInteger
else if typeHandle = TypeInfo(Int64) then
Result := skInt64
if typeHandle = TypeInfo(Int64) then
Result := TScalar.TKind.Ordinal
else if typeHandle = TypeInfo(Integer) then
Result := TScalar.TKind.Ordinal
else if typeHandle = TypeInfo(UInt64) then
Result := skUInt64
else if typeHandle = TypeInfo(Single) then
Result := skSingle
else if typeHandle = TypeInfo(Double) then
Result := skDouble
else if typeHandle = TypeInfo(TDateTime) then
Result := skDateTime
Result := TScalar.TKind.Ordinal
else if typeHandle = TypeInfo(Boolean) then
Result := skBoolean
else if typeHandle = TypeInfo(Char) then
Result := skChar
else if typeHandle = TypeInfo(TDecimal) then
Result := skDecimal
else if typeHandle = TypeInfo(TTimestamp) then
Result := skTimestamp
Result := TScalar.TKind.Ordinal
else if typeHandle = TypeInfo(Double) then
Result := TScalar.TKind.Float
else if typeHandle = TypeInfo(Single) then
Result := TScalar.TKind.Float
else if typeHandle = TypeInfo(TDateTime) then
Result := TScalar.TKind.Float // Correctly handle TDateTime as a Float
else
// 4. Raise an exception for unsupported types.
raise EArgumentException.CreateFmt('Unsupported record field type: %s', [AType.Name]);
end;
+238 -1128
View File
File diff suppressed because it is too large Load Diff
+6
View File
@@ -53,6 +53,7 @@ type
class function Void: TDataValue; inline; static;
class operator Implicit(const AValue: TScalar): TDataValue; overload; inline;
class operator Implicit(const AValue: TDataValue): TScalar; overload; inline;
class operator Implicit(const AValue: String): TDataValue; overload; inline;
class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
class operator Implicit(const AValue: TObject): TDataValue; overload; inline;
@@ -435,6 +436,11 @@ begin
Result.FInterface := TObjVal.Create(AValue);
end;
class operator TDataValue.Implicit(const AValue: TDataValue): TScalar;
begin
Result := AValue.AsScalar;
end;
{ TDataValueKindHelper }
function TDataValueKindHelper.ToString: string;