Is_Code in H3.CC.

Use Wide_Character'First instead of Wide_Character'Val(0) 
Removed the terminator parameter in the H3.Strings

lib2/Makefile

@@ -1,3 +1,14 @@
-all:
+OPTS := -gnata -gnatW8 -gnatwa -gnatya -gnatyb -gnatyk -gnatyn -gnatyp ##-gnatyt
-	gnat make -gnata -gnatW8 hello && valgrind ./hello
+all: hello hello2 hello3
-	gnat make -gnata -gnatW8 hello2 && valgrind ./hello2
+
+hello: hello.adb
+	gnat make $(OPTS) hello && valgrind ./hello
+
+hello2: hello2.adb
+	gnat make $(OPTS) hello2 && valgrind ./hello2
+
+hello3: hello3.adb
+	gnat make $(OPTS) hello3 && valgrind ./hello3
+
+clean:
+	rm -rf *.o *.ali hello hello2 hello3

lib2/h3-arrays.adb

@@ -52,12 +52,12 @@ package body H3.Arrays is
 		return P;
 	end Get_Slot_Pointer;
 
-	function Is_Shared(Obj: in Elastic_Array) return Standard.Boolean is
+	function Is_Shared(Obj: in Elastic_Array) return Boolean is
 	begin
 		return Obj.Buffer /= Empty_Buffer'Access and then Obj.Buffer.Refs > 1;
 	end Is_Shared;
 
-	procedure Ref_Buffer (Buf: in out Buffer_Pointer) is
+	procedure Ref_Buffer (Buf: in Buffer_Pointer) is
 	begin
 		if Buf /= Empty_Buffer'Access then
 			Buf.Refs := Buf.Refs + 1;
@@ -88,14 +88,14 @@ package body H3.Arrays is
 		return Tmp;
 	end New_Buffer_Container;
 
-	-- prepare the buffer for writing 
+	-- prepare the buffer for writing
 	procedure Prepare_Buffer (Obj: in out Elastic_Array) is
 		Tmp: Elastic_Array;
 	begin
 		if Obj.Buffer /= Empty_Buffer'Access then
 			if Is_Shared(Obj) then
 				-- The code like this doesn't work correctly in terms of finalization.
-				-- The buffer pointer held inside a finalization controlled record must be 
+				-- The buffer pointer held inside a finalization controlled record must be
 				-- manipluated through the record itself. otherwise, the Adjust and Finalize
 				-- calls goes incompatible with the reference counting implementation.
 				-- It is because finalization is set on the record rather than the buffer pointer.
@@ -114,7 +114,7 @@ package body H3.Arrays is
 		end if;
 	end Prepare_Buffer;
 
-	-- prepare the buffer for writing 
+	-- prepare the buffer for writing
 	procedure Prepare_Buffer (Obj: in out Elastic_Array; Req_Hard_Capa: in System_Size; Shift_Pos: in System_Size := 0; Shift_Size: in System_Size := 0; Shift_Dir: in Direction := DIRECTION_FORWARD) is
 		Tmp: Elastic_Array;
 		First, Last: System_Size;
@@ -158,11 +158,11 @@ package body H3.Arrays is
 		end if;
 	<<COPY_OVER_WITH_SHIFT>>
 		-- it is an internal function. perform no sanity check.
-		-- if Shift_Pos or Shift_Size is beyond the allocated capacity, 
+		-- if Shift_Pos or Shift_Size is beyond the allocated capacity,
 		-- it will end up in an exception.
 		if Shift_Dir = DIRECTION_BACKWARD then
 			declare
-				Mid: System_Size := Shift_Pos - Shift_Size;
+				Mid: constant System_Size := Shift_Pos - Shift_Size;
 			begin
 				Obj.Buffer.Slot(First .. Mid) := Tmp.Buffer.Slot(First .. Mid);
 				Obj.Buffer.Slot(Mid + 1 .. Last - Shift_Size + Terminator_Length) := Tmp.Buffer.Slot(Shift_Pos + 1 .. Last + Terminator_Length);
@@ -183,7 +183,7 @@ package body H3.Arrays is
 	end Clear;
 
 	procedure Purge (Obj: in out Elastic_Array) is
-	begin 
+	begin
 		Unref_Buffer (Obj.Buffer);
 		Obj.Buffer := Empty_Buffer'Access;
 	end Purge;
@@ -195,7 +195,7 @@ package body H3.Arrays is
 
 	procedure Insert (Obj: in out Elastic_Array; Pos: in System_Index; V: in Item_Type; Repeat: in System_Size := 1) is
 		Act_Pos: System_Index := Pos;
-		Act_Inc: System_Size := Repeat;
+		Act_Inc: constant System_Size := Repeat;
 	begin
 		if Act_Pos > Obj.Buffer.Last then
 			Act_Pos := Obj.Buffer.Last + 1;
@@ -295,7 +295,7 @@ package body H3.Arrays is
 		end if;
 	end Delete;
 
-	function Find (Obj: in Elastic_Array; V: In Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size is
+	function Find (Obj: in Elastic_Array; V: in Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size is
 		Act_Start_Pos: System_Index := Start_Pos;
 	begin
 		if Find_Dir = DIRECTION_FORWARD then
@@ -321,7 +321,7 @@ package body H3.Arrays is
 		return System_Size'First;
 	end Find;
 
-	function Find (Obj: in Elastic_Array; V: In Item_Array; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size is
+	function Find (Obj: in Elastic_Array; V: in Item_Array; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size is
 		End_Pos: System_Size;
 	begin
 		if Get_Length(Obj) > 0 and then V'Length > 0 and then V'Length <= Get_Length(Obj) then
@@ -347,12 +347,12 @@ package body H3.Arrays is
 		return System_Size'First;
 	end Find;
 
-	function "=" (Obj: in Elastic_Array; Obj2: in Elastic_Array) return Standard.Boolean is
+	function "=" (Obj: in Elastic_Array; Obj2: in Elastic_Array) return Boolean is
 	begin
 		return Obj.Buffer = Obj2.Buffer or else Obj.Buffer.Slot(Get_First_Index(Obj) .. Get_Last_Index(Obj)) = Obj2.Buffer.Slot(Get_First_Index(Obj2) .. Get_Last_Index(Obj2));
 	end "=";
 
-	function "=" (Obj: in Elastic_Array; Obj2: in Item_Array) return Standard.Boolean is
+	function "=" (Obj: in Elastic_Array; Obj2: in Item_Array) return Boolean is
 	begin
 		return Obj.Buffer.Slot(Get_First_Index(Obj) .. Get_Last_Index(Obj)) = Obj2;
 	end "=";

lib2/h3-arrays.ads

@@ -13,6 +13,7 @@ package H3.Arrays is
 	type Direction is (DIRECTION_BACKWARD, DIRECTION_FORWARD);
 
 	type Elastic_Array is tagged private;
+	--type Item_Array is array(System_Index range <>) of aliased Item_Type;
 	type Item_Array is array(System_Index range <>) of Item_Type;
 	--type Item_Array_Pointer is access all Item_Array;
 
@@ -42,7 +43,7 @@ package H3.Arrays is
 	function Get_Slot_Pointer (Obj: in Elastic_Array) return Thin_Item_Array_Pointer;
 	pragma Inline (Get_Slot_Pointer);
 
-	function Is_Shared(Obj: in Elastic_Array) return Standard.Boolean;
+	function Is_Shared(Obj: in Elastic_Array) return Boolean;
 	pragma Inline (Is_Shared);
 
 	procedure Clear (Obj: in out Elastic_Array);
@@ -56,17 +57,17 @@ package H3.Arrays is
 
 	procedure Prepend (Obj: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1);
 	procedure Prepend (Obj: in out Elastic_Array; V: in Item_Array);
-	
+
 	procedure Replace (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Type; Repeat: in System_Size := 1);
 	procedure Replace (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Array);
 
 	procedure Delete (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size);
 
-	function Find (Obj: in Elastic_Array; V: In Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size;
+	function Find (Obj: in Elastic_Array; V: in Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size;
-	function Find (Obj: in Elastic_Array; V: In Item_Array; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size;
+	function Find (Obj: in Elastic_Array; V: in Item_Array; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size;
 
-	function "=" (Obj: in Elastic_Array; Obj2: in Elastic_Array) return Standard.Boolean;
+	function "=" (Obj: in Elastic_Array; Obj2: in Elastic_Array) return Boolean;
-	function "=" (Obj: in Elastic_Array; Obj2: in Item_Array) return Standard.Boolean;
+	function "=" (Obj: in Elastic_Array; Obj2: in Item_Array) return Boolean;
 
 private
 	type Buffer_Record(Capa: System_Size) is limited record

lib2/h3-cc.adb

@@ -8,70 +8,70 @@ package body H3.CC is
 	SP: constant Item_Type := Item_Type'Val(32);
 	HT: constant Item_Type := Item_Type'Val(9);
 
-	function Is_Alpha (V: in Item_Type) return Standard.Boolean is
+	function Is_Alpha (V: in Item_Type) return Boolean is
 	begin
 		return UC.Is_UTF_32_Letter(Item_Type'Pos(V));
 	end Is_Alpha;
 
-	function Is_Alnum (V: in Item_Type) return Standard.Boolean is
+	function Is_Alnum (V: in Item_Type) return Boolean is
 	begin
 		return UC.Is_UTF_32_Letter(Item_Type'Pos(V)) or else
 		       UC.Is_UTF_32_Digit(Item_Type'Pos(V));
 	end Is_Alnum;
 
-	function Is_Blank (V: in Item_Type) return Standard.Boolean is
+	function Is_Blank (V: in Item_Type) return Boolean is
 	begin
 		return V = SP or else V = HT;
 	end Is_Blank;
 
-	function Is_Cntrl (V: in Item_Type) return Standard.Boolean is
+	function Is_Cntrl (V: in Item_Type) return Boolean is
 	begin
 		return UC.Get_Category(Item_Type'Pos(V)) = UC.Cc;
 	end Is_Cntrl;
 
-	function Is_Digit (V: in Item_Type) return Standard.Boolean is
+	function Is_Digit (V: in Item_Type) return Boolean is
 	begin
 		return UC.Is_UTF_32_Digit(Item_Type'Pos(V));
 	end Is_Digit;
 
-	function Is_Graph (V: in Item_Type) return Standard.Boolean is
+	function Is_Graph (V: in Item_Type) return Boolean is
 	begin
 		return Is_Print(V) and then V /= SP;
 	end Is_Graph;
 
-	function Is_Lower (V: in Item_Type) return Standard.Boolean is
+	function Is_Lower (V: in Item_Type) return Boolean is
 	begin
 		return UC.Get_Category(Item_Type'Pos(V)) = UC.Ll;
 	end Is_Lower;
 
-	function Is_Print (V: in Item_Type) return Standard.Boolean is
+	function Is_Print (V: in Item_Type) return Boolean is
 	begin
 		return not UC.IS_UTF_32_Non_Graphic(Item_Type'Pos(V));
 	end Is_Print;
 
-	function Is_Punct (V: in Item_Type) return Standard.Boolean is
+	function Is_Punct (V: in Item_Type) return Boolean is
 	begin
 		--return UC.Is_UTF_32_Punctuation(Item_Type'Pos(V));
 		return Is_Print(V) and then not Is_Space(V) and then not Is_Alnum(V);
 	end Is_Punct;
 
-	function Is_Space (V: in Item_Type) return Standard.Boolean is
+	function Is_Space (V: in Item_Type) return Boolean is
 	begin
 		return UC.Is_UTF_32_Space(Item_Type'Pos(V)) or else
-		       UC.Is_UTF_32_Line_Terminator(Item_Type'Pos(V)) or else 
+		       UC.Is_UTF_32_Line_Terminator(Item_Type'Pos(V)) or else
 		       V = HT;
 	end Is_Space;
 
-	function Is_Upper (V: in Item_Type) return Standard.Boolean is
+	function Is_Upper (V: in Item_Type) return Boolean is
 	begin
 		return UC.Get_Category(Item_Type'Pos(V)) = UC.Lu;
 	end Is_Upper;
 
-	function Is_Xdigit (V: in Item_Type) return Standard.Boolean is
+	function Is_Xdigit (V: in Item_Type) return Boolean is
 	begin
 		return UC.Is_UTF_32_Digit(Item_Type'Pos(V)) or else
-		       Item_Type'Pos(V) in Standard.Character'Pos('A') .. Standard.Character'Pos('F') or else
+		       Item_Type'Pos(V) in System_Character'Pos('A') .. System_Character'Pos('F') or else
-		       Item_Type'Pos(V) in Standard.Character'Pos('a') .. Standard.Character'Pos('f');
+		       Item_Type'Pos(V) in System_Character'Pos('a') .. System_Character'Pos('f');
 	end Is_Xdigit;
 
 	function To_Lower (V: in Item_Type) return Item_Type is
@@ -84,7 +84,7 @@ package body H3.CC is
 		return Item_Type'Val(UC.UTF_32_To_Upper_Case(Item_Type'Pos(V)));
 	end To_Upper;
 
-	function Is_Class (V: in Item_Type; Cls: in Class) return Standard.Boolean is
+	function Is_Class (V: in Item_Type; Cls: in Class) return Boolean is
 	begin
 		case Cls is
 			when ALPHA => return Is_Alpha(V);
@@ -101,4 +101,11 @@ package body H3.CC is
 			when XDIGIT => return Is_Xdigit(V);
 		end case;
 	end Is_Class;
+
+	function Is_Code (V: in Item_Type; Code: in Item_Code) return Boolean is
+	begin
+		-- a clumsy way to work around strong type checking
+		-- with unknown Item_Type at the generic level?
+		return Item_Type'Pos(V) = Code;
+	end Is_Code;
 end H3.CC;

lib2/h3-cc.ads

@@ -1,26 +1,38 @@
-generic 
+generic
 	type Item_Type is (<>); -- any discrete type
 package H3.CC is
 	-- <ctype.h>-like character classification package
 	-- unicode-based. no system locale honored.
 
+	subtype Item_Code is H3.Natural;
+
+	Colon: constant Item_Code := System_Character'Pos(':');
+	SemicoloN: constant Item_Code := System_Character'Pos(';');
+	Tilde: constant Item_Code := System_Character'Pos('~');
+	Underline: constant Item_Code := System_Character'Pos('_');
+	Equal: constant Item_Code := System_Character'Pos('=');
+	L_Arrow: constant Item_Code := System_Character'Pos('<');
+	R_Arrow: constant Item_Code := System_Character'Pos('>');
+
 	type Class is (ALPHA, ALNUM, BLANK, CNTRL, DIGIT, GRAPH, LOWER, PRINT, PUNCT, SPACE, UPPER, XDIGIT);
-	function Is_Class (V: in Item_Type; Cls: in Class) return Standard.Boolean;	
+	function Is_Class (V: in Item_Type; Cls: in Class) return Boolean;
 
-	function Is_Alpha (V: in Item_Type) return Standard.Boolean;
+	function Is_Alpha (V: in Item_Type) return Boolean;
-	function Is_Alnum (V: in Item_Type) return Standard.Boolean;
+	function Is_Alnum (V: in Item_Type) return Boolean;
-	function Is_Blank (V: in Item_Type) return Standard.Boolean;
+	function Is_Blank (V: in Item_Type) return Boolean;
-	function Is_Cntrl (V: in Item_Type) return Standard.Boolean;
+	function Is_Cntrl (V: in Item_Type) return Boolean;
-	function Is_Digit (V: in Item_Type) return Standard.Boolean;
+	function Is_Digit (V: in Item_Type) return Boolean;
-	function Is_Graph (V: in Item_Type) return Standard.Boolean;
+	function Is_Graph (V: in Item_Type) return Boolean;
-	function Is_Print (V: in Item_Type) return Standard.Boolean;
+	function Is_Print (V: in Item_Type) return Boolean;
-	function Is_Punct (V: in Item_Type) return Standard.Boolean;
+	function Is_Punct (V: in Item_Type) return Boolean;
-	function Is_Space (V: in Item_Type) return Standard.Boolean;
+	function Is_Space (V: in Item_Type) return Boolean;
-	function Is_Xdigit (V: in Item_Type) return Standard.Boolean;
+	function Is_Xdigit (V: in Item_Type) return Boolean;
 
-	function Is_Lower (V: in Item_Type) return Standard.Boolean;
+	function Is_Lower (V: in Item_Type) return Boolean;
-	function Is_Upper (V: in Item_Type) return Standard.Boolean;
+	function Is_Upper (V: in Item_Type) return Boolean;
 
 	function To_Lower (V: in Item_Type) return Item_Type;
 	function To_Upper (V: in Item_Type) return Item_Type;
+
+	function Is_Code (V: in Item_Type; Code: in Item_Code) return Boolean;
 end H3.CC;

lib2/h3-mm.adb

@@ -24,7 +24,7 @@ package body H3.MM is
 		end if;
 	end Get_Item_Pointer;
 
-	function Is_Shared (R: in Ref_Counted) return Standard.Boolean is
+	function Is_Shared (R: in Ref_Counted) return Boolean is
 	begin
 		--return R.Data /= null and then not System.Atomic_Counters.Is_One(R.Data.Refs);
 		return R.Data /= null and then R.Data.Refs > 1;

lib2/h3-mm.ads

@@ -24,7 +24,7 @@ package H3.MM is
 	function Get_Item_Pointer (R: in Ref_Counted) return Item_Pointer;
 	pragma Inline(Get_Item_Pointer);
 
-	function Is_Shared (R: in Ref_Counted) return Standard.Boolean;
+	function Is_Shared (R: in Ref_Counted) return Boolean;
 	pragma Inline(Is_Shared);
 
 	overriding procedure Initialize (R: in out Ref_Counted);

lib2/h3-strings.ads

@@ -2,10 +2,9 @@ with H3.Arrays;
 
 generic
 	type Item_Type is (<>);
-	G_Terminator_Value: Item_Type;
 package H3.Strings is
 
-	package P is new H3.Arrays(Item_Type, 1, G_Terminator_Value);
+	package P is new H3.Arrays(Item_Type, 1, Item_Type'First);
 
 	Terminator_Length: System_Zero_Or_One renames P.Terminator_Length;
 	Terminator_Value: Item_Type renames P.Terminator_Value;

lib2/h3.ads

@@ -1,9 +1,13 @@
 with System;
 with System.Storage_Pools;
-with Ada.Finalization;
 
 package H3 is
-	--pragma Preelaborate (H2);
+	--pragma Preelaborate (H3);
+	subtype Boolean is Standard.Boolean;
+	subtype Natural is Standard.Natural;
+
+	subtype System_Character is Standard.Wide_Character;
+
 	System_Byte_Bits: constant := System.Storage_Unit;
 	System_Word_Bits: constant := System.Word_Size;
 	System_Word_Bytes: constant := System_Word_Bits / System_Byte_Bits;

lib2/hello.adb

@@ -15,7 +15,7 @@ with Ada.Assertions;
 use type H3.System_Size;
 
 procedure hello is
-	package S is new H3.Strings(Standard.Wide_Character, Wide_Character'Val(0));
+	package S is new H3.Strings(Standard.Wide_Character);
 	
 
 	--type Global_Pool is new System.Storage_Pools.Root_Storage_Pool with null record;

lib2/hello2.adb

@@ -11,8 +11,8 @@ with System;
 use type H3.System_Size;
 
 procedure hello2 is
-	package A is new H3.Arrays(Standard.Wide_Character, 1, Wide_Character'Val(0));
+	package A is new H3.Arrays(Standard.Wide_Character, 1, Wide_Character'First);
-	package S is new H3.Strings(Standard.Wide_Character, Wide_Character'Val(0));
+	package S is new H3.Strings(Standard.Wide_Character);
 	package CC is new H3.CC(Standard.Wide_Character);
 	package C renames Interfaces.C;