diff --git a/lib2/h3-compilers.adb b/lib2/h3-compilers.adb index 1558f18..03cde07 100644 --- a/lib2/h3-compilers.adb +++ b/lib2/h3-compilers.adb @@ -139,11 +139,13 @@ package body H3.Compilers is S.Current := Code; end; C.Prs.Top := Top; +--ada.text_io.put_line ("Push_Parse_State " & Code'Img); end Push_Parse_State; procedure Pop_Parse_State (C: in out Compiler) is begin - C.Prs.top := C.Prs.Top - 1; +--ada.text_io.put_line ("Pop_Parse_State " & C.Prs.States(C.Prs.Top).Current'Img); + C.Prs.Top := C.Prs.Top - 1; end Pop_Parse_State; -- ------------------------------------------------------------------- @@ -172,12 +174,13 @@ package body H3.Compilers is Push_Parse_State (C, C.Prs.States(C.Prs.Top - 1).Current); end Push_Inclusion; - procedure Pop_Inclusion (C: in out Compiler; Check: Boolean) is + procedure Pop_Inclusion (C: in out Compiler; Check: in Boolean) is begin Ada.Text_IO.Close (C.Inc.Streams(C.Inc.Top).Handle); if Check then if C.Prs.Top /= C.Inc.Streams(C.Inc.Top).Prs_Level + 1 then - raise Syntax_Error with "unblanced inclusion content"; +ada.text_io.put_line (">>>>>>>>>>> UNBALANCED INCLUSION CONTEXT..." & C.Prs.Top'Img & " " & C.Inc.Streams(C.Inc.Top).Prs_Level'Img); + raise Syntax_Error with "unbalanced inclusion content"; end if; end if; C.Inc.Top := C.Inc.Top - 1; @@ -195,6 +198,10 @@ package body H3.Compilers is else -- probably a command name or a variable name? Push_Parse_State (C, PS_PLAIN_STATEMENT_START); + C.Prs.States(C.Prs.Top).Data := ( + Code => PD_STATEMENT, + Stmt_Starter => C.Tk.Buf + ); end if; end Parse_Ident; @@ -211,8 +218,42 @@ package body H3.Compilers is -- ------------------------------------------------------------------- procedure Parse_Plain_Statement_Start (C: in out Compiler) is begin - null; + case C.Tk.Id is + when TK_EOL => + Pop_Parse_State (C); + + when TK_EOF => + Pop_Parse_State (C); + + if C.Inc.Top > 0 then + Pop_Inclusion (C, True); + else + -- end of really the input?? + null; + end if; + + when TK_CSTR => + null; + + when TK_IDENT => + null; + + when TK_DOLLARED_LPAREN => -- $( + Push_Parse_State (C, PS_START); + + when TK_RPAREN => + Pop_Parse_State (C); -- pop as if EOL is seen. + Pop_Parse_State (C); -- pop against TK_DOLLARED_LPAREN + + when TK_SEMICOLON => + -- end of the current statement. go on to the next statement + Set_Parse_State (C, PS_PLAIN_STATEMENT_START); + + when others => + raise Syntax_Error with "invalid token in in plain statement"; + end case; end Parse_Plain_Statement_Start; + -- ------------------------------------------------------------------- procedure Parse_Start (C: in out Compiler) is @@ -257,12 +298,16 @@ package body H3.Compilers is when TK_SEMICOLON => null; - when TK_HASHED_LBRACE => - null; - when TK_HASHED_LBRACK => - null; - when TK_HASHED_LPAREN => - null; + --when TK_HASHED_LBRACE => + -- null; + --when TK_HASHED_LBRACK => + -- null; + + when TK_DOLLARED_LPAREN => + Push_Parse_State (C, PS_START); + + when TK_RPAREN => + Pop_Parse_State (C); when others => raise Syntax_Error with "unexpected token"; diff --git a/lib2/h3-compilers.ads b/lib2/h3-compilers.ads index 44dc65e..f5c3855 100644 --- a/lib2/h3-compilers.ads +++ b/lib2/h3-compilers.ads @@ -113,9 +113,9 @@ private when PD_VOID => null; when PD_STATEMENT => - Cmd_Name: S.Elastic_String; + Stmt_Starter: S.Elastic_String; when PD_ASSIGNMENT => - Var_Name: S.Elastic_String; + Assign_Starter: S.Elastic_String; end case; end record; diff --git a/lib2/h3-trees.adb b/lib2/h3-trees.adb new file mode 100644 index 0000000..115e9e8 --- /dev/null +++ b/lib2/h3-trees.adb @@ -0,0 +1,19 @@ + +package body H3.Trees is + + procedure Add_Node (Tr: in out Tree; N: in Node) is + begin + --Tr.Nodes, + + null; + end Add_Node; + + procedure Free_Node (Tr: in out Tree; N: in out Node) is + begin + --case N.Code is + -- when NODE_... + --end case; + null; + end Free_Node; + +end H3.Trees; diff --git a/lib2/h3-trees.ads b/lib2/h3-trees.ads new file mode 100644 index 0000000..0e9642a --- /dev/null +++ b/lib2/h3-trees.ads @@ -0,0 +1,43 @@ +use H3.Arrays; + +package H3.Trees is + + -- parse tree + + --package A is new H3.Arrays(XXXX, 0); + + type Node_Code is ( + NODE_ASSIGN, + NODE_CALL, + NODE_CLASS + NODE_IF, + NODE_FUN, + NODE_VOID, + NODE_WHILE + ); + + type Node(Code: Node_Code := NODE_VOID) is record + -- Loc: location. + case Code is + when NODE_ASSIGN => + null; + when NODE_CALL => + null; + when NODE_CLASS => + null; + when NODE_IF => + null; + when NODE_FUN => + null; + when NODE_VOID => + null; + when NODE_WHILE => + null; + end record; + + type Tree is record + Next_Node: System_Index := System_Index'First; + Toplevel_Node := Node + end Tree; + +end H3.Trees;