added H2.Slim and Slim_Stream.

renamed Stream to Wide_Stream.

cmd/scheme.adb

@@ -1,30 +1,33 @@
 
-with H2.Scheme;
+with H2.Wide;
+with H2.Slim;
 with H2.Pool;
 with Storage;
-with Stream;
+with Slim_Stream;
+with Wide_Stream;
 with Ada.Text_IO;
 with Ada.Unchecked_Deallocation;
 
 procedure scheme is
-	--package S renames H2.Scheme;
+	--package Stream renames Wide_Stream;
-	--package S is new  H2.Scheme (Wide_Character, Wide_String);
+	--package Scheme renames H2.Wide.Scheme;
-	package S renames Stream.S;
 
+	package Stream renames Slim_Stream;
+	package Scheme renames H2.Slim.Scheme;
+	
 	Pool: aliased Storage.Global_Pool;
-	SI: S.Interpreter_Record;
+	SI: Scheme.Interpreter_Record;
 
-	I: S.Object_Pointer;
+	I: Scheme.Object_Pointer;
-	O: S.Object_Pointer;
+	O: Scheme.Object_Pointer;
 
 	--String: aliased S.Object_String := "(car '(1 2 3))";
-	String: aliased constant S.Object_Character_Array := "((lambda (x y) (+ x y))  9  7)";
+	String: aliased constant Scheme.Object_Character_Array := "((lambda (x y) (+ x y))  9  7)";
 	String_Stream: Stream.String_Input_Stream_Record (String'Unchecked_Access);
 	--String_Stream: Stream.String_Input_Stream_Record := (Len => String'Length, Str => String, Pos => 0);
-	
 
 	--File_Name: aliased S.Object_Character_Array := "test.adb";
-	File_Name: aliased constant S.Object_Character_Array := "test.scm";
+	File_Name: aliased constant Scheme.Object_Character_Array := "test.scm";
 	--File_Stream: Stream.File_Stream_Record (File_Name'Unchecked_Access);
 	--File_Stream: Stream.File_Stream_Record := (Name => File_Name'Unchecked_Access);
 	File_Stream: Stream.File_Stream_Record;
@@ -35,33 +38,32 @@ procedure scheme is
 
 begin
 	--h2init;
-	Ada.Text_Io.Put_Line (S.Object_Word'Image(S.Object_Pointer_Bytes));
 
-	S.Open (SI, 2_000_000, Pool'Unchecked_Access);
+	Scheme.Open (SI, 2_000_000, Pool'Unchecked_Access);
-	--S.Open (SI, null);
+	--Scheme.Open (SI, null);
 
 	-- Specify the named stream handler
-	S.Set_Option (SI, (S.Stream_Option, 
+	Scheme.Set_Option (SI, (Scheme.Stream_Option, 
 	                   Stream.Allocate_Stream'Access, 
 	                   Stream.Deallocate_Stream'Access)
 	);
 
-S.Set_Option (SI, (S.Trait_Option, S.No_Optimization));
+Scheme.Set_Option (SI, (Scheme.Trait_Option, Scheme.No_Optimization));
 
 	File_Stream.Name := File_Name'Unchecked_Access;
 	begin
-		S.Set_Input_Stream (SI, File_Stream); -- specify main input stream
+		Scheme.Set_Input_Stream (SI, File_Stream); -- specify main input stream
-		--S.Set_Input_Stream (SI, String_Stream);
+		--Schee.Set_Input_Stream (SI, String_Stream);
 	exception
 		when others =>
 			Ada.Text_IO.Put_Line ("Cannot open Input Stream");
 	end;
-	--S.Set_Output_Stream (SI, Stream); -- specify main output stream.
+	--Scheme.Set_Output_Stream (SI, Stream); -- specify main output stream.
 
 Ada.Text_IO.Put_Line ("-------------------------------------------");
-S.Run_Loop (SI, I);
+Scheme.Run_Loop (SI, I);
-S.Print (SI, I);
+Scheme.Print (SI, I);
-	S.Close (SI);
+	Scheme.Close (SI);
 
 	Ada.Text_IO.Put_Line ("BYE...");
 

cmd/scheme.gpr.in

@@ -15,8 +15,10 @@ project Scheme is
 	for Source_Files use (
 		"storage.ads",
 		"storage.adb",
-		"stream.ads",
+		"slim_stream.ads",
-		"stream.adb",
+		"slim_stream.adb",
+		"wide_stream.ads",
+		"wide_stream.adb",
 		"scheme.adb"
 	);
 	for Object_Dir use "@ADA_OBJDIR@";

cmd/slim_stream.adb

@@ -0,0 +1,125 @@
+with H2.Pool;
+with Ada.Unchecked_Conversion;
+
+package body Slim_Stream is
+
+	use type S.Object_Size;
+
+	------------------------------------------------------------------
+
+	procedure Open (Stream: in out String_Input_Stream_Record) is
+	begin
+Ada.Text_IO.Put_Line ("****** OPEN SLIM STRING STREAM ******");
+		Stream.Pos := 0;
+	end Open;
+
+	procedure Close (Stream: in out String_Input_Stream_Record) is
+	begin
+Ada.Text_IO.Put_Line ("****** CLOSE SLIM STRING STREAM ******");
+		Stream.Pos := Stream.Str'Last;
+	end Close;
+
+	procedure Read (Stream: in out String_Input_Stream_Record;
+	                Data:   out    S.Object_Character_Array;
+	                Last:   out    S.Object_Size) is
+		Avail: S.Object_Size;
+	begin
+		Avail := Stream.Str'Last - Stream.Pos;
+		if Avail <= 0 then
+			-- EOF
+			Last := Data'First - 1;
+		else
+			if Avail > Data'Length then
+				Avail := Data'Length;
+			end if;
+
+			Data(Data'First .. Avail) := Stream.Str(Stream.Pos + 1..Stream.Pos + Avail);
+			Stream.Pos := Stream.Pos + Avail;
+			Last := Data'First + Avail - 1;
+		end if;
+	end Read;
+
+	procedure Write (Stream: in out String_Input_Stream_Record;
+	                 Data:   out    S.Object_Character_Array;
+	                 Last:   out    S.Object_Size) is
+	begin
+		--raise S.Stream_Error;
+		Last := Data'First - 1;
+	end Write;
+
+	------------------------------------------------------------------
+
+	procedure Open (Stream: in out File_Stream_Record) is
+	begin
+Ada.Text_IO.Put_Line (">>>>> OPEN SLIM FILE STREAM <<<<< " & Standard.String(Stream.Name.all));
+		Ada.Text_IO.Open (Stream.Handle, Ada.Text_IO.In_File, Standard.String(Stream.Name.all));
+	end Open;
+
+	procedure Close (Stream: in out File_Stream_Record) is
+	begin
+Ada.Text_IO.Put_Line (">>>>> CLOSE SLIM FILE STREAM <<<<< " & Standard.String(Stream.Name.all));
+		Ada.Text_IO.Close (Stream.Handle);
+	end Close;
+
+	procedure Read (Stream: in out File_Stream_Record;
+	                Data:   out    S.Object_Character_Array;
+	                Last:   out    S.Object_Size) is
+	begin
+		for I in Data'First .. Data'Last loop
+			begin
+				if Ada.Text_IO.End_Of_File (Stream.Handle) then
+					Last := I - 1;
+					return;
+				end if;
+
+				Ada.Text_IO.Get_Immediate (Stream.Handle, Data(I));
+				--Ada.Text_IO.Get (Stream.Handle, Data(I));
+
+			exception
+				when Ada.Text_IO.End_Error =>
+					Last := I - 1;
+					return;
+				-- other exceptions must be just raised to indicate errors
+			end;
+		end loop;
+		Last := Data'Last;
+	end Read;
+
+	procedure Write (Stream: in out File_Stream_Record;
+	                 Data:   out    S.Object_Character_Array;
+	                 Last:   out    S.Object_Size) is
+	begin
+		--raise S.Stream_Error;
+		Last := Data'First - 1;
+	end Write;
+
+	------------------------------------------------------------------
+
+	procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
+	                           Name:   access S.Object_Character_Array;
+	                           Result: out    S.Stream_Pointer) is
+		subtype FSR is File_Stream_Record;
+		type FSP is access all FSR;
+		package P is new H2.Pool (FSR, FSP);
+
+		X: FSP;
+		for X'Address use Result'Address;
+		pragma Import (Ada, X);
+	begin
+		X := P.Allocate (S.Get_Storage_Pool(Interp));
+		X.Name := S.Constant_Object_Character_Array_Pointer(Name);
+	end Allocate_Stream;
+
+	procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
+	                             Source: in out S.Stream_Pointer) is
+		subtype FSR is File_Stream_Record;
+		type FSP is access all FSR;
+		package P is new H2.Pool (FSR, FSP);
+
+		X: FSP;
+		for X'Address use Source'Address;
+		pragma Import (Ada, X);
+	begin
+		P.Deallocate (X, S.Get_Storage_Pool(Interp));
+	end Deallocate_Stream;
+end Slim_Stream;

cmd/slim_stream.ads

@@ -0,0 +1,55 @@
+with H2.Slim;
+with Ada.Text_IO;
+
+package Slim_Stream is
+
+	package S renames H2.Slim.Scheme;
+
+	------------------------------------------------------------
+	--type Object_Character_Array_Pointer is access all S.Object_Character_Array;
+	type Object_Character_Array_Pointer is access constant S.Object_Character_Array;
+	type String_Input_Stream_Record(Str: Object_Character_Array_Pointer) is new S.Stream_Record with record
+		Pos: S.Object_Size := 0;	
+	end record;
+
+	procedure Open (Stream: in out String_Input_Stream_Record);
+	procedure Close (Stream: in out String_Input_Stream_Record);
+	procedure Read (Stream: in out String_Input_Stream_Record;
+	                Data:   out    S.Object_Character_Array;
+	                Last:   out    S.Object_Size);
+	procedure Write (Stream: in out String_Input_Stream_Record;
+	                 Data:   out    S.Object_Character_Array;
+	                 Last:   out    S.Object_Size);
+
+	------------------------------------------------------------
+
+	type File_Stream_Record is new S.Stream_Record with record
+		Name:   S.Constant_Object_Character_Array_Pointer;
+		Handle: Ada.Text_IO.File_Type;
+	end record;
+
+	procedure Open (Stream: in out File_Stream_Record);
+	procedure Close (Stream: in out File_Stream_Record);
+	procedure Read (Stream: in out File_Stream_Record;
+	                Data:   out    S.Object_Character_Array;
+	                Last:   out    S.Object_Size);
+	procedure Write (Stream: in out File_Stream_Record;
+	                 Data:   out    S.Object_Character_Array;
+	                 Last:   out    S.Object_Size);
+
+	------------------------------------------------------------
+	procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
+	                           Name:   access S.Object_Character_Array;
+	                           Result: out    S.Stream_Pointer);
+
+	procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
+	                             Source: in out S.Stream_Pointer);
+
+--private
+--	type File_Stream_Record is new S.Stream_Record with record
+--		Name:   S.Constant_Object_Character_Array_Pointer;
+--		Handle: Ada.Text_IO.File_Type;
+--	end record;
+
+end Slim_Stream;
+

cmd/wide_stream.adb

@@ -3,20 +3,22 @@ with Ada.Unchecked_Conversion;
 
 with Ada.Text_IO; -- for debugging
 
-package body Stream is
+package body Wide_Stream is
+
+	package Utf8 renames H2.Wide.Utf8;
+	use type S.Object_Size;
 
 	------------------------------------------------------------------
-	use type S.Object_Size;
 
 	procedure Open (Stream: in out String_Input_Stream_Record) is
 	begin
-Ada.Text_IO.Put_Line ("****** OPEN STRING STREAM ******");
+Ada.Text_IO.Put_Line ("****** OPEN WIDE STRING STREAM ******");
 		Stream.Pos := 0;
 	end Open;
 
 	procedure Close (Stream: in out String_Input_Stream_Record) is
 	begin
-Ada.Text_IO.Put_Line ("****** CLOSE STRING STREAM ******");
+Ada.Text_IO.Put_Line ("****** CLOSE WIDE STRING STREAM ******");
 		Stream.Pos := Stream.Str'Last;
 	end Close;
 
@@ -52,7 +54,7 @@ Ada.Text_IO.Put_Line ("****** CLOSE STRING STREAM ******");
 
 	procedure Open (Stream: in out File_Stream_Record) is
 	begin
-Ada.Text_IO.Put_Line (">>>>> OPEN File STREAM <<<<< " & Standard.String(Utf8.Unicode_To_Utf8(Utf8.Unicode_String(Stream.Name.all))));
+Ada.Text_IO.Put_Line (">>>>> OPEN WIDE FILE STREAM <<<<< " & Standard.String(Utf8.Unicode_To_Utf8(Utf8.Unicode_String(Stream.Name.all))));
 		--Ada.Wide_Text_IO.Open (Stream.Handle, Ada.Wide_Text_IO.In_File, Ada.Characters.Conversions.To_String(Standard.Wide_String(Stream.Name.all)));
 		Ada.Wide_Text_IO.Open (Stream.Handle, Ada.Wide_Text_IO.In_File, Standard.String(Utf8.Unicode_To_Utf8(Utf8.Unicode_String(Stream.Name.all))));
 	end Open;
@@ -62,7 +64,7 @@ Ada.Text_IO.Put_Line (">>>>> OPEN File STREAM <<<<< " & Standard.String(Utf8.Uni
 		function To_Wide_String is new Ada.Unchecked_Conversion (S.Object_Character_Array, Wide_String);
 	begin
 --Ada.Wide_Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<< " & Standard.Wide_String(Stream.Name.all));
-Ada.Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<< " & Standard.String(Utf8.Unicode_To_Utf8(Utf8.Unicode_String(Stream.Name.all))));
+Ada.Text_IO.Put_Line (">>>>> CLOSE WIDE FILE STREAM <<<<< " & Standard.String(Utf8.Unicode_To_Utf8(Utf8.Unicode_String(Stream.Name.all))));
 		Ada.Wide_Text_IO.Close (Stream.Handle);
 	end Close;
 
@@ -100,7 +102,7 @@ Ada.Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<< " & Standard.String(Utf8.Un
 	procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
 	                           Name:   access S.Object_Character_Array;
 	                           Result: out    S.Stream_Pointer) is
-		subtype FSR is Stream.File_Stream_Record;
+		subtype FSR is File_Stream_Record;
 		type FSP is access all FSR;
 		package P is new H2.Pool (FSR, FSP);
 
@@ -114,7 +116,7 @@ Ada.Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<< " & Standard.String(Utf8.Un
 
 	procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
 	                             Source: in out S.Stream_Pointer) is
-		subtype FSR is Stream.File_Stream_Record;
+		subtype FSR is File_Stream_Record;
 		type FSP is access all FSR;
 		package P is new H2.Pool (FSR, FSP);
 
@@ -124,4 +126,4 @@ Ada.Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<< " & Standard.String(Utf8.Un
 	begin
 		P.Deallocate (X, S.Get_Storage_Pool(Interp));
 	end Deallocate_Stream;
-end Stream;
+end Wide_Stream;

cmd/wide_stream.ads

@@ -1,10 +1,9 @@
 with H2.Wide;
 with Ada.Wide_Text_IO;
 
-package Stream is
+package Wide_Stream is
 
 	package S renames H2.Wide.Scheme;
-	package Utf8 renames H2.Wide.Utf8;
 
 	------------------------------------------------------------
 	--type Object_Character_Array_Pointer is access all S.Object_Character_Array;
@@ -52,5 +51,5 @@ package Stream is
 --		Handle: Ada.Wide_Text_IO.File_Type;
 --	end record;
 
-end Stream;
+end Wide_Stream;
 

lib/h2-scheme-bigint.adb

@@ -287,8 +287,8 @@ package body Bigint is
 	begin
 		if Is_Integer(A) and then Is_Integer(B) then
 			declare
-				pragma Unsuppress (Range_Check);
+				--pragma Unsuppress (Range_Check);
-				pragma Unsuppress (Overflow_Check);
+				--pragma Unsuppress (Overflow_Check);
 
 				G: Object_Integer := Pointer_To_Integer(A);
 				H: Object_Integer := Pointer_To_Integer(B);

lib/h2-scheme-execute.adb

@@ -570,7 +570,7 @@ procedure Execute (Interp: in out Interpreter_Record) is
 					--return;
 					raise IO_Error;
 			end;
-			if Interp.Input.Last < Interp.Input.Data'First then	
+			if Interp.Input.Last < Interp.Input.Data'First then
 				-- The callee must read 0 bytes on EOF 
 				Interp.Input.Flags := Interp.Input.Flags and IO_End_Reached;
 				Interp.Input.Iochar := (End_Character, Object_Character'First);

lib/h2-scheme.adb

@@ -1236,7 +1236,6 @@ end if;
 	end Make_Cons;
 
 	function Is_Cons (Source: in Object_Pointer) return Standard.Boolean is
-		pragma Inline (Is_Cons);
 	begin
 		return Is_Normal_Pointer(Source) and then 
 		       Source.Tag = Cons_Object;
@@ -1439,7 +1438,6 @@ end if;
 	end Make_Bigint;
 
 	function Is_Bigint (Source: in Object_Pointer) return Standard.Boolean is
-		pragma Inline (Is_Bigint);
 	begin
 		return Is_Normal_Pointer(Source) and then 
 		       Source.Tag = Bigint_Object;

lib/h2-scheme.ads

@@ -335,6 +335,8 @@ package H2.Scheme is
 	function Is_Cons (Source: in Object_Pointer) return Standard.Boolean;
 	function Is_Bigint (Source: in Object_Pointer) return Standard.Boolean;
 
+	pragma Inline (Is_Cons);
+	pragma Inline (Is_Bigint);
 	-- -----------------------------------------------------------------------------
 
 

lib/h2-slim.ads

@@ -0,0 +1,7 @@
+with H2.Scheme;
+
+package H2.Slim is
+
+	package Scheme is new H2.Scheme (Standard.Character);
+
+end H2.Slim;

lib/lib.gpr.in

@@ -19,6 +19,7 @@ project Lib is
 		"h2-scheme-execute-apply.adb",
 		"h2-scheme-execute-evaluate.adb",
 		"h2-scheme-token.adb",
+		"h2-slim.ads",
 		"h2-utf8.adb",
 		"h2-utf8.ads",
 		"h2-wide.ads"
@@ -28,6 +29,7 @@ project Lib is
 		"h2.ascii",
 		"h2.pool",
 		"h2.scheme",
+		"h2.slim",
 		"h2.utf8",
 		"h2.wide"
 	);