added utf8 functions

h2/lib2/h3-compilers.adb

@@ -1,7 +1,12 @@
+with H3.Utf8;
 with ada.text_io;
 
 package body H3.Compilers is
+	type Char_Array is array(System_Index range<>) of Standard.Character;
+	package Utf8 is new H3.Utf8(Standard.Character, S.Rune, Char_Array, S.Rune_Array);
+
 	LB_EOF: constant S.Rune_Array := (R.V.Left_Arrow,R.V.UC_E,R.V.UC_O,R.V.UC_F,R.V.Right_Arrow); -- <EOF>
+	LB_XINCLUDE: constant S.Rune_Array := (R.V.Number_Sign,R.V.LC_I,R.V.LC_N,R.V.LC_C,R.V.LC_L,R.V.LC_U,R.V.LC_D,R.V.LC_E); -- #include
 
 	procedure Set_Lexer_State (C: in out Compiler; State: in Lexer_State) is
 	begin
@@ -21,21 +26,13 @@ package body H3.Compilers is
 		Set_Lexer_State (C, State, R.To_Rune(Code));
 	end Set_Lexer_State;
 
-	procedure Got_Token (C: in out Compiler) is
+	procedure Set_Parser_State (C: in out Compiler; State: in Parser_State) 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))));
-end loop;
-ada.text_io.put_line("");
-
+		C.Ps.State := State;
+	end Set_Parser_State;
 
+	procedure Parse_Start (C: in out Compiler) is
+	begin
 		case C.Tk.Id is
 			when TK_BSTR =>
 				null;
@@ -46,8 +43,11 @@ ada.text_io.put_line("");
 			when TK_CSTR =>
 				null;
 			when TK_DIRECTIVE =>
-				--Push_Feed_Layer (...
-				null;
+				if C.Tk.Buf.Equals(LB_XINCLUDE) then
+					Set_Parser_State (C, PS_INCLUDE);
+				else
+					raise Syntax_Error;
+				end if;
 			when TK_EOF =>
 				null;
 			when TK_EOL =>
@@ -65,6 +65,69 @@ ada.text_io.put_line("");
 			when TK_SEMICOLON =>
 				null;
 		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; -- TODO: 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
+	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
+			raise Syntax_Error; -- string literal required
+		end if;
+	end Parse_Include;
+
+	procedure Parse_Include_End (C: in out Compiler) is
+	begin
+		if C.Tk.Id /= TK_SEMICOLON then
+			raise Syntax_Error;
+		end if;
+
+		-- TODO: put the state back to START???
+	end Parse_Include_End;
+
+	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))));
+end loop;
+ada.text_io.put_line("");
+
+		case C.Ps.State is
+			when PS_START => 
+				Parse_Start (C);
+			when PS_INCLUDE =>
+				Parse_Include (C);
+			when others =>
+				raise Syntax_Error; -- TODO: change this...
+		end case;
+
 	end Got_Token;
 
 	procedure Start_Token (C: in out Compiler) is
@@ -208,6 +271,18 @@ end if;
 	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;
+			end if;
 		end loop;
 	end Feed;