parser.adb (7274B)
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Types; use Types;
package body Parser is
function Init (File_Name : File_Name_Ref; Source : Source_Ref; Tokens : Token_Vector.Vector) return Parser
is
P : constant Parser :=
(Source => Source,
File_Name => File_Name,
Tokens => Tokens,
Pos => 1,
AST => Declaration_Vectors.Empty_Vector);
begin
return P;
end;
-----------
-- utils --
-----------
-- peek
function Peek (P : in Parser) return Token is
begin
if P.Pos < P.Tokens.Last_Index then
return P.Tokens (P.Pos);
end if;
return Token'(Kind => EOF, Lexeme => To_Unbounded_String (""), Line => 1, Col => 1);
end;
-- peek2
function Peek2 (P : in Parser) return Token is
begin
if P.Pos + 1 < P.Tokens.Last_Index then
return P.Tokens (P.Pos + 1);
end if;
return Token'(Kind => EOF, Lexeme => To_Unbounded_String (""), Line => 1, Col => 1);
end;
-- match
function Match (P : in out Parser; Kind : Token_Kind) return Token is
T : Token;
begin
if P.Pos < P.Tokens.Last_Index then
T := P.Tokens (P.Pos);
if T.Kind = Kind then
P.Pos := P.Pos + 1;
return T;
else
raise Program_Error
with
"Match: expected different token: "
& Token_Kind'Image (Kind)
& " but found: "
& Token_Kind'Image (T.Kind)
& " at L"
& Fixed.Trim (Positive'Image (T.Line), Left)
& ":"
& Fixed.Trim (Positive'Image (T.Col), Left);
end if;
end if;
raise Program_Error with "Match: Token out of bounds";
end Match;
-- consume
function Consume (P : in out Parser) return Token is
T : Token;
begin
if P.Pos < P.Tokens.Last_Index then
T := P.Tokens (P.Pos);
P.Pos := P.Pos + 1;
return T;
end if;
raise Program_Error with "Consume: Token out of bounds";
end Consume;
--------------------
-- skip new lines --
--------------------
procedure Skip_New_Lines (P : in out Parser) is
T : Token;
begin
T := Peek (P);
if T.Kind = Separator then
P.Pos := P.Pos + 1;
end if;
end;
----------------
-- Parse Expr --
----------------
function Parse_Expr (P : in out Parser) return Expr_Ref is
T : Token;
E : Expr_Ref;
begin
T := Match (P, Str_Literal);
E :=
new Expr'
(Entity_Type => null,
Kind => String_Literal,
Lit_Str => T.Lexeme,
File_Name => P.File_Name,
Line => T.Line,
Col => T.Col);
return E;
end Parse_Expr;
---------------------
-- parse func call --
---------------------
function Parse_Call_Statement (P : in out Parser) return Stmt is
T : Token;
Name : Unbounded_String;
E : Expr_Ref;
Expressions : Expr_Vectors.Vector;
CS : Call_Expr;
begin
T := Match (P, Ident);
Name := T.Lexeme;
T := Match (P, L_Paren);
loop
T := Peek (P);
exit when T.Kind = EOF or T.Kind = R_Paren;
E := Parse_Expr (P);
Expressions.Append (E);
T := Peek (P);
exit when T.Kind /= Comma;
end loop;
T := Match (P, R_Paren);
T := Match (P, Separator);
CS := Call_Expr'(Name => Name, Params => Expressions, Entity_Type => null);
return Stmt'(Kind => Stmt_Call_Kind, Call => CS, Scope => null);
end;
----------------
-- parse stmt --
----------------
function Parse_Statement (P : in out Parser) return Stmt is
T : Token;
begin
T := Peek (P);
loop
T := Peek (P);
Skip_New_Lines (P);
exit when T.Kind = EOF or (T.Kind = Keyword and T.Lexeme = "end");
if T.Kind = Ident and Peek2 (P).Kind = L_Paren then
return Parse_Call_Statement (P);
end if;
end loop;
raise Program_Error with "Parse Statement failed: unknown token " & Token'Image (T);
end;
---------------------
-- parse func decl --
---------------------
function Parse_Func_Decl (P : in out Parser) return Decl is
T : Token;
Name : Unbounded_String;
Param_Name : Unbounded_String;
Param_Kind : Unbounded_String;
Public : Boolean := false;
Stmts : Stmt_Vectors.Vector;
Pa : Param;
Params : Param_Vectors.Vector;
Line, Col : Positive;
begin
T := Consume (P); -- fx
Line := T.Line;
Col := T.Col;
if T.Lexeme = "fx" then
Public := true;
end if;
Name := Match (P, Ident).Lexeme;
Put_Line ("name: " & To_String (Name));
T := Peek (P);
T := Match (P, L_Paren); -- (
loop
-- func decl params
T := Peek (P);
exit when T.Kind = EOF or T.Kind = R_Paren;
T := Match (P, Ident); -- type of param
T := Match (P, Ident); -- name of param
Pa := Param'(Name => Param_Name, Kind => Param_Kind);
Params.Append (Pa);
T := Peek (P);
exit when T.Kind /= Comma;
end loop;
T := Match (P, R_Paren);
-- TODO func decl: missing 'return' type/kind parsing, currently none
T := Match (P, ColonColon);
loop
-- func decl statements
T := Peek (P);
exit when T.Kind = EOF or (T.Kind = Keyword and T.Lexeme = "end");
Stmts.Append (Parse_Statement (P));
end loop;
return
Decl'
(Kind => Function_Kind,
Scope => null,
Func =>
Func_Decl'
(Name => Name,
Params => Params,
Public => Public,
Return_Kind => To_Unbounded_String (""),
File_Name => P.File_Name,
Line => Line,
Col => Col,
Stmts => Stmts));
end Parse_Func_Decl;
-------------------
-- parse program --
-------------------
procedure Parse_Program (P : in out Parser) is
TL : Declaration_Vectors.Vector;
T : Token;
Counter : Positive := 1;
begin
Put_Line ("parsing");
while Peek (P).Kind /= EOF and Counter < 100 loop
Counter := Counter + 1;
Skip_New_Lines (P);
T := Peek (P);
if T.Kind = Keyword and (T.Lexeme = "fx" or T.Lexeme = "fn") then
TL.Append (Parse_Func_Decl (P));
end if;
exit when T.Kind = EOF or (T.Kind = Keyword and T.Lexeme = "end");
end loop;
P.AST := TL;
Put_Line ("done parsing");
end;
-----------
-- parse --
-----------
procedure Parse (P : in out Parser) is
begin
Parse_Program (P);
Put_Line ("done parsing");
end Parse;
end Parser;