some ada experiments

lib2/h3-limited_pool.ads

@@ -1,8 +1,9 @@
 --------------------------------------------------------------------
 -- Instantantiate this package before using. To allocate integers,
 --
+--   P1: aliased System.Pool_Global.Unbounded_No_Reclaim_Pool;
 --   type Integer_Pointer is access Integer_Pointer;
---   package Integer_Pool is new Pool(Integer, Integer_Pointer, Storage_Pool'Unchecked_Access);
+--   package Integer_Pool is new Pool(Integer, Integer_Pointer, P1'Unchecked_Access);
 --   x: Integer_Pointer;
 --
 --   x := Integer_Pool.Allocate(10);

lib2/h3-strings.adb

@@ -187,9 +187,32 @@ package body H3.Strings is
 
 	procedure Delete (Str: in out Elastic_String; Pos: in System_Index; Length: in System_Size) is
 	begin
-		null;
+		if Pos <= Str.Buffer.Last then
+			Prepare_Buffer (Str);
+		else
+			raise Standard.Constraint_Error;
+		end if;
 	end Delete;
 
+	procedure Insert (Str: in out Elastic_String; Pos: in System_Index; Char: in Character_Type) is
+	begin
+		if Pos <= Str.Buffer.Last then
+			Prepare_Buffer (Str, H3.Align(Get_Length(Str) + V'Length + 1, BUFFER_ALIGN));
+			Str.Buffer.Slot(Pos) := New_Char;
+		end if;
+	end Insert;
+
+	procedure Replace (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type) is
+	begin
+		if Pos <= Str.Buffer.Last then
+			Prepare_Buffer (Str);
+			Str.Buffer.Slot(Pos) := New_Char;
+		else
+		--	raise Index_Error;
+			raise Standard.Constraint_Error;
+		end if;
+	end Replace;
+
 	-- ---------------------------------------------------------------------
 	-- Controlled Management
 	-- ---------------------------------------------------------------------

lib2/h3-strings.ads

@@ -21,11 +21,11 @@ package H3.Strings is
 	function Get_Length (Str: in Elastic_String) return System_Size;
 	pragma Inline (Get_Length);
 
-	-- the return type is System_Size for consistency with Get_FIrst_Index.
+	-- the return type is System_Size for consistency with Get_Last_Index.
 	function Get_First_Index (Str: in Elastic_String) return System_Size;
 	pragma Inline (Get_First_Index);
 
-	-- the return type is System_Size because the Last index can be -1 off the System_Index'First.
+	-- the return type is System_Size because the Last index is -1 off the System_Index'First for an empty string
 	function Get_Last_Index (Str: in Elastic_String) return System_Size;
 	pragma Inline (Get_Last_index);
 
@@ -45,6 +45,8 @@ package H3.Strings is
 	procedure Append (Str: in out Elastic_String; V: in Character_Array);
 	procedure Append (Str: in out Elastic_String; V: in Character_Type);
 
+	procedure Replace (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type);
+
 private
 	type Buffer_Record(Capa: System_Size) is limited record
 		Refs: System_Size := 1;

lib2/h3.adb

@@ -6,38 +6,4 @@ package body H3 is
 		return ((X + Y - 1) / Y) * Y;
 	end Align;
 
-
-
---	procedure Set (R: in out Ref; Data: in Ref_Counted_Pointer) is
---	begin
---		if R.Data /= null then
---			Finalize (R);
---		end if;
---
---		R.Data := Data;
---		Adjust (R);
---	end Set;
-
---	function Get (R: in Ref) return Ref_Counted_Pointer is
---	begin
---		return R.Data;
---	end Get;
-
---	procedure Adjust (R: in out Ref) is
---	begin
---		if R.Data /= null then
---			R.Data.Ref_Count := R.Data.Ref_Count + 1;
---		end if;
---	end Adjust;
-
---	procedure Finalize (R: in out Ref) is
---	begin
---		if R.Data /= null then
---			R.Data.Ref_Count  := R.Data.Ref_Count - 1;
---			if R.Data.Ref_Count = 0 then
---				null;
---			end if;
---			R.Data := null;
---		end if;
---	end Finalize;
 end H3;

lib2/h3.ads

@@ -12,6 +12,7 @@ package H3 is
 	for System_Byte'Size use System_Byte_Bits;
 
 	type System_Word is mod 2 ** System_Word_Bits;
+	--type System_Word is range 0 .. (2 ** System_Word_Bits) - 1;
 	for System_Word'Size use System_Word_Bits;
 
 	type System_Signed_Word is range -(2 ** (System_Word_Bits - 1)) ..
@@ -22,7 +23,7 @@ package H3 is
 	subtype System_Size is System_Word range 0 .. (2 ** System_Word_Bits) - 1;
 
 	--subtype System_Index is System_Size range 0 .. (System_Size'Last - 1);
-	subtype System_Index is System_Size range 1 .. System_Size'Last;
+	subtype System_Index is System_Size range (System_Size'First + 1) .. System_Size'Last;
 
 	type Storage_Pool_Pointer is access all System.Storage_Pools.Root_Storage_Pool'Class;
 
@@ -34,4 +35,5 @@ package H3 is
 	function Align (X: in System_Size; Y: in System_Size) return System_Size;
 	pragma Inline(Align);
 
+	Index_Error: exception;
 end H3;

lib2/hello.adb

@@ -11,6 +11,7 @@ with Ada.Text_IO;
 with Ada.Wide_Text_IO;
 with Ada.Assertions;
 
+use type H3.System_Size;
 procedure hello is
 	package S is new H3.Strings(Wide_Character, Wide_Character'Val(0));
 
@@ -47,7 +48,23 @@ procedure hello is
 	y: L_Pointer;
 
 	SS: S.Elastic_String;
+
 begin
+	declare
+		TTT: H3.System_Size := H3.System_Size'Last;
+		--NNN: Standard.Natural := Standard.Natural'Last;
+	begin
+		TTT := TTT + 1;
+		ada.text_io.put_line ("-----------------");
+		ada.text_io.put_line (TTT'Img);
+		ada.text_io.put_line ("-----------------");
+
+		--NNN := NNN + 1;
+		--ada.text_io.put_line ("-----------------");
+		--ada.text_io.put_line (NNN'Img);
+		--ada.text_io.put_line ("-----------------");
+	end;
+
 	x := TP.Allocate((A => 900, B => 800, C => 1.1));
 	i := IP.Allocate(200);
 
@@ -128,6 +145,10 @@ begin
 				Ada.Wide_Text_IO.Put (arr(i));	
 			end loop;
 			Ada.Wide_Text_IO.Put_Line ("]");	
+
+			Ada.Wide_Text_IO.Put ("PRINTING AGAIN [");	
+			Ada.Wide_Text_IO.Put (Standard.Wide_String(arr));
+			Ada.Wide_Text_IO.Put_Line ("]");	
 		end;
 		
 		-- unsafe way to access the internal buffer.
@@ -139,6 +160,8 @@ begin
 		S.Append (Str2, "EXTRA");
 		S.Append (Str2, " THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR H3");
 	
+		S.Replace (Str2, 1, 'Q');
+		--S.Replace (Str2, 10000, 'Q'); -- constraint error
 
 		declare
 			arr: constant S.Thin_Character_Array_Pointer := S.Get_Slot_Pointer(Str);
@@ -154,8 +177,8 @@ begin
 			last := S.Get_Last_Index(Str);
 			Ada.Text_IO.Put_Line ("STR length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
 			
-			Ada.Wide_Text_IO.Put ("[");	
+			Ada.Wide_Text_IO.Put ("STR(By-Pointer) [");	
-			for i in S.Get_First_Index(Str) .. S.Get_Last_Index(Str) + 1 loop
+			for i in S.Get_First_Index(Str) .. S.Get_Last_Index(Str) + 1 loop -- this must loop to the terminating null.
 				Ada.Wide_Text_IO.Put (arr.all(i));
 			end loop;
 			Ada.Wide_Text_IO.Put_Line ("]");	
@@ -166,7 +189,7 @@ begin
 			last := S.Get_Last_Index(Str2);
 			Ada.Text_IO.Put_Line ("STR2 length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
 		
-			Ada.Wide_Text_IO.Put ("[");	
+			Ada.Wide_Text_IO.Put ("Str2(By-Pointer) [");	 -- this must loop to the terminating null.
 			for i in S.Get_First_Index(Str2) .. S.Get_Last_Index(Str2) + 1 loop
 				Ada.Wide_Text_IO.Put (arr2.all(i));
 			end loop;