hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

experimenting include handling

Browse Source
This commit is contained in:
hyung-hwan
2021-11-14 15:07:41 +00:00
parent bcba60f0b7
commit 5e40282416
7 changed files with 136 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

143
h2/lib2/h3-compilers.adb
View File

@ -1,5 +1,4 @@
with H3.Utf8;
with ada.text_io;
package body H3.Compilers is
type Char_Array is array(System_Index range<>) of Standard.Character;
@ -93,13 +92,54 @@ package body H3.Compilers is
Set_Lexer_State (C, LX_START);
end End_Token;
procedure Dump_Token (Tk: in Token) is
begin
Ada.Text_IO.Put (Tk.Id'Img);
Ada.Text_IO.Put (": ");
Ada.Text_IO.Put_Line (Standard.String(Utf8.From_Unicode_String(Tk.Buf.To_Rune_Array)));
end Dump_Token;
-- -------------------------------------------------------------------
procedure Set_Parser_State (C: in out Compiler; State: in Parser_State) is
begin
C.Ps.Prev_State := C.Ps.State;
C.Ps.State := State;
end Set_Parser_State;
procedure Start_Inclusion (C: in out Compiler; Name: in S.Rune_Array) is
Top: System_Index;
begin
if C.Inc.Top = C.Inc.Streams'Last then
raise Syntax_Error with "inclusion depth too deep";
end if;
Top := C.Inc.Top + 1;
declare
St: Stream renames C.Inc.Streams(Top);
begin
Ada.Text_IO.Open (St.Handle, Ada.Text_IO.In_File, Standard.String(Utf8.From_Unicode_String(Name)));
St.Initial_Level := C.Ps.Level;
St.Initial_Parser_State := C.Ps.Prev_State;
St.Next_Parser_State := PS_INCLUDE_TERMINATOR;
end;
C.Inc.Top := Top;
-- the parser should resume at the state when the include directive is seen
Set_Parser_State (C, C.Ps.Prev_State); -- the state when the include directive is seen
end Start_Inclusion;
procedure End_Inclusion (C: in out Compiler) is
Top: constant System_Index := C.Inc.Top;
begin
if C.Ps.State /= C.Inc.Streams(Top).Initial_Parser_State or else C.Ps.Level /= C.Inc.Streams(Top).Initial_Level then
raise Syntax_Error with "unexpected end of inclusion";
end if;
Ada.Text_IO.Close (C.Inc.Streams(C.Inc.Top).Handle);
Set_Parser_State (C, C.Inc.Streams(C.Inc.Top).Next_Parser_State);
C.Inc.Top := C.Inc.Top - 1;
end End_Inclusion;
procedure Parse_Start (C: in out Compiler) is
begin
case C.Tk.Id is
@ -113,12 +153,17 @@ package body H3.Compilers is
null;
when TK_DIRECTIVE =>
if C.Tk.Buf.Equals(LB_XINCLUDE) then
Set_Parser_State (C, PS_INCLUDE);
Set_Parser_State (C, PS_INCLUDE_TARGET);
else
raise Syntax_Error with "unknown directive name";
end if;
when TK_EOF =>
null;
if C.Inc.Top > 0 then
End_Inclusion (C);
else
-- end of really the input??
null;
end if;
when TK_EOL =>
null;
when TK_GE =>
@ -136,65 +181,48 @@ package body H3.Compilers is
end case;
end Parse_Start;
procedure Start_Inclusion (C: in out Compiler; Name: in S.Rune_Array) is
Top: System_Index;
begin
if C.St.Top = C.St.Items'Last then
raise Syntax_Error with "inclusion depth too deep";
end if;
Top := C.St.Top + 1;
Ada.Text_IO.Open (C.St.Items(Top).Handle, Ada.Text_IO.In_File, Standard.String(Utf8.From_Unicode_String(Name)));
C.St.Top := Top;
end Start_Inclusion;
procedure End_Inclusion (C: in out Compiler) is
begin
Ada.Text_IO.Close (C.St.Items(C.St.Top).Handle);
C.St.Top := C.St.Top - 1;
end End_Inclusion;
procedure Parse_Include (C: in out Compiler) is
procedure Parse_Include_Target (C: in out Compiler) is
begin
if C.Tk.Id = TK_CSTR then
-- arrange to feed more data from the included file.
Start_Inclusion (C, S.To_Rune_Array(C.Tk.Buf));
null;
else
-- the target is not a string.
Dump_Token (C.Tk);
raise Syntax_Error with "string literal required";
end if;
end Parse_Include;
end Parse_Include_Target;
procedure Parse_Include_End (C: in out Compiler) is
procedure Parse_Include_Terminator (C: in out Compiler) is
begin
if C.Tk.Id /= TK_SEMICOLON then
raise Syntax_Error with "semicolon required";
end if;
-- TODO: put the state back to START???
end Parse_Include_End;
-- it is not safe to access information at the previous stack top.
-- no problem in doing that becuase the current implementation uses
-- a static array.
Set_Parser_State (C, C.Inc.Streams(C.Inc.Top + 1).Initial_Parser_State);
end Parse_Include_Terminator;
procedure Got_Token (C: in out Compiler) is
begin
--case C.P.State IS
-- when START =>
-- null;
--end case;
ada.text_io.put (C.Tk.Id'Img);
ada.text_io.put (" ");
for i in C.Tk.Buf.Get_First_Index .. C.Tk.Buf.Get_Last_Index loop
ada.text_io.put (standard.character'val(S.Rune'Pos(C.Tk.Buf.Get_Item(i))));
ada.text_io.put (Standard.Character'val(S.Rune'Pos(C.Tk.Buf.Get_Item(i))));
end loop;
ada.text_io.put_line("");
case C.Ps.State is
when PS_START =>
when PS_START =>
Parse_Start (C);
when PS_INCLUDE =>
Parse_Include (C);
when PS_INCLUDE_TARGET =>
Parse_Include_Target (C);
when PS_INCLUDE_TERMINATOR =>
Parse_Include_Terminator (C);
when others =>
raise Syntax_Error; -- TODO: change this...
raise Syntax_Error with "unknown parser state"; -- TODO: change this...
end case;
end Got_Token;
@ -290,21 +318,42 @@ end if;
end case;
end Feed_Char_Code;
procedure Feed_Inc (C: in out Compiler) is
Entry_Top: constant System_Index := C.Inc.Top;
begin
loop
while not Ada.Text_IO.End_Of_File(C.Inc.Streams(C.Inc.Top).Handle) loop
declare
Ch: Standard.Character;
begin
Ada.Text_IO.Get (C.Inc.Streams(C.Inc.Top).Handle, Ch);
Feed_Char_Code (C, Standard.Character'Pos(Ch));
end;
-- After each feed, C.Inc.Top may get incremented if an inclusion
-- directive is found. so the while loop iterates over the streams
-- of all inner included levels. End_Feed() below drops C.Inc.Top
-- and the outer loop will resume the inner while loop at the outer
-- inclusion level until all entered inclusion levels are exited.
end loop;
End_Feed (C);
if C.Inc.Top < Entry_Top then
-- End_Inclusion() is called on EOF which is fed by End_Feed().
-- It also decrements the stack pointer. The current inclusion
-- stack pointer will get less that First_Top if the first inclusion
-- level entered is exited.
exit;
end if;
end loop;
end Feed_Inc;
procedure Feed (C: in out Compiler; Data: in S.Rune_Array) is
begin
for i in Data'Range loop
Feed_Char_Code (C, R.To_Code(Data(i)));
if C.St.Top > 0 then
declare
Ch: Standard.Character;
begin
while not Ada.Text_IO.End_Of_File(C.St.Items(C.St.Top).Handle) loop
Ada.Text_IO.Get (C.St.Items(C.St.Top).Handle, Ch);
Feed_Char_Code (C, Standard.Character'Pos(Ch));
--if inclusion stack is not Empty???
end loop;
end;
if C.Inc.Top > 0 then
Feed_Inc (C);
end if;
end loop;
end Feed;