Implementing Pipes

This commit is contained in:
Michael Schimmel
2025-12-21 16:30:09 +01:00
parent ac96a105a5
commit 8b765487ae
6 changed files with 515 additions and 336 deletions
+202 -206
View File
@@ -9,7 +9,6 @@ uses
Myc.Ast.Visitor;
type
// Exception for parsing errors containing location information
EParserException = class(EAstException)
strict private
FLine: Integer;
@@ -20,67 +19,6 @@ type
property Col: Integer read FCol;
end;
var
// This BNF should always be kept up to date and valid.
BNF: String =
'''
(* ---------------------------------------------------------------------- *)
(* ---- Main Productions (Start Symbols) ---- *)
(* ---------------------------------------------------------------------- *)
program ::= expression
expression ::= atom | list | record_literal | reader_macro
(* ---------------------------------------------------------------------- *)
(* ---- Atoms (Basic Values) ---- *)
(* ---------------------------------------------------------------------- *)
atom ::= number | string | identifier | keyword
(* ---------------------------------------------------------------------- *)
(* ---- Reader-Macros (Syntactic Sugar) ---- *)
(* ---------------------------------------------------------------------- *)
reader_macro ::= "'" expression (* (quote ...) *)
| "`" expression (* (quasiquote ...) *)
| "~" expression (* (unquote ...) *)
| "~@" expression (* (unquote-splicing ...) *)
(* ---------------------------------------------------------------------- *)
(* ---- Lists (S-Expressions) ---- *)
(* ---------------------------------------------------------------------- *)
list ::= "(" list_content ")"
list_content ::= special_form | function_call
special_form ::= "if" expression expression expression?
| "?" (expression expression)* expression (* cond1 branch1 ... else *)
| "def" identifier expression?
| "defmacro" identifier parameter_list expression
| "assign" identifier expression
| "fn" parameter_list expression
| "do" expression*
| "recur" expression*
| "get" expression expression
| dot_identifier expression
function_call ::= expression expression*
(* ---------------------------------------------------------------------- *)
(* ---- Parameter Lists and Records ---- *)
(* ---------------------------------------------------------------------- *)
parameter_list ::= "[" identifier* "]"
record_literal ::= "{" (keyword expression)* "}"
(* ---------------------------------------------------------------------- *)
(* ---- Terminals (Lexer Tokens) ---- *)
(* ---------------------------------------------------------------------- *)
number ::= ["-"] digit+ ["." digit+]
string ::= '"' ( ? any char except \ or " ? | '\' ( '"' | '\' | 'n' | 'r' | 't' ) )* '"'
keyword ::= ":" identifier
dot_identifier ::= "." identifier
identifier ::= ? any sequence of chars not containing whitespace, '()[]{}'`~:; ?
digit ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
''';
type
// Provides a high-level facade for parsing and printing the AST.
TAstScript = record
public
class function Parse(const ASource: string): IAstNode; static;
@@ -100,19 +38,17 @@ uses
Myc.Ast.Identities;
type
// --- Internal Parser Implementation ---
TTokenKind = (
tkLeftParen, // (
tkRightParen, // )
tkLeftBracket, // [
tkRightBracket, // ]
tkLeftBrace, // {
tkRightBrace, // }
tkQuote, // '
tkBacktick, // `
tkTilde, // ~
tkAt, // @
tkLeftParen,
tkRightParen,
tkLeftBracket,
tkRightBracket,
tkLeftBrace,
tkRightBrace,
tkQuote,
tkBacktick,
tkTilde,
tkAt,
tkIdentifier,
tkKeyword,
tkNumber,
@@ -157,7 +93,6 @@ type
TExpr = record
Token: TToken;
Node: IAstNode;
Params: TArray<IIdentifierNode>;
end;
TParser = class
@@ -168,18 +103,19 @@ type
procedure ErrorFmt(const Msg: string; const Args: array of const);
procedure Consume(AExpectedKind: TTokenKind);
procedure NextToken;
function ParseList: IAstNode;
function ParseRecordLiteral: IAstNode;
function ParseParameterList: TArray<IIdentifierNode>;
function ParseVector: IAstNode;
function ParseExpression: TExpr;
function ExtractIdentifiers(const Node: IAstNode; const Context: string): TArray<IIdentifierNode>;
public
constructor Create(const ASource: string);
destructor Destroy; override;
function Parse: IAstNode;
end;
// --- Internal Printer Implementation ---
TPrettyPrintVisitor = class(TAstVisitor)
private
FBuilder: TStringBuilder;
@@ -198,7 +134,6 @@ type
function VisitIdentifier(const Node: IIdentifierNode): TVoid; override;
function VisitKeyword(const Node: IKeywordNode): TVoid; override;
// List Visitors
function VisitParameterList(const Node: IParameterList): TVoid; override;
function VisitArgumentList(const Node: IArgumentList): TVoid; override;
function VisitExpressionList(const Node: IExpressionList): TVoid; override;
@@ -225,8 +160,14 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TVoid; override;
function VisitRecurNode(const Node: IRecurNode): TVoid; override;
function VisitNop(const Node: INopNode): TVoid; override;
function VisitPipeInput(const Node: IPipeInputNode): TVoid; override;
function VisitPipeSelectorList(const Node: IPipeSelectorList): TVoid; override;
function VisitPipeInputList(const Node: IPipeInputList): TVoid; override;
function VisitPipe(const Node: IPipeNode): TVoid; override;
end;
{ TTokenKindHelper }
function TTokenKindHelper.ToString: String;
begin
case Self of
@@ -250,13 +191,13 @@ begin
end;
end;
{ TToken }
function TToken.GetLocation: ISourceLocation;
begin
Result := TIdentities.Location(Line, Col);
end;
{ EParserException }
constructor EParserException.Create(const AMessage: string; ALine, ACol: Integer);
begin
inherited CreateFmt('[Line %d, Col %d] %s', [ALine, ACol, AMessage]);
@@ -265,7 +206,6 @@ begin
end;
{ TLexer }
constructor TLexer.Create(const ASource: string);
begin
inherited Create;
@@ -342,7 +282,7 @@ var
builder: TStringBuilder;
c: Char;
begin
Advance; // Skip opening "
Advance;
builder := TStringBuilder.Create;
try
while (FCurrentPos <= Length(FSource)) do
@@ -350,18 +290,18 @@ begin
c := Peek;
if c = '"' then
begin
Advance; // Consume closing "
Advance;
Result := builder.ToString;
exit;
end;
if c = '\' then
begin
Advance; // Consume '\'
Advance;
if FCurrentPos > Length(FSource) then
Error('Syntax Error: String literal ends with an escape character.');
c := Peek; // Get escaped char
c := Peek;
case c of
'"': builder.Append('"');
'\': builder.Append('\');
@@ -371,7 +311,7 @@ begin
else
builder.Append(c);
end;
Advance; // Consume escaped char
Advance;
end
else
begin
@@ -494,9 +434,7 @@ begin
end;
end;
// -----------------------------------------------------------------------------
// IMPLEMENTATION: Parser
// -----------------------------------------------------------------------------
{ TParser }
constructor TParser.Create(const ASource: string);
begin
@@ -533,30 +471,48 @@ begin
NextToken;
end;
function TParser.ParseParameterList: TArray<IIdentifierNode>;
function TParser.ParseVector: IAstNode;
var
params: TList<IIdentifierNode>;
items: TList<IAstNode>;
startLoc: ISourceLocation;
begin
startLoc := FCurrentToken.GetLocation;
Consume(tkLeftBracket);
params := TList<IIdentifierNode>.Create;
items := TList<IAstNode>.Create;
try
while FCurrentToken.Kind <> tkRightBracket do
begin
if FCurrentToken.Kind = tkEOF then
Error('Syntax Error: Unexpected end of file.');
if FCurrentToken.Kind <> tkIdentifier then
Error('Syntax Error: Expected identifier in parameter list.');
params.Add(TAst.Identifier(FCurrentToken.Text, FCurrentToken.GetLocation));
NextToken;
Error('Syntax Error: Unexpected end of file in vector.');
items.Add(ParseExpression.Node);
end;
Result := params.ToArray;
var id := TIdentities.List('[', ']', ' ', startLoc);
Result := TArgumentList.Create(items.ToArray, id);
finally
params.Free;
items.Free;
end;
Consume(tkRightBracket);
end;
function TParser.ExtractIdentifiers(const Node: IAstNode; const Context: string): TArray<IIdentifierNode>;
var
list: IArgumentList;
i: Integer;
begin
if Node.Kind <> akArgumentList then
ErrorFmt('%s expects a vector [...]', [Context]);
list := Node.AsArgumentList;
SetLength(Result, list.Count);
for i := 0 to list.Count - 1 do
begin
if list[i].Kind <> akIdentifier then
ErrorFmt('%s vector must contain only identifiers.', [Context]);
Result[i] := list[i].AsIdentifier;
end;
end;
function TParser.ParseRecordLiteral: IAstNode;
var
fields: TList<IRecordFieldNode>;
@@ -589,7 +545,6 @@ begin
fields.Add(TAst.RecordField(keyNode, fieldValue, keyToken.GetLocation));
end;
Result := TAst.RecordLiteral(fields.ToArray, startLoc);
finally
fields.Free;
@@ -602,7 +557,6 @@ var
elements: TList<TExpr>;
head: TExpr;
tailNodes: TArray<IAstNode>;
initializer: IAstNode;
startLoc: ISourceLocation;
begin
startLoc := FCurrentToken.GetLocation;
@@ -620,25 +574,89 @@ begin
end;
head := elements[0];
SetLength(tailNodes, elements.Count - 1);
for var i := 0 to High(tailNodes) do
tailNodes[i] := elements[i + 1].Node;
if head.Token.Kind = tkIdentifier then
begin
if SameText(head.Token.Text, 'if') then
if SameText(head.Token.Text, 'pipe') then
begin
if not (Length(tailNodes) in [2, 3]) then
Error('Syntax Error in if statement.');
var elseBranch: IAstNode := nil;
// (pipe [stream1 [:Key1 :Key2] stream2 [:Key3]] (fn ...))
if Length(tailNodes) <> 2 then
Error('Syntax Error: ''pipe'' requires [inputs] vector and (fn) transformation.');
if tailNodes[0].Kind <> akArgumentList then
Error('Syntax Error: ''pipe'' first argument must be a vector [...].');
var rawInputs := tailNodes[0].AsArgumentList;
if (rawInputs.Count mod 2) <> 0 then
Error('Syntax Error: Pipe inputs must be pairs of Identifier and Selector Vector (e.g. [btc [:Close]]).');
var pipeInputs := TList<IPipeInputNode>.Create;
try
var k := 0;
while k < rawInputs.Count do
begin
if rawInputs[k].Kind <> akIdentifier then
Error('Syntax Error: Pipe input stream must be an identifier.');
var selNode := rawInputs[k + 1];
var streamId := rawInputs[k].AsIdentifier;
var selKeywords: TArray<IKeywordNode>;
// Strict format: Selector must be a vector [...] containing keywords
if selNode.Kind <> akArgumentList then
Error('Syntax Error: Pipe selector must be a vector of keywords (e.g. [:Close :High]).');
var selList := selNode.AsArgumentList;
if selList.Count = 0 then
Error('Syntax Error: Selector list cannot be empty.');
SetLength(selKeywords, selList.Count);
for var m := 0 to selList.Count - 1 do
begin
if selList[m].Kind <> akKeyword then
Error('Syntax Error: Selector vector must contain only keywords.');
selKeywords[m] := selList[m].AsKeyword;
end;
var selectorList := TAst.PipeSelectorList(selKeywords, selNode.Identity.Location);
pipeInputs.Add(TAst.PipeInput(streamId, selectorList, streamId.Identity.Location));
Inc(k, 2);
end;
if tailNodes[1].Kind <> akLambdaExpression then
Error('Syntax Error: Pipe transformation must be a lambda (fn).');
Result := TAst.Pipe(pipeInputs.ToArray, tailNodes[1].AsLambdaExpression, startLoc);
finally
pipeInputs.Free;
end;
end
else if SameText(head.Token.Text, 'fn') then
begin
if Length(tailNodes) <> 2 then
Error('Syntax Error: ''fn'' requires a parameter list and a body.');
var params := ExtractIdentifiers(tailNodes[0], 'fn');
Result := TAst.LambdaExpr(params, tailNodes[1], startLoc);
end
else if SameText(head.Token.Text, 'defmacro') then
begin
if (Length(tailNodes) <> 3) or (elements[1].Token.Kind <> tkIdentifier) then
Error('Syntax Error: ''defmacro'' requires name, params, body.');
var params := ExtractIdentifiers(tailNodes[1], 'defmacro');
Result := TAst.MacroDef(tailNodes[0].AsIdentifier, params, tailNodes[2], startLoc);
end
else if SameText(head.Token.Text, 'if') then
begin
var elseNode: IAstNode := nil;
if Length(tailNodes) = 3 then
elseBranch := tailNodes[2];
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseBranch, startLoc);
elseNode := tailNodes[2];
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseNode, startLoc);
end
else if SameText(head.Token.Text, '?') then
begin
// (? test1 branch1 test2 branch2 ... else)
var count := Length(tailNodes);
if (count < 1) or ((count mod 2) = 0) then
Error('Syntax Error: ''?'' (cond) requires an odd number of arguments.');
@@ -653,39 +671,15 @@ begin
end
else if SameText(head.Token.Text, 'def') then
begin
if not (Length(tailNodes) in [1, 2]) then
Error('Syntax Error: ''def'' requires a target and an optional initializer.');
initializer := nil;
var initializer: IAstNode := nil;
if Length(tailNodes) = 2 then
initializer := tailNodes[1];
Result := TAst.VarDecl(tailNodes[0], initializer, startLoc);
end
else if SameText(head.Token.Text, 'defmacro') then
begin
if (Length(tailNodes) <> 3) or (elements[1].Token.Kind <> tkIdentifier) then
Error('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.');
var macroName := tailNodes[0].AsIdentifier;
var macroParams := elements[2].Params; // Parameter list parsing happens in ParseExpression for brackets
if tailNodes[2].Kind <> akQuasiquote then
Error('Syntax Error: Expected a quasiquote as macro body.');
Result := TAst.MacroDef(macroName, macroParams, tailNodes[2], startLoc);
end
else if SameText(head.Token.Text, 'assign') then
begin
if Length(tailNodes) <> 2 then
Error('Syntax Error: ''assign'' requires exactly 2 arguments.');
Result := TAst.Assign(tailNodes[0], tailNodes[1], startLoc);
end
else if SameText(head.Token.Text, 'fn') then
begin
if Length(tailNodes) <> 2 then
Error('Syntax Error: ''fn'' requires a parameter list and a body.');
// elements[1] is the parameter list node which contains the parsed Params array
Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1], startLoc);
end
else if SameText(head.Token.Text, 'do') then
begin
Result := TAst.Block(tailNodes, startLoc)
@@ -696,57 +690,32 @@ begin
end
else if SameText(head.Token.Text, 'get') then
begin
if Length(tailNodes) <> 2 then
Error('Syntax Error: ''get'' requires exactly 2 arguments (base and index).');
Result := TAst.Indexer(tailNodes[0], tailNodes[1], startLoc)
end
// --- NEW: Support for new-series ---
else if SameText(head.Token.Text, 'new-series') then
begin
if Length(tailNodes) <> 1 then
Error('Syntax Error: ''new-series'' requires exactly 1 argument (definition string).');
// Extract definition string from constant node
if (tailNodes[0].Kind = akConstant) and (tailNodes[0].AsConstant.Value.Kind = vkText) then
Result := TAst.CreateSeries(tailNodes[0].AsConstant.Value.AsText, startLoc)
else
Error('Syntax Error: ''new-series'' argument must be a string literal.');
end
// --- NEW: Support for add-item ---
else if SameText(head.Token.Text, 'add-item') then
begin
if not (Length(tailNodes) in [2, 3]) then
Error('Syntax Error: ''add-item'' requires 2 or 3 arguments (series, value, [lookback]).');
var lookback: IAstNode := nil;
if Length(tailNodes) = 3 then
lookback := tailNodes[2];
if tailNodes[0].Kind <> akIdentifier then
Error('Syntax Error: ''add-item'' first argument must be a series identifier.');
Result := TAst.AddSeriesItem(tailNodes[0].AsIdentifier, tailNodes[1], lookback, startLoc);
end
// --- NEW: Support for count (SeriesLength) ---
else if SameText(head.Token.Text, 'count') then
begin
if Length(tailNodes) <> 1 then
Error('Syntax Error: ''count'' requires exactly 1 argument (series).');
if tailNodes[0].Kind <> akIdentifier then
Error('Syntax Error: ''count'' argument must be a series identifier.');
Result := TAst.SeriesLength(tailNodes[0].AsIdentifier, startLoc);
end
else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
begin
if Length(tailNodes) <> 1 then
ErrorFmt(
'Syntax Error: Member access (e.g., ''%s'') requires exactly 1 argument (the base object).',
[head.Token.Text]
);
Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1), head.Token.GetLocation), startLoc);
end;
end
else
Result := nil;
end;
if Result = nil then
@@ -755,26 +724,28 @@ begin
finally
elements.Free;
end;
Consume(tkRightParen);
end;
function TParser.ParseExpression: TExpr;
var
startLoc: ISourceLocation;
i64: Int64;
dbl: Double;
expr: TExpr;
startLoc: ISourceLocation;
begin
Result.Token := FCurrentToken;
startLoc := FCurrentToken.GetLocation;
case FCurrentToken.Kind of
tkLeftBracket:
begin
Result.Node := ParseVector;
exit;
end;
tkBacktick:
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.Quasiquote(expr.Node, startLoc);
Result.Node := TAst.Quasiquote(ParseExpression.Node, startLoc);
exit;
end;
tkTilde:
@@ -783,26 +754,20 @@ begin
if FCurrentToken.Kind = tkAt then
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote, startLoc);
Result.Node := TAst.UnquoteSplicing(ParseExpression.Node.AsQuasiquote, startLoc);
end
else
begin
expr := ParseExpression;
Result.Node := TAst.Unquote(expr.Node, startLoc);
end;
Result.Node := TAst.Unquote(ParseExpression.Node, startLoc);
exit;
end;
tkQuote:
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.FunctionCall(TAst.Identifier('quote', startLoc), [expr.Node], startLoc);
Result.Node := TAst.FunctionCall(TAst.Identifier('quote', startLoc), [ParseExpression.Node], startLoc);
exit;
end;
end;
Result.Token := FCurrentToken;
case FCurrentToken.Kind of
tkNumber:
begin
@@ -811,7 +776,7 @@ begin
else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then
Result.Node := TAst.Constant(dbl, startLoc)
else
ErrorFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
Error('Invalid number');
NextToken;
end;
tkString:
@@ -833,11 +798,9 @@ begin
NextToken;
end;
tkLeftParen: Result.Node := ParseList;
tkLeftBracket: Result.Params := ParseParameterList;
tkLeftBrace: Result.Node := ParseRecordLiteral;
tkEOF: {nop};
else
ErrorFmt('Syntax Error: Unexpected token %s', [FCurrentToken.Kind.ToString]);
Error('Unexpected token');
end;
end;
@@ -845,7 +808,7 @@ function TParser.Parse: IAstNode;
begin
var expr := ParseExpression;
if FCurrentToken.Kind <> tkEOF then
Error('Syntax Error: Unexpected characters after end of expression.');
Error('Unexpected chars after end.');
Result := expr.Node;
end;
@@ -861,7 +824,7 @@ end;
destructor TPrettyPrintVisitor.Destroy;
begin
FBuilder.Free;
inherited Destroy;
inherited;
end;
function TPrettyPrintVisitor.GetResult: string;
@@ -871,12 +834,12 @@ end;
procedure TPrettyPrintVisitor.Indent;
begin
inc(FIndentLevel, 2);
Inc(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
dec(FIndentLevel, 2);
Dec(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Append(const S: string);
@@ -897,15 +860,56 @@ begin
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TVoid;
var
val: TDataValue;
function TPrettyPrintVisitor.VisitPipeInput(const Node: IPipeInputNode): TVoid;
begin
val := Node.Value;
if val.Kind = vkText then
Append('"' + val.AsText + '"')
Node.StreamSource.Accept(Self);
Append(' ');
// Printer Logic for Vector syntax
Node.Selectors.Accept(Self); // Selectors is IPipeSelectorList which is visited as list
end;
function TPrettyPrintVisitor.VisitPipeSelectorList(const Node: IPipeSelectorList): TVoid;
begin
Append('[');
for var i := 0 to Node.Count - 1 do
begin
if i > 0 then
Append(' ');
Node[i].Accept(Self);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitPipeInputList(const Node: IPipeInputList): TVoid;
begin
Append('[');
for var i := 0 to Node.Count - 1 do
begin
if i > 0 then
Append(' ');
Node[i].Accept(Self);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitPipe(const Node: IPipeNode): TVoid;
begin
Append('(pipe ');
Node.Inputs.Accept(Self);
Indent;
NewLine;
Node.Transformation.Accept(Self);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TVoid;
begin
if Node.Value.Kind = vkText then
Append('"' + Node.Value.AsText + '"')
else
Append(val.ToString);
Append(Node.Value.ToString);
end;
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TVoid;
@@ -918,7 +922,10 @@ begin
Append(':' + Node.Value.Name);
end;
// --- List Visitors Implementation ---
function TPrettyPrintVisitor.VisitNop(const Node: INopNode): TVoid;
begin
Append('...');
end;
function TPrettyPrintVisitor.VisitParameterList(const Node: IParameterList): TVoid;
begin
@@ -934,10 +941,9 @@ end;
function TPrettyPrintVisitor.VisitArgumentList(const Node: IArgumentList): TVoid;
begin
// Argument list does not have brackets of its own in Lisp call syntax
for var i := 0 to Node.Count - 1 do
begin
Append(' '); // Space before each argument
Append(' ');
Node[i].Accept(Self);
end;
end;
@@ -973,8 +979,6 @@ begin
Node.Value.Accept(Self);
end;
// --- Node Visitors ---
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TVoid;
begin
Append('(if ');
@@ -1003,7 +1007,6 @@ begin
Append(' ');
pair.Branch.Accept(Self);
end;
// Else
NewLine;
Node.ElseBranch.Accept(Self);
Unindent;
@@ -1063,10 +1066,9 @@ begin
Node.Arguments[0].Accept(Self);
exit;
end;
Append('(');
Node.Callee.Accept(Self);
Node.Arguments.Accept(Self); // Prints separated by space
Node.Arguments.Accept(Self);
Append(')');
end;
@@ -1135,7 +1137,6 @@ begin
Append('{}');
exit;
end;
Append('{');
Node.Fields.Accept(Self);
Append('}');
@@ -1160,11 +1161,6 @@ begin
Append(')');
end;
function TPrettyPrintVisitor.VisitNop(const Node: INopNode): TVoid;
begin
Append('...');
end;
function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TVoid;
begin
Append('(count ');