adding more experimental code

This commit is contained in:
hyung-hwan 2021-12-05 16:13:36 +00:00
parent e5157250fe
commit 7fd7a82104
4 changed files with 119 additions and 12 deletions

View File

@ -139,11 +139,13 @@ package body H3.Compilers is
S.Current := Code; S.Current := Code;
end; end;
C.Prs.Top := Top; C.Prs.Top := Top;
--ada.text_io.put_line ("Push_Parse_State " & Code'Img);
end Push_Parse_State; end Push_Parse_State;
procedure Pop_Parse_State (C: in out Compiler) is procedure Pop_Parse_State (C: in out Compiler) is
begin 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; 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); Push_Parse_State (C, C.Prs.States(C.Prs.Top - 1).Current);
end Push_Inclusion; 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 begin
Ada.Text_IO.Close (C.Inc.Streams(C.Inc.Top).Handle); Ada.Text_IO.Close (C.Inc.Streams(C.Inc.Top).Handle);
if Check then if Check then
if C.Prs.Top /= C.Inc.Streams(C.Inc.Top).Prs_Level + 1 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;
end if; end if;
C.Inc.Top := C.Inc.Top - 1; C.Inc.Top := C.Inc.Top - 1;
@ -195,6 +198,10 @@ package body H3.Compilers is
else else
-- probably a command name or a variable name? -- probably a command name or a variable name?
Push_Parse_State (C, PS_PLAIN_STATEMENT_START); 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 if;
end Parse_Ident; end Parse_Ident;
@ -211,8 +218,42 @@ package body H3.Compilers is
-- ------------------------------------------------------------------- -- -------------------------------------------------------------------
procedure Parse_Plain_Statement_Start (C: in out Compiler) is procedure Parse_Plain_Statement_Start (C: in out Compiler) is
begin begin
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; 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; end Parse_Plain_Statement_Start;
-- ------------------------------------------------------------------- -- -------------------------------------------------------------------
procedure Parse_Start (C: in out Compiler) is procedure Parse_Start (C: in out Compiler) is
@ -257,12 +298,16 @@ package body H3.Compilers is
when TK_SEMICOLON => when TK_SEMICOLON =>
null; null;
when TK_HASHED_LBRACE => --when TK_HASHED_LBRACE =>
null; -- null;
when TK_HASHED_LBRACK => --when TK_HASHED_LBRACK =>
null; -- null;
when TK_HASHED_LPAREN =>
null; when TK_DOLLARED_LPAREN =>
Push_Parse_State (C, PS_START);
when TK_RPAREN =>
Pop_Parse_State (C);
when others => when others =>
raise Syntax_Error with "unexpected token"; raise Syntax_Error with "unexpected token";

View File

@ -113,9 +113,9 @@ private
when PD_VOID => when PD_VOID =>
null; null;
when PD_STATEMENT => when PD_STATEMENT =>
Cmd_Name: S.Elastic_String; Stmt_Starter: S.Elastic_String;
when PD_ASSIGNMENT => when PD_ASSIGNMENT =>
Var_Name: S.Elastic_String; Assign_Starter: S.Elastic_String;
end case; end case;
end record; end record;

19
lib2/h3-trees.adb Normal file
View File

@ -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;

43
lib2/h3-trees.ads Normal file
View File

@ -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;