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