commit cee9de1c5073c352838dd65b7bd51d445369492f
parent 6a1a19fc3ffeb64f93eedfa1a1198ee51657ed76
Author: citbl <citbl@citbl.org>
Date: Sun, 7 Jun 2026 16:44:34 +1000
progress?
Diffstat:
| M | src/parser.adb | | | 85 | ++++++++++++++++++++++++++++++++++--------------------------------------------- |
| M | src/parser.ads | | | 87 | ++++++++++++++++++++++++++++++++++++++++++++++--------------------------------- |
2 files changed, 88 insertions(+), 84 deletions(-)
diff --git a/src/parser.adb b/src/parser.adb
@@ -3,19 +3,13 @@ with Lexer; use Lexer;
package body Parser is
function Init
- (File_Name : File_Name_Ref;
- Source : Source_Ref;
- Tokens : Token_Vector.Vector) return Parser
+ (File_Name : File_Name_Ref; Source : Source_Ref; Tokens : Token_Vector.Vector) return Parser
is
P : Parser :=
- (Source => Source,
- File_Name => File_Name,
- Tokens => Tokens,
- Pos => 1,
- AST => null);
+ (Source => Source, File_Name => File_Name, Tokens => Tokens, Pos => 1, AST => null);
begin
return P;
- end Init;
+ end;
-- peek
@@ -24,13 +18,8 @@ package body Parser is
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 Peek;
+ return Token'(Kind => EOF, Lexeme => To_Unbounded_String (""), Line => 1, Col => 1);
+ end;
-- peek2
@@ -39,13 +28,8 @@ package body Parser is
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 Peek2;
+ return Token'(Kind => EOF, Lexeme => To_Unbounded_String (""), Line => 1, Col => 1);
+ end;
-- match
@@ -57,8 +41,7 @@ package body Parser is
if T.Kind = Kind then
return T;
else
- raise Program_Error
- with "expected different token: " & Token_Kind'Image (Kind);
+ raise Program_Error with "expected different token: " & Token_Kind'Image (Kind);
end if;
end if;
raise Program_Error with "Match: Token out of bounds";
@@ -77,31 +60,29 @@ package body Parser is
raise Program_Error with "Consume: Token out of bounds";
end Consume;
- function Parse_Expr(P: in out Parser) return Expr is
- T: Token;
+ function Parse_Expr (P : in out Parser) return Expr is
+ T : Token;
begin
-
- end Parse_Param;
+ null; -- TODO parse expr
+
+ end Parse_Expr;
-- TODO parse func call statement
- function Parse_Call_Statement(P : in out Parser) return Call_Statement is
- T : Token;
+ function Parse_Call_Statement (P : in out Parser) return Call_Statement is
+ T : Token;
Name : Unbounded_String;
begin
- T := Expect(P, Ident);
+ T := Expect (P, Ident);
Name := T.Lexeme;
- T := Expect(P, L_Paren);
+ T := Expect (P, L_Paren);
loop
- T := Peek(P);
+ T := Peek (P);
exit when T.Kind = EOF or T.Kind = R_Paren;
-
-
end loop;
- end Parse_Call_Statement;
-
+ end;
-- parse stmt
@@ -110,19 +91,17 @@ package body Parser is
begin
loop
- T := Peek(P);
+ T := Peek (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
+ if T.Kind = Ident and Peek2 (P).Kind = L_Paren then
-- func call
- Parse_Call_Statement(P);
+ Parse_Call_Statement (P);
end if; -- TODO support other statement kinds
-
- end loop;
-
+ end loop;
- end Parse_Statement;
+ end;
-- parse func decl
@@ -131,6 +110,8 @@ package body Parser is
Name_Token : Token;
Public : Boolean := false;
Func : Func_Decl;
+ Stmts : Stmt_Vectors.Vector;
+ Stmt : Statement;
begin
T := Consume (P); -- fx
if T.Lexeme = fx then
@@ -155,9 +136,17 @@ package body Parser is
Expect (P, R_Paren);
Expect (P, ColonColon);
- -- parse statements
+ -- parse statements
+
+ loop
+ T := Peek (P);
+ exit when T.Kind = EOF or T.Lexeme = "end";
+
+ Stmt := Parse_Statement (P);
+ Stmts.Append (Stmt);
+ end loop;
- end Parse_Funcion_Decl;
+ end Parse_Func_Decl;
-- parse program
@@ -189,7 +178,7 @@ package body Parser is
Line => 1,
Col => 1);
return N;
- end Parse_Program;
+ end;
-- parse
diff --git a/src/parser.ads b/src/parser.ads
@@ -1,4 +1,5 @@
with Ada.Containers.Vectors;
+with Ada.Containers.Indefinite_Vectors;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Lexer; use Lexer;
@@ -41,64 +42,78 @@ package Parser is
package Nodes_Vector is new
Ada.Containers.Vectors (Index_Type => Natural, Element_Type => Node_Ref);
- type Decl_Kind is (Function_Decl, Struct_Decl);
+ type Param is record
+ Name : Unbounded_String;
+ Kind : Unbounded_String;
+ end record;
- type Decl (Kind : Decl_Kind := Function_Decl) is record
+ package Param_Vectors is new
+ Ada.Containers.Vectors (Index_Type => Natural, Element_Type => Param);
+
+ type Statement_Kind is (Stmt_Call);
+
+ type Call_Stmt is record
+ Name : Unbounded_String;
+ Params : Param_Vectors.Vector;
+ end record;
+
+ type Statement (Kind : Statement_Kind) is record
case Kind is
- when Function_Kind =>
- Func : Function_Decl;
+ when Stmt_Call =>
+ Call : Call_Stmt;
+
+ -- when Stmt_If =>
+ -- Iff : If_Stmt;
- when Struct_Kind =>
- Struct : Struct_Decl;
+ -- when Stmt_While =>
+ -- Whilee : While_Stmt;
+
+ -- when Stmt_Expr =>
+ -- Expr : Expr_Stmt;
end case;
end record;
+ type Expr;
+
+ type Expr_Ref is access Expr;
+
+ package Stmt_Vectors is new
+ Ada.Containers.Indefinite_Vectors (Index_Type => Natural, Element_Type => Statement);
+
+ package Expr_Vectors is new
+ Ada.Containers.Indefinite_Vectors (Index_Type => Natural, Element_Type => Expr_Ref);
+
+ type Call_Expr is record
+ Callee : Unbounded_String;
+ Params : Expr_Vectors.Vector;
+ end record;
+
type Expr_Kind is (Expr_Call, String_Literal);
- type Expr (Kind : Expr_Kind := Call_Expr) is record
+ type Expr (Kind : Expr_Kind := Expr_Call) is record
case Kind is
when Expr_Call =>
- Call_Expr : Call_Expr;
+ Call : Call_Expr;
when String_Literal =>
- Lit_String : Lit_String;
+ Lit_Str : Unbounded_String;
end case;
end record;
- type Param is record
- Name : Unbounded_String;
- Kind : Unbounded_String;
- end record;
-
- package Param_Vectors is new
- Ada.Containers.Vectors (Index_Type => Natural, Element_Type => Param);
-
type Func_Decl is record
Name : Unbounded_String;
Params : Param_Vectors.Vector;
Return_Kind : Unbounded_String;
- Block : Block;
+ Stmts : Stmt_Vectors.Vector;
end record;
+ type Decl_Kind is (Function_Kind);
- type Call_Stmt is record
- Name : Unbounded_String;
- Params : Param_Vectors.Vector;
- end record;
-
- type Statement_Kind is (Stmt_Call, Stmt_If, Stmt_While, Stmt_Expr);
-
- type Statement (Kind : Statement_Kind := Stmt_call) is record
+ type Decl (Kind : Decl_Kind) is record
case Kind is
- when Stmt_Call =>
- Call_Stmt : Call_Stmt;
-
- when Stmt_If =>
- If_Stmt : If_Stmt;
-
- when Stmt_While =>
- While_Stmt : While_Stmt;
+ when Function_Kind =>
+ Func : Func_Decl;
- when Stmt_Expr =>
- Expr_Stmt : Expr_Stmt;
+ -- when Struct_Kind =>
+ -- Struct : Struct_Decl;
end case;
end record;
