adding more experimental code
This commit is contained in:
parent
e5157250fe
commit
7fd7a82104
@ -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";
|
||||
|
@ -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;
|
||||
|
||||
|
19
lib2/h3-trees.adb
Normal file
19
lib2/h3-trees.adb
Normal 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
43
lib2/h3-trees.ads
Normal 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;
|
Loading…
Reference in New Issue
Block a user