Files
MycLib/Src/AST/Myc.Ast.Script.pas
T
Michael Schimmel 0526ec8a24 Keywords
2025-10-30 20:27:44 +01:00

1016 lines
29 KiB
ObjectPascal

unit Myc.Ast.Script;
interface
uses
System.SysUtils,
Myc.Ast.Nodes,
Myc.Ast.Visitor;
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.Data.Keyword,
Myc.Ast;
type
// --- Internal Parser Implementation ---
TTokenKind = (
tkLeftParen, // (
tkRightParen, // )
tkLeftBracket, // [
tkRightBracket, // ]
tkLeftBrace, // {
tkRightBrace, // }
tkQuote, // '
tkBacktick, // `
tkTilde, // ~
tkAt, // @
tkIdentifier,
tkKeyword,
tkNumber,
tkString,
tkEOF,
tkError
);
TTokenKindHelper = record helper for TTokenKind
function ToString: String;
end;
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;
Params: TArray<IIdentifierNode>;
end;
TParser = class
private
FLexer: TLexer;
FCurrentToken: TToken;
procedure Consume(AExpectedKind: TTokenKind);
procedure NextToken;
function ParseList: IAstNode;
function ParseRecordLiteral: 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(TAstVisitor)
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; 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 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 VisitRecurNode(const Node: IRecurNode): TDataValue; override;
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;
// Reader macro characters are now also delimiters for identifiers.
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
// Skip whitespace and comments
while FCurrentPos <= Length(FSource) do
begin
if FSource[FCurrentPos].IsWhiteSpace then
begin
Advance;
continue;
end;
if FSource[FCurrentPos] = ';' then
begin
// Comment found, skip to the end of the line
while (FCurrentPos <= Length(FSource)) and (not CharInSet(FSource[FCurrentPos], [#10, #13])) do
Advance;
continue;
end;
// No whitespace or comment, so break out and process the token
break;
end;
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 := tkLeftBrace;
Advance;
end;
'}':
begin
Result.Kind := tkRightBrace;
Advance;
end;
'''':
begin
Result.Kind := tkQuote;
Advance;
end;
'`':
begin
Result.Kind := tkBacktick;
Advance;
end;
'~':
begin
Result.Kind := tkTilde;
Advance;
end;
'@':
begin
Result.Kind := tkAt;
Advance;
end;
'"':
begin
Result.Kind := tkString;
Result.Text := ReadString;
end;
':':
begin
Advance; // Skip :
Result.Kind := tkKeyword;
Result.Text := ReadIdentifier;
if Result.Text.IsEmpty then
Result.Kind := tkError;
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 %s, but found %s', [AExpectedKind.ToString, FCurrentToken.Kind.ToString]);
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 = tkEOF then
raise Exception.Create('Syntax Error: Unexpected end of file.');
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.ParseRecordLiteral: IAstNode;
var
fields: TList<TRecordFieldLiteral>;
fieldName: string;
fieldValue: IAstNode;
begin
Consume(tkLeftBrace);
fields := TList<TRecordFieldLiteral>.Create;
try
while FCurrentToken.Kind <> tkRightBrace do
begin
if FCurrentToken.Kind = tkEOF then
raise Exception.Create('Syntax Error: Unexpected end of file in record literal.');
// Key must be a keyword
if FCurrentToken.Kind <> tkKeyword then
raise Exception.Create('Syntax Error: Expected keyword (e.g., :key) as field name in record literal.');
fieldName := FCurrentToken.Text;
NextToken;
// Value can be any expression
if FCurrentToken.Kind = tkRightBrace then
raise Exception.Create('Syntax Error: Missing value for key ' + fieldName + ' in record literal.');
fieldValue := ParseExpression.Node;
fields.Add(TRecordFieldLiteral.Create(TKeywordNode.Create(TKeywordRegistry.Intern(fieldName)), fieldValue));
end;
Result := TAst.RecordLiteral(fields.ToArray);
finally
fields.Free;
end;
Consume(tkRightBrace);
end;
function TParser.ParseList: IAstNode;
var
elements: TList<TExpr>;
head: TExpr;
tailTokens: TArray<TToken>;
tailNodes: TArray<IAstNode>;
initializer: 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
begin
if FCurrentToken.Kind = tkEOF then
raise Exception.Create('Syntax Error: Unexpected end of file.');
elements.Add(ParseExpression);
end;
head := elements[0];
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(head.Token.Text, 'if') then
begin
if not (Length(tailNodes) in [2, 3]) then
raise Exception.Create('Syntax Error in if statement.');
var elseBranch: IAstNode := nil;
if Length(tailNodes) = 3 then
elseBranch := tailNodes[2];
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseBranch);
end
else if SameText(head.Token.Text, '?') then
begin
if Length(tailNodes) <> 3 then
raise Exception.Create('Syntax Error in ternary statement.');
Result := TAst.TernaryExpr(tailNodes[0], tailNodes[1], tailNodes[2]);
end
else if SameText(head.Token.Text, 'def') then
begin
// Validate argument count for 'def' special form.
if not (Length(tailNodes) in [1, 2]) then
raise Exception.CreateFmt(
'Syntax Error: ''def'' requires an identifier and an optional initializer (1 or 2 arguments), but got %d.',
[Length(tailNodes)]);
if tailTokens[0].Kind <> tkIdentifier then
raise Exception.Create('Syntax Error: Expected an identifier for def statement.');
initializer := nil;
if Length(tailNodes) = 2 then
initializer := tailNodes[1];
Result := TAst.VarDecl(IIdentifierNode(tailNodes[0]), initializer);
end
else if SameText(head.Token.Text, 'defmacro') then
begin
if (Length(tailNodes) <> 3) or (tailTokens[0].Kind <> tkIdentifier) then
raise Exception.Create('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.');
var macroName := IIdentifierNode(tailNodes[0]);
var macroParams := elements[2].Params;
if tailTokens[2].Kind <> tkBacktick then
raise Exception.Create('Syntax Error: Expected a quasiquote as macro body.');
var macroBody := IQuasiQuoteNode(tailNodes[2]);
Result := TAst.MacroDef(macroName, macroParams, macroBody);
end
else if SameText(head.Token.Text, 'assign') then
begin
if tailTokens[0].Kind <> tkIdentifier then
raise Exception.Create('Syntax Error: Expected an identifier for assignment.');
Result := TAst.Assign(IIdentifierNode(tailNodes[0]), tailNodes[1]);
end
else if SameText(head.Token.Text, 'fn') then
begin
if Length(tailNodes) <> 2 then
raise Exception.Create('Syntax Error: ''fn'' requires a parameter list and a body.');
Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1]);
end
else if SameText(head.Token.Text, 'do') then
Result := TAst.Block(tailNodes)
else if SameText(head.Token.Text, 'recur') then
Result := TAst.Recur(tailNodes)
else if SameText(head.Token.Text, 'get') then
Result := TAst.Indexer(tailNodes[0], tailNodes[1])
else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1)));
end;
// If no special form matched, treat it as a generic function call.
if Result = nil then
Result := TAst.FunctionCall(head.Node, tailNodes);
finally
elements.Free;
end;
Consume(tkRightParen);
end;
function TParser.ParseExpression: TExpr;
var
i64: Int64;
dbl: Double;
expr: TExpr;
begin
// Handle reader macros.
Result.Token := FCurrentToken;
case FCurrentToken.Kind of
tkBacktick:
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.Quasiquote(expr.Node);
exit;
end;
tkTilde:
begin
NextToken;
if FCurrentToken.Kind = tkAt then
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.UnquoteSplicing(expr.Node);
end
else
begin
expr := ParseExpression;
Result.Node := TAst.Unquote(expr.Node);
end;
exit;
end;
tkQuote:
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.FunctionCall(TAst.Identifier('quote'), [expr.Node]);
exit;
end;
end;
Result.Token := FCurrentToken;
case FCurrentToken.Kind of
tkNumber:
begin
if TryStrToInt64(FCurrentToken.Text, i64) then
Result.Node :=
TAst.Constant(i64)
// Use invariant format settings for float parsing.
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;
tkKeyword:
begin
Result.Node := TAst.Keyword(FCurrentToken.Text);
NextToken;
end;
tkIdentifier:
begin
Result.Node := TAst.Identifier(FCurrentToken.Text);
NextToken;
end;
tkLeftParen: Result.Node := ParseList;
tkLeftBracket: Result.Params := ParseParameterList;
tkLeftBrace: Result.Node := ParseRecordLiteral;
tkEOF: {nop};
else
raise Exception.CreateFmt('Syntax Error: Unexpected token %s', [FCurrentToken.Kind.ToString]);
end;
end;
function TParser.Parse: IAstNode;
begin
var expr := ParseExpression;
if FCurrentToken.Kind <> tkEOF then
raise Exception.Create('Syntax Error: Unexpected characters after end of expression.');
Result := expr.Node;
end;
{ TPrettyPrintVisitor }
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.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
Append(':' + Node.Value.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('(? ');
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.VisitMacroDefinition(const Node: IMacroDefinitionNode): 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);
Append('(defmacro ' + Node.Name.Name + ' [' + sb.ToString + ']');
finally
sb.Free;
end;
Indent;
NewLine;
Node.Body.Accept(Self);
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
begin
Append('`');
Node.Expression.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
begin
Append('~');
Node.Expression.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
// To handle '~@', we need to check if the expression is an identifier '@'.
// However, the parser logic now handles this, so we just print '~@'.
Append('~@');
Node.Expression.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
arg: IAstNode;
begin
// Special case for (quote ...) to print it as '...
if (Node.Callee is TIdentifierNode) and (TIdentifierNode(Node.Callee).Name = 'quote') and (Length(Node.Arguments) = 1) then
begin
Append('''');
Node.Arguments[0].Accept(Self);
exit(TDataValue.Void);
end;
Append('(');
Node.Callee.Accept(Self);
Indent;
for arg in Node.Arguments do
begin
Append(' ');
arg.Accept(Self);
end;
Unindent;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
// For pretty-printing, show the original macro call, not the expanded body.
// Delegate to the regular VisitFunctionCall to print it as such.
Result := VisitFunctionCall(Node);
end;
function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
arg: IAstNode;
begin
Append('(recur');
Indent;
for arg in Node.Arguments do
begin
Append(' ');
arg.Accept(Self);
end;
Unindent;
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.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
field: TRecordFieldLiteral;
begin
if Length(Node.Fields) = 0 then
begin
Append('{}');
exit(TDataValue.Void);
end;
Append('{');
Indent;
for field in Node.Fields do
begin
NewLine;
Append(':' + field.Key.Value.Name);
Append(' ');
field.Value.Accept(Self);
end;
Unindent;
NewLine;
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;
function TTokenKindHelper.ToString: String;
begin
case Self of
tkLeftParen: Result := '(';
tkRightParen: Result := ')';
tkLeftBracket: Result := '[';
tkRightBracket: Result := ']';
tkLeftBrace: Result := '{';
tkRightBrace: Result := '}';
tkQuote: Result := '''';
tkBacktick: Result := '`';
tkTilde: Result := '~';
tkAt: Result := '@';
tkIdentifier: Result := '<identifier>';
tkKeyword: Result := '<keyword>';
tkNumber: Result := '<number>';
tkString: Result := '<string>';
tkEOF: Result := '<EOF>';
else
Result := '<error>';
end;
end;
initialization
FormatSettings.DecimalSeparator := '.';
end.