Michael Schimmel
1036 lines
36 KiB
ObjectPascal
1036 lines
36 KiB
ObjectPascal
unit Myc.Ast.Json;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Generics.Collections,
|
|
System.JSON,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Ast,
|
|
Myc.Ast.Visitor,
|
|
Myc.Ast.Nodes;
|
|
|
|
type
|
|
IJsonAstConverter = interface
|
|
function Serialize(const RootNode: IAstNode): TJSONObject;
|
|
function Deserialize(const AJson: TJSONObject): IAstNode;
|
|
end;
|
|
|
|
// TJsonAstConverter implements the visitor pattern for serialization
|
|
// and uses factory functions for deserialization.
|
|
TJsonAstConverter = class(TAstVisitor, IJsonAstConverter)
|
|
private
|
|
FJsonObjectStack: TStack<TJSONObject>;
|
|
procedure DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string);
|
|
function JsonToNode(const AJson: TJSONValue; const ExpectedType: String = ''): IAstNode;
|
|
function JsonToDataValue(const AObj: TJSONObject; const AName: string): TDataValue;
|
|
|
|
function JsonToConstantNode(const AObj: TJSONObject): IConstantNode;
|
|
function JsonToIdentifierNode(const AObj: TJSONObject): IIdentifierNode;
|
|
function JsonToKeywordNode(const AObj: TJSONObject): IKeywordNode;
|
|
function JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode;
|
|
function JsonToUnaryExprNode(const AObj: TJSONObject): IUnaryExpressionNode;
|
|
function JsonToIfExprNode(const AObj: TJSONObject): IIfExpressionNode;
|
|
function JsonToTernaryExprNode(const AObj: TJSONObject): ITernaryExpressionNode;
|
|
function JsonToLambdaExprNode(const AObj: TJSONObject): ILambdaExpressionNode;
|
|
function JsonToMacroDefNode(const AObj: TJSONObject): IMacroDefinitionNode;
|
|
function JsonToQuasiquoteNode(const AObj: TJSONObject): IQuasiquoteNode;
|
|
function JsonToUnquoteNode(const AObj: TJSONObject): IUnquoteNode;
|
|
function JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode;
|
|
function JsonToFunctionCallNode(const AObj: TJSONObject): IFunctionCallNode;
|
|
function JsonToMacroExpansionNode(const AObj: TJSONObject): IMacroExpansionNode;
|
|
function JsonToRecurNode(const AObj: TJSONObject): IRecurNode;
|
|
function JsonToBlockNode(const AObj: TJSONObject): IBlockExpressionNode;
|
|
function JsonToVarDeclNode(const AObj: TJSONObject): IVariableDeclarationNode;
|
|
function JsonToAssignmentNode(const AObj: TJSONObject): IAssignmentNode;
|
|
function JsonToIndexerNode(const AObj: TJSONObject): IIndexerNode;
|
|
function JsonToMemberAccessNode(const AObj: TJSONObject): IMemberAccessNode;
|
|
function JsonToRecordLiteralNode(const AObj: TJSONObject): IRecordLiteralNode;
|
|
function JsonToCreateSeriesNode(const AObj: TJSONObject): ICreateSeriesNode;
|
|
function JsonToAddSeriesItemNode(const AObj: TJSONObject): IAddSeriesItemNode;
|
|
function JsonToSeriesLengthNode(const AObj: TJSONObject): ISeriesLengthNode;
|
|
protected
|
|
// IAstVisitor implementation for serialization
|
|
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
|
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
|
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
|
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
|
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
|
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
|
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
|
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
|
|
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
|
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
|
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
|
|
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
|
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
|
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
|
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
|
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
|
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
|
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
|
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
|
|
|
function Serialize(const RootNode: IAstNode): TJSONObject;
|
|
function Deserialize(const AJson: TJSONObject): IAstNode;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Myc.Data.Keyword;
|
|
|
|
{ TJsonAstConverter }
|
|
|
|
constructor TJsonAstConverter.Create;
|
|
begin
|
|
inherited;
|
|
FJsonObjectStack := TStack<TJSONObject>.Create;
|
|
end;
|
|
|
|
destructor TJsonAstConverter.Destroy;
|
|
begin
|
|
FJsonObjectStack.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TJsonAstConverter.Deserialize(const AJson: TJSONObject): IAstNode;
|
|
begin
|
|
Result := JsonToNode(AJson);
|
|
end;
|
|
|
|
{ TJsonAstConverter - IAstVisitor for Serialization }
|
|
|
|
procedure TJsonAstConverter.DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string);
|
|
var
|
|
valObj, scalarObj: TJSONObject;
|
|
kwName: string;
|
|
begin
|
|
valObj := TJSONObject.Create;
|
|
valObj.AddPair('Kind', TJSONString.Create(AValue.Kind.ToString));
|
|
|
|
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));
|
|
TScalar.TKind.Keyword:
|
|
begin
|
|
// Use reverse map to get name from index (AsInt64)
|
|
kwName := TKeywordRegistry.GetName(AValue.AsScalar.Value.AsInt64);
|
|
scalarObj.AddPair('Value', TJSONString.Create(kwName));
|
|
end;
|
|
end;
|
|
valObj.AddPair('Value', scalarObj);
|
|
end;
|
|
vkText: valObj.AddPair('Value', TJSONString.Create(AValue.AsText));
|
|
vkVoid:; // No value to add
|
|
else
|
|
raise ENotSupportedException.Create('Unsupported TDataValue kind for constant serialization.');
|
|
end;
|
|
|
|
AParent.AddPair(AName, valObj);
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitConstant(const Node: IConstantNode): TDataValue;
|
|
var
|
|
obj: TJSONObject;
|
|
begin
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Constant'));
|
|
DataValueToJson(Node.Value, obj, 'Value');
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
|
var
|
|
obj: TJSONObject;
|
|
begin
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Identifier'));
|
|
obj.AddPair('Name', TJSONString.Create(Node.Name));
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
|
var
|
|
obj: TJSONObject;
|
|
begin
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Keyword'));
|
|
obj.AddPair('Name', TJSONString.Create(Node.Value.Name));
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
|
var
|
|
obj, leftObj, rightObj: TJSONObject;
|
|
begin
|
|
Node.Left.Accept(Self);
|
|
Node.Right.Accept(Self);
|
|
|
|
rightObj := FJsonObjectStack.Pop;
|
|
leftObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('BinaryExpr'));
|
|
obj.AddPair('Operator', TJSONString.Create(Node.Operator.ToString));
|
|
obj.AddPair('Left', leftObj);
|
|
obj.AddPair('Right', rightObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
|
var
|
|
obj, rightObj: TJSONObject;
|
|
begin
|
|
Node.Right.Accept(Self);
|
|
rightObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('UnaryExpr'));
|
|
obj.AddPair('Operator', TJSONString.Create(Node.Operator.ToString));
|
|
obj.AddPair('Right', rightObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
|
var
|
|
obj, condObj, thenObj, elseObj: TJSONObject;
|
|
begin
|
|
Node.Condition.Accept(Self);
|
|
Node.ThenBranch.Accept(Self);
|
|
if Assigned(Node.ElseBranch) then
|
|
Node.ElseBranch.Accept(Self);
|
|
|
|
if Assigned(Node.ElseBranch) then
|
|
elseObj := FJsonObjectStack.Pop
|
|
else
|
|
elseObj := nil;
|
|
|
|
thenObj := FJsonObjectStack.Pop;
|
|
condObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('IfExpr'));
|
|
obj.AddPair('Condition', condObj);
|
|
obj.AddPair('ThenBranch', thenObj);
|
|
if Assigned(elseObj) then
|
|
obj.AddPair('ElseBranch', elseObj)
|
|
else
|
|
obj.AddPair('ElseBranch', TJSONNull.Create);
|
|
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
|
var
|
|
obj, condObj, thenObj, elseObj: TJSONObject;
|
|
begin
|
|
Node.Condition.Accept(Self);
|
|
Node.ThenBranch.Accept(Self);
|
|
Node.ElseBranch.Accept(Self);
|
|
|
|
elseObj := FJsonObjectStack.Pop;
|
|
thenObj := FJsonObjectStack.Pop;
|
|
condObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('TernaryExpr'));
|
|
obj.AddPair('Condition', condObj);
|
|
obj.AddPair('ThenBranch', thenObj);
|
|
obj.AddPair('ElseBranch', elseObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
|
var
|
|
obj, bodyObj: TJSONObject;
|
|
paramsArray: TJSONArray;
|
|
tempParams: TArray<TJSONObject>;
|
|
param: IIdentifierNode;
|
|
i: Integer;
|
|
begin
|
|
for param in Node.Parameters do
|
|
param.Accept(Self);
|
|
Node.Body.Accept(Self);
|
|
|
|
bodyObj := FJsonObjectStack.Pop;
|
|
|
|
SetLength(tempParams, Length(Node.Parameters));
|
|
for i := High(tempParams) downto 0 do
|
|
tempParams[i] := FJsonObjectStack.Pop;
|
|
|
|
paramsArray := TJSONArray.Create;
|
|
for i := 0 to High(tempParams) do
|
|
paramsArray.Add(tempParams[i]);
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('LambdaExpr'));
|
|
obj.AddPair('Parameters', paramsArray);
|
|
obj.AddPair('Body', bodyObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
|
var
|
|
obj, nameObj, bodyObj: TJSONObject;
|
|
paramsArray: TJSONArray;
|
|
tempParams: TArray<TJSONObject>;
|
|
param: IIdentifierNode;
|
|
i: Integer;
|
|
begin
|
|
Node.Name.Accept(Self);
|
|
for param in Node.Parameters do
|
|
param.Accept(Self);
|
|
Node.Body.Accept(Self);
|
|
|
|
bodyObj := FJsonObjectStack.Pop;
|
|
|
|
SetLength(tempParams, Length(Node.Parameters));
|
|
for i := High(tempParams) downto 0 do
|
|
tempParams[i] := FJsonObjectStack.Pop;
|
|
|
|
nameObj := FJsonObjectStack.Pop;
|
|
|
|
paramsArray := TJSONArray.Create;
|
|
for i := 0 to High(tempParams) do
|
|
paramsArray.Add(tempParams[i]);
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('MacroDef'));
|
|
obj.AddPair('Name', nameObj);
|
|
obj.AddPair('Parameters', paramsArray);
|
|
obj.AddPair('Body', bodyObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
|
|
var
|
|
obj, exprObj: TJSONObject;
|
|
begin
|
|
Node.Expression.Accept(Self);
|
|
exprObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Quasiquote'));
|
|
obj.AddPair('Expression', exprObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
|
var
|
|
obj, exprObj: TJSONObject;
|
|
begin
|
|
Node.Expression.Accept(Self);
|
|
exprObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Unquote'));
|
|
obj.AddPair('Expression', exprObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
|
var
|
|
obj, exprObj: TJSONObject;
|
|
begin
|
|
Node.Expression.Accept(Self);
|
|
exprObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('UnquoteSplicing'));
|
|
obj.AddPair('Expression', exprObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
|
var
|
|
obj, calleeObj: TJSONObject;
|
|
argsArray: TJSONArray;
|
|
tempArgs: TArray<TJSONObject>;
|
|
arg: IAstNode;
|
|
i: Integer;
|
|
begin
|
|
Node.Callee.Accept(Self);
|
|
for arg in Node.Arguments do
|
|
arg.Accept(Self);
|
|
|
|
SetLength(tempArgs, Length(Node.Arguments));
|
|
for i := High(tempArgs) downto 0 do
|
|
tempArgs[i] := FJsonObjectStack.Pop;
|
|
|
|
argsArray := TJSONArray.Create;
|
|
for i := 0 to High(tempArgs) do
|
|
argsArray.Add(tempArgs[i]);
|
|
|
|
calleeObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('FunctionCall'));
|
|
obj.AddPair('Callee', calleeObj);
|
|
obj.AddPair('Arguments', argsArray);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
|
var
|
|
obj, calleeObj, bodyObj: TJSONObject;
|
|
argsArray: TJSONArray;
|
|
tempArgs: TArray<TJSONObject>;
|
|
arg: IAstNode;
|
|
i: Integer;
|
|
begin
|
|
// Serialize all children first: Callee, Arguments, and the new ExpandedBody
|
|
Node.Callee.Accept(Self);
|
|
for arg in Node.Arguments do
|
|
arg.Accept(Self);
|
|
Node.ExpandedBody.Accept(Self);
|
|
|
|
// Pop children's JSON from stack in reverse order of visitation
|
|
bodyObj := FJsonObjectStack.Pop;
|
|
|
|
SetLength(tempArgs, Length(Node.Arguments));
|
|
for i := High(tempArgs) downto 0 do
|
|
tempArgs[i] := FJsonObjectStack.Pop;
|
|
|
|
calleeObj := FJsonObjectStack.Pop;
|
|
|
|
// Build JSON array for arguments
|
|
argsArray := TJSONArray.Create;
|
|
for var argObj in tempArgs do
|
|
argsArray.Add(argObj);
|
|
|
|
// Create the final JSON object for this node
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('MacroExpansion'));
|
|
obj.AddPair('Callee', calleeObj);
|
|
obj.AddPair('Arguments', argsArray);
|
|
obj.AddPair('ExpandedBody', bodyObj);
|
|
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
|
var
|
|
obj: TJSONObject;
|
|
argsArray: TJSONArray;
|
|
tempArgs: TArray<TJSONObject>;
|
|
arg: IAstNode;
|
|
i: Integer;
|
|
begin
|
|
for arg in Node.Arguments do
|
|
arg.Accept(Self);
|
|
|
|
SetLength(tempArgs, Length(Node.Arguments));
|
|
for i := High(tempArgs) downto 0 do
|
|
tempArgs[i] := FJsonObjectStack.Pop;
|
|
|
|
argsArray := TJSONArray.Create;
|
|
for i := 0 to High(tempArgs) do
|
|
argsArray.Add(tempArgs[i]);
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Recur'));
|
|
obj.AddPair('Arguments', argsArray);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
|
var
|
|
obj: TJSONObject;
|
|
exprsArray: TJSONArray;
|
|
tempExprs: TArray<TJSONObject>;
|
|
expr: IAstNode;
|
|
i: Integer;
|
|
begin
|
|
for expr in Node.Expressions do
|
|
expr.Accept(Self);
|
|
|
|
SetLength(tempExprs, Length(Node.Expressions));
|
|
for i := High(tempExprs) downto 0 do
|
|
tempExprs[i] := FJsonObjectStack.Pop;
|
|
|
|
exprsArray := TJSONArray.Create;
|
|
for i := 0 to High(tempExprs) do
|
|
exprsArray.Add(tempExprs[i]);
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Block'));
|
|
obj.AddPair('Expressions', exprsArray);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
|
var
|
|
obj, identObj, initObj: TJSONObject;
|
|
begin
|
|
Node.Identifier.Accept(Self);
|
|
if Assigned(Node.Initializer) then
|
|
Node.Initializer.Accept(Self);
|
|
|
|
if Assigned(Node.Initializer) then
|
|
initObj := FJsonObjectStack.Pop
|
|
else
|
|
initObj := nil;
|
|
identObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('VarDecl'));
|
|
obj.AddPair('Identifier', identObj);
|
|
if Assigned(initObj) then
|
|
obj.AddPair('Initializer', initObj)
|
|
else
|
|
obj.AddPair('Initializer', TJSONNull.Create);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
|
var
|
|
obj, identObj, valueObj: TJSONObject;
|
|
begin
|
|
Node.Identifier.Accept(Self);
|
|
Node.Value.Accept(Self);
|
|
|
|
valueObj := FJsonObjectStack.Pop;
|
|
identObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Assignment'));
|
|
obj.AddPair('Identifier', identObj);
|
|
obj.AddPair('Value', valueObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
|
var
|
|
obj, baseObj, indexObj: TJSONObject;
|
|
begin
|
|
Node.Base.Accept(Self);
|
|
Node.Index.Accept(Self);
|
|
|
|
indexObj := FJsonObjectStack.Pop;
|
|
baseObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('Indexer'));
|
|
obj.AddPair('Base', baseObj);
|
|
obj.AddPair('Index', indexObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
|
var
|
|
obj, baseObj, memberObj: TJSONObject;
|
|
begin
|
|
Node.Base.Accept(Self);
|
|
Node.Member.Accept(Self);
|
|
|
|
memberObj := FJsonObjectStack.Pop;
|
|
baseObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('MemberAccess'));
|
|
obj.AddPair('Base', baseObj);
|
|
obj.AddPair('Member', memberObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
|
var
|
|
obj, fieldObj: TJSONObject;
|
|
fieldsArray: TJSONArray;
|
|
field: TRecordFieldLiteral;
|
|
begin
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('RecordLiteral'));
|
|
|
|
fieldsArray := TJSONArray.Create;
|
|
for field in Node.Fields do
|
|
begin
|
|
field.Value.Accept(Self); // This pushes the value JSON onto the stack
|
|
|
|
fieldObj := TJSONObject.Create;
|
|
fieldObj.AddPair('Name', TJSONString.Create(field.Key.Value.Name));
|
|
fieldObj.AddPair('Value', FJsonObjectStack.Pop);
|
|
fieldsArray.Add(fieldObj);
|
|
end;
|
|
|
|
obj.AddPair('Fields', fieldsArray);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
|
var
|
|
obj: TJSONObject;
|
|
begin
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('CreateSeries'));
|
|
obj.AddPair('Definition', TJSONString.Create(Node.Definition));
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
|
var
|
|
obj, seriesObj, valueObj, lookbackObj: TJSONObject;
|
|
begin
|
|
Node.Series.Accept(Self);
|
|
Node.Value.Accept(Self);
|
|
if Assigned(Node.Lookback) then
|
|
Node.Lookback.Accept(Self);
|
|
|
|
if Assigned(Node.Lookback) then
|
|
lookbackObj := FJsonObjectStack.Pop
|
|
else
|
|
lookbackObj := nil;
|
|
valueObj := FJsonObjectStack.Pop;
|
|
seriesObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('AddSeriesItem'));
|
|
obj.AddPair('Series', seriesObj);
|
|
obj.AddPair('Value', valueObj);
|
|
if Assigned(lookbackObj) then
|
|
obj.AddPair('Lookback', lookbackObj)
|
|
else
|
|
obj.AddPair('Lookback', TJSONNull.Create);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
function TJsonAstConverter.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
|
var
|
|
obj, seriesObj: TJSONObject;
|
|
begin
|
|
Node.Series.Accept(Self);
|
|
seriesObj := FJsonObjectStack.Pop;
|
|
|
|
obj := TJSONObject.Create;
|
|
obj.AddPair('NodeType', TJSONString.Create('SeriesLength'));
|
|
obj.AddPair('Series', seriesObj);
|
|
FJsonObjectStack.Push(obj);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
|
|
{ TJsonAstConverter - Deserialization }
|
|
|
|
function TJsonAstConverter.JsonToDataValue(const AObj: TJSONObject; const AName: string): TDataValue;
|
|
var
|
|
valObj, scalarObj: TJSONObject;
|
|
kindStr: string;
|
|
scalarKind: TScalar.TKind;
|
|
begin
|
|
valObj := AObj.GetValue<TJSONObject>(AName);
|
|
kindStr := valObj.GetValue<string>('Kind');
|
|
|
|
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);
|
|
TScalar.TKind.Keyword:
|
|
// Keywords are serialized by name, intern them back
|
|
Result := TScalar.FromKeyword(TKeywordRegistry.Intern(scalarObj.GetValue<string>('Value')));
|
|
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.Create('Unsupported TDataValue kind for constant deserialization.');
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToConstantNode(const AObj: TJSONObject): IConstantNode;
|
|
begin
|
|
Result := TAst.Constant(JsonToDataValue(AObj, 'Value'));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToIdentifierNode(const AObj: TJSONObject): IIdentifierNode;
|
|
begin
|
|
Result := TAst.Identifier(AObj.GetValue<string>('Name'));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToKeywordNode(const AObj: TJSONObject): IKeywordNode;
|
|
begin
|
|
Result := TAst.Keyword(AObj.GetValue<string>('Name'));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode;
|
|
var
|
|
opStr: string;
|
|
op: TScalar.TBinaryOp;
|
|
leftNode, rightNode: IAstNode;
|
|
begin
|
|
opStr := AObj.GetValue<string>('Operator');
|
|
for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
|
|
if SameText(op.ToString, opStr) then
|
|
begin
|
|
leftNode := JsonToNode(AObj.GetValue('Left'));
|
|
rightNode := JsonToNode(AObj.GetValue('Right'));
|
|
Result := TAst.BinaryExpr(leftNode, op, rightNode);
|
|
exit;
|
|
end;
|
|
raise EInvalidOpException.CreateFmt('Unknown binary operator "%s"', [opStr]);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToUnaryExprNode(const AObj: TJSONObject): IUnaryExpressionNode;
|
|
var
|
|
opStr: string;
|
|
op: TScalar.TUnaryOp;
|
|
rightNode: IAstNode;
|
|
begin
|
|
opStr := AObj.GetValue<string>('Operator');
|
|
for op := Low(TScalar.TUnaryOp) to High(TScalar.TUnaryOp) do
|
|
if SameText(op.ToString, opStr) then
|
|
begin
|
|
rightNode := JsonToNode(AObj.GetValue('Right'));
|
|
Result := TAst.UnaryExpr(op, rightNode);
|
|
exit;
|
|
end;
|
|
raise EInvalidOpException.CreateFmt('Unknown unary operator "%s"', [opStr]);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToIfExprNode(const AObj: TJSONObject): IIfExpressionNode;
|
|
var
|
|
condNode, thenNode, elseNode: IAstNode;
|
|
begin
|
|
condNode := JsonToNode(AObj.GetValue('Condition'));
|
|
thenNode := JsonToNode(AObj.GetValue('ThenBranch'));
|
|
if not (AObj.GetValue('ElseBranch') is TJSONNull) then
|
|
elseNode := JsonToNode(AObj.GetValue('ElseBranch'))
|
|
else
|
|
elseNode := nil;
|
|
Result := TAst.IfExpr(condNode, thenNode, elseNode);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToTernaryExprNode(const AObj: TJSONObject): ITernaryExpressionNode;
|
|
var
|
|
condNode, thenNode, elseNode: IAstNode;
|
|
begin
|
|
condNode := JsonToNode(AObj.GetValue('Condition'));
|
|
thenNode := JsonToNode(AObj.GetValue('ThenBranch'));
|
|
elseNode := JsonToNode(AObj.GetValue('ElseBranch'));
|
|
Result := TAst.TernaryExpr(condNode, thenNode, elseNode);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToLambdaExprNode(const AObj: TJSONObject): ILambdaExpressionNode;
|
|
var
|
|
params: TArray<IIdentifierNode>;
|
|
body: IAstNode;
|
|
paramArray: TJSONArray;
|
|
i: Integer;
|
|
begin
|
|
paramArray := AObj.GetValue<TJSONArray>('Parameters');
|
|
SetLength(params, paramArray.Count);
|
|
for i := 0 to paramArray.Count - 1 do
|
|
params[i] := JsonToIdentifierNode(paramArray.Items[i] as TJSONObject);
|
|
|
|
body := JsonToNode(AObj.GetValue('Body'));
|
|
Result := TAst.LambdaExpr(params, body);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToMacroDefNode(const AObj: TJSONObject): IMacroDefinitionNode;
|
|
var
|
|
name: IIdentifierNode;
|
|
params: TArray<IIdentifierNode>;
|
|
body: IQuasiquoteNode;
|
|
paramArray: TJSONArray;
|
|
i: Integer;
|
|
begin
|
|
|
|
name := JsonToIdentifierNode(AObj.GetValue('Name') as TJSONObject);
|
|
|
|
paramArray := AObj.GetValue<TJSONArray>('Parameters');
|
|
SetLength(params, paramArray.Count);
|
|
for i := 0 to paramArray.Count - 1 do
|
|
params[i] := JsonToIdentifierNode(paramArray.Items[i] as TJSONObject);
|
|
|
|
body := IQuasiquoteNode(JsonToNode(AObj.GetValue('Body'), 'Quasiquote'));
|
|
Result := TAst.MacroDef(name, params, body);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToMacroExpansionNode(const AObj: TJSONObject): IMacroExpansionNode;
|
|
var
|
|
callee, expandedBody: IAstNode;
|
|
args: TArray<IAstNode>;
|
|
argsArray: TJSONArray;
|
|
i: Integer;
|
|
tempCallNode: IFunctionCallNode;
|
|
begin
|
|
// Recursively deserialize all parts of the macro expansion node
|
|
callee := JsonToNode(AObj.GetValue('Callee'));
|
|
expandedBody := JsonToNode(AObj.GetValue('ExpandedBody'));
|
|
argsArray := AObj.GetValue<TJSONArray>('Arguments');
|
|
SetLength(args, argsArray.Count);
|
|
for i := 0 to argsArray.Count - 1 do
|
|
args[i] := JsonToNode(argsArray.Items[i]);
|
|
|
|
// Create a temporary IFunctionCallNode to pass to the factory
|
|
tempCallNode := TAst.FunctionCall(callee, args);
|
|
|
|
// Use the new global factory function from the TAst record
|
|
Result := TAst.MacroExpansionNode(tempCallNode, expandedBody);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToQuasiquoteNode(const AObj: TJSONObject): IQuasiquoteNode;
|
|
begin
|
|
Result := TAst.Quasiquote(JsonToNode(AObj.GetValue('Expression')));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToUnquoteNode(const AObj: TJSONObject): IUnquoteNode;
|
|
begin
|
|
Result := TAst.Unquote(JsonToNode(AObj.GetValue('Expression')));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode;
|
|
begin
|
|
Result := TAst.UnquoteSplicing(JsonToNode(AObj.GetValue('Expression')));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToFunctionCallNode(const AObj: TJSONObject): IFunctionCallNode;
|
|
var
|
|
callee: IAstNode;
|
|
args: TArray<IAstNode>;
|
|
argsArray: TJSONArray;
|
|
i: Integer;
|
|
begin
|
|
callee := JsonToNode(AObj.GetValue('Callee'));
|
|
argsArray := AObj.GetValue<TJSONArray>('Arguments');
|
|
SetLength(args, argsArray.Count);
|
|
for i := 0 to argsArray.Count - 1 do
|
|
args[i] := JsonToNode(argsArray.Items[i]);
|
|
|
|
Result := TAst.FunctionCall(callee, args);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToRecurNode(const AObj: TJSONObject): IRecurNode;
|
|
var
|
|
args: TArray<IAstNode>;
|
|
argsArray: TJSONArray;
|
|
i: Integer;
|
|
begin
|
|
argsArray := AObj.GetValue<TJSONArray>('Arguments');
|
|
SetLength(args, argsArray.Count);
|
|
for i := 0 to argsArray.Count - 1 do
|
|
args[i] := JsonToNode(argsArray.Items[i]);
|
|
|
|
Result := TAst.Recur(args);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToBlockNode(const AObj: TJSONObject): IBlockExpressionNode;
|
|
var
|
|
expressions: TArray<IAstNode>;
|
|
exprsArray: TJSONArray;
|
|
i: Integer;
|
|
begin
|
|
exprsArray := AObj.GetValue<TJSONArray>('Expressions');
|
|
SetLength(expressions, exprsArray.Count);
|
|
for i := 0 to exprsArray.Count - 1 do
|
|
expressions[i] := JsonToNode(exprsArray.Items[i]);
|
|
|
|
Result := TAst.Block(expressions);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToVarDeclNode(const AObj: TJSONObject): IVariableDeclarationNode;
|
|
var
|
|
ident: IIdentifierNode;
|
|
initializer: IAstNode;
|
|
begin
|
|
ident := JsonToIdentifierNode(AObj.GetValue('Identifier') as TJSONObject);
|
|
if not (AObj.GetValue('Initializer') is TJSONNull) then
|
|
initializer := JsonToNode(AObj.GetValue('Initializer'))
|
|
else
|
|
initializer := nil;
|
|
|
|
Result := TAst.VarDecl(ident, initializer);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToAssignmentNode(const AObj: TJSONObject): IAssignmentNode;
|
|
var
|
|
ident: IIdentifierNode;
|
|
value: IAstNode;
|
|
begin
|
|
ident := JsonToIdentifierNode(AObj.GetValue('Identifier') as TJSONObject);
|
|
value := JsonToNode(AObj.GetValue('Value'));
|
|
Result := TAst.Assign(ident, value);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToIndexerNode(const AObj: TJSONObject): IIndexerNode;
|
|
begin
|
|
Result := TAst.Indexer(JsonToNode(AObj.GetValue('Base')), JsonToNode(AObj.GetValue('Index')));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToMemberAccessNode(const AObj: TJSONObject): IMemberAccessNode;
|
|
begin
|
|
Result := TAst.MemberAccess(JsonToNode(AObj.GetValue('Base')), JsonToKeywordNode(AObj.GetValue('Member') as TJSONObject));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToRecordLiteralNode(const AObj: TJSONObject): IRecordLiteralNode;
|
|
var
|
|
fields: TArray<TRecordFieldLiteral>;
|
|
fieldsArray: TJSONArray;
|
|
fieldObj: TJSONObject;
|
|
i: Integer;
|
|
begin
|
|
fieldsArray := AObj.GetValue<TJSONArray>('Fields');
|
|
SetLength(fields, fieldsArray.Count);
|
|
for i := 0 to fieldsArray.Count - 1 do
|
|
begin
|
|
fieldObj := fieldsArray.Items[i] as TJSONObject;
|
|
fields[i] :=
|
|
TRecordFieldLiteral.Create(
|
|
TKeywordNode.Create(TKeywordRegistry.Intern(fieldObj.GetValue<string>('Name'))),
|
|
JsonToNode(fieldObj.GetValue('Value'))
|
|
);
|
|
end;
|
|
Result := TAst.RecordLiteral(fields);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToCreateSeriesNode(const AObj: TJSONObject): ICreateSeriesNode;
|
|
begin
|
|
Result := TAst.CreateSeries(AObj.GetValue<string>('Definition'));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToAddSeriesItemNode(const AObj: TJSONObject): IAddSeriesItemNode;
|
|
var
|
|
lookbackNode: IAstNode;
|
|
begin
|
|
if not (AObj.GetValue('Lookback') is TJSONNull) then
|
|
lookbackNode := JsonToNode(AObj.GetValue('Lookback'))
|
|
else
|
|
lookbackNode := nil;
|
|
|
|
Result :=
|
|
TAst.AddSeriesItem(JsonToIdentifierNode(AObj.GetValue('Series') as TJSONObject), JsonToNode(AObj.GetValue('Value')), lookbackNode);
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToSeriesLengthNode(const AObj: TJSONObject): ISeriesLengthNode;
|
|
begin
|
|
Result := TAst.SeriesLength(JsonToIdentifierNode(AObj.GetValue('Series') as TJSONObject));
|
|
end;
|
|
|
|
function TJsonAstConverter.JsonToNode(const AJson: TJSONValue; const ExpectedType: String = ''): IAstNode;
|
|
var
|
|
obj: TJSONObject;
|
|
nodeType: string;
|
|
begin
|
|
if not (AJson is TJSONObject) then
|
|
raise EInvalidCast.Create('Expected a JSON object for node deserialization.');
|
|
|
|
obj := AJson as TJSONObject;
|
|
nodeType := obj.GetValue<string>('NodeType');
|
|
|
|
if (ExpectedType <> '') and (nodeType <> ExpectedType) then
|
|
raise EInvalidCast.CreateFmt('Expected a JSON object of type %s for deserialization, but got a %s.', [ExpectedType, nodeType]);
|
|
|
|
if nodeType = 'Constant' then
|
|
Result := JsonToConstantNode(obj)
|
|
else if nodeType = 'Identifier' then
|
|
Result := JsonToIdentifierNode(obj)
|
|
else if nodeType = 'Keyword' then
|
|
Result := JsonToKeywordNode(obj)
|
|
else if nodeType = 'BinaryExpr' then
|
|
Result := JsonToBinaryExprNode(obj)
|
|
else if nodeType = 'UnaryExpr' then
|
|
Result := JsonToUnaryExprNode(obj)
|
|
else if nodeType = 'IfExpr' then
|
|
Result := JsonToIfExprNode(obj)
|
|
else if nodeType = 'TernaryExpr' then
|
|
Result := JsonToTernaryExprNode(obj)
|
|
else if nodeType = 'LambdaExpr' then
|
|
Result := JsonToLambdaExprNode(obj)
|
|
else if nodeType = 'MacroDef' then
|
|
Result := JsonToMacroDefNode(obj)
|
|
else if nodeType = 'MacroExpansion' then
|
|
Result := JsonToMacroExpansionNode(obj)
|
|
else if nodeType = 'Quasiquote' then
|
|
Result := JsonToQuasiquoteNode(obj)
|
|
else if nodeType = 'Unquote' then
|
|
Result := JsonToUnquoteNode(obj)
|
|
else if nodeType = 'UnquoteSplicing' then
|
|
Result := JsonToUnquoteSplicingNode(obj)
|
|
else if nodeType = 'FunctionCall' then
|
|
Result := JsonToFunctionCallNode(obj)
|
|
else if nodeType = 'Recur' then
|
|
Result := JsonToRecurNode(obj)
|
|
else if nodeType = 'Block' then
|
|
Result := JsonToBlockNode(obj)
|
|
else if nodeType = 'VarDecl' then
|
|
Result := JsonToVarDeclNode(obj)
|
|
else if nodeType = 'Assignment' then
|
|
Result := JsonToAssignmentNode(obj)
|
|
else if nodeType = 'Indexer' then
|
|
Result := JsonToIndexerNode(obj)
|
|
else if nodeType = 'MemberAccess' then
|
|
Result := JsonToMemberAccessNode(obj)
|
|
else if nodeType = 'RecordLiteral' then
|
|
Result := JsonToRecordLiteralNode(obj)
|
|
else if nodeType = 'CreateSeries' then
|
|
Result := JsonToCreateSeriesNode(obj)
|
|
else if nodeType = 'AddSeriesItem' then
|
|
Result := JsonToAddSeriesItemNode(obj)
|
|
else if nodeType = 'SeriesLength' then
|
|
Result := JsonToSeriesLengthNode(obj)
|
|
else
|
|
raise ENotSupportedException.CreateFmt('Unsupported NodeType "%s" for JSON deserialization.', [nodeType]);
|
|
end;
|
|
|
|
function TJsonAstConverter.Serialize(const RootNode: IAstNode): TJSONObject;
|
|
begin
|
|
FJsonObjectStack.Clear;
|
|
if not Assigned(RootNode) then
|
|
exit(nil);
|
|
|
|
RootNode.Accept(Self);
|
|
|
|
if FJsonObjectStack.Count <> 1 then
|
|
raise EInvalidOpException.Create('JSON serialization stack is corrupt.');
|
|
|
|
Result := FJsonObjectStack.Pop;
|
|
end;
|
|
|
|
end.
|