parser.adb (5552B)
1 with Lexer; use Lexer; 2 3 package body Parser is 4 5 function Init 6 (File_Name : File_Name_Ref; Source : Source_Ref; Tokens : Token_Vector.Vector) return Parser 7 is 8 P : Parser := 9 (Source => Source, File_Name => File_Name, Tokens => Tokens, Pos => 1, Top_Program => Top_Level_Vectors.Empty_Vector); 10 begin 11 return P; 12 end; 13 14 ----------- 15 -- utils -- 16 ----------- 17 18 -- peek 19 20 function Peek (P : in Parser) return Token is 21 begin 22 if P.Pos < P.Tokens.Last_Index then 23 return P.Tokens (P.Pos); 24 end if; 25 return Token'(Kind => EOF, Lexeme => To_Unbounded_String (""), Line => 1, Col => 1); 26 end; 27 28 -- peek2 29 30 function Peek2 (P : in Parser) return Token is 31 begin 32 if P.Pos + 1 < P.Tokens.Last_Index then 33 return P.Tokens (P.Pos + 1); 34 end if; 35 return Token'(Kind => EOF, Lexeme => To_Unbounded_String (""), Line => 1, Col => 1); 36 end; 37 38 -- match 39 40 function Match (P : in Parser; Kind : Token_Kind) return Token is 41 T : Token; 42 begin 43 if P.Pos < P.Tokens.Last_Index then 44 T := P.Tokens (P.Pos); 45 if T.Kind = Kind then 46 return T; 47 else 48 raise Program_Error with "expected different token: " & Token_Kind'Image (Kind); 49 end if; 50 end if; 51 raise Program_Error with "Match: Token out of bounds"; 52 end Match; 53 54 -- consume 55 56 function Consume (P : in out Parser) return Token is 57 T : Token; 58 begin 59 if P.Pos < P.Tokens.Last_Index then 60 T := P.Tokens (P.Pos); 61 P.Pos := P.Pos + 1; 62 return T; 63 end if; 64 raise Program_Error with "Consume: Token out of bounds"; 65 end Consume; 66 67 ---------------- 68 -- Parse Expr -- 69 ---------------- 70 71 function Parse_Expr (P : in out Parser) return Expr_Ref is 72 T : Token; 73 E : Expr_Ref; 74 begin 75 T := Match (P, Str_Literal); 76 E := new Expr'(Kind => String_Literal, Lit_Str => T.Lexeme); 77 return E; 78 79 end Parse_Expr; 80 81 --------------------- 82 -- parse func call -- 83 --------------------- 84 85 function Parse_Call_Statement (P : in out Parser) return Stmt_Ref is 86 T : Token; 87 Name : Unbounded_String; 88 E : Expr_Ref; 89 Expressions : Expr_Vectors.Vector; 90 CS : Call_Stmt; 91 ST : Stmt_Ref; 92 begin 93 94 T := Match (P, Ident); 95 Name := T.Lexeme; 96 T := Match (P, L_Paren); 97 98 loop 99 T := Peek (P); 100 exit when T.Kind = EOF or T.Kind = R_Paren; 101 E := Parse_Expr (P); 102 Expressions.Append (E); 103 T := Peek (P); 104 exit when T.Kind /= Comma; 105 end loop; 106 107 T := Match (P, R_Paren); 108 CS := Call_Stmt'(Name => Name, Params => Expressions); 109 ST := new Stmt'(Kind => Stmt_Call, Call => CS); 110 return ST; 111 end; 112 113 ---------------- 114 -- parse stmt -- 115 ---------------- 116 117 function Parse_Statement (P : in out Parser) return Stmt_Ref is 118 T : Token; 119 begin 120 121 loop 122 T := Peek (P); 123 exit when T.Kind = EOF or (T.Kind = Keyword and T.Lexeme = "end"); 124 125 if T.Kind = Ident and Peek2 (P).Kind = L_Paren then 126 return Parse_Call_Statement (P); 127 end if; 128 129 end loop; 130 131 end; 132 133 --------------------- 134 -- parse func decl -- 135 --------------------- 136 137 function Parse_Func_Decl (P : in out Parser) return Decl is 138 T : Token; 139 Name : Unbounded_String; 140 Param_Name : Unbounded_String; 141 Param_Kind : Unbounded_String; 142 Public : Boolean := false; 143 Func : Func_Decl; 144 Stmts : Stmt_Vectors.Vector; 145 Pa : Param; 146 Params : Param_Vectors.Vector; 147 ST : Stmt_Ref; 148 begin 149 T := Consume (P); -- fx 150 if T.Lexeme = "fx" then 151 Public := true; 152 end if; 153 Name := Match (P, Ident).Lexeme; 154 T := Match (P, L_Paren); -- ( 155 156 loop 157 -- func decl params 158 T := Peek (P); 159 exit when T.Kind = EOF or T.Kind = R_Paren; 160 T := Match (P, Ident); -- type of param 161 T := Match (P, Ident); -- name of param 162 Pa := Param'(Name => Param_Name, Kind => Param_Kind); 163 Params.Append (Pa); 164 T := Peek (P); 165 exit when T.Kind /= Comma; 166 end loop; 167 168 T := Match (P, R_Paren); 169 -- TODO func decl missing return kind parsing 170 T := Match (P, ColonColon); 171 172 loop 173 -- func decl statements 174 T := Peek (P); 175 exit when T.Kind = EOF or (T.Kind = Keyword and T.Lexeme = "end"); 176 ST := Parse_Statement (P); 177 Stmts.Append (ST); 178 end loop; 179 180 return 181 Decl' 182 (Kind => Function_Kind, 183 Func => Func_Decl'(Name => Name, Params => Params, Return_Kind => To_Unbounded_String(""), Stmts => Stmts)); 184 185 end Parse_Func_Decl; 186 187 ------------------- 188 -- parse program -- 189 ------------------- 190 191 procedure Parse_Program (P : in out Parser) is 192 TL : Top_Level_Vectors.Vector; 193 T : Token; 194 begin 195 -- if Next_Token = 196 197 while Peek (P).Kind /= EOF loop 198 T := Peek (P); 199 if T.Kind = Keyword and (T.Lexeme = "fx" or T.Lexeme = "fn") then 200 TL.Append(Parse_Func_Decl (P)); 201 end if; 202 end loop; 203 204 P.Top_Program := TL; 205 206 end; 207 208 ----------- 209 -- parse -- 210 ----------- 211 212 procedure Parse (P : in out Parser) is 213 begin 214 Parse_Program (P); 215 end Parse; 216 217 procedure Print_AST (P : Parser) is 218 begin 219 null; 220 end Print_AST; 221 222 end Parser;