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

ada experiments

Browse Source
This commit is contained in:
hyung-hwan 2021-10-01 11:03:54 +00:00
parent 18aa6a19e5
commit 0bdc581467
3 changed files with 57 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
lib2/h3-strings.adb
View File

@ -1,5 +1,7 @@
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with ada.text_io;
package body H3.Strings is package body H3.Strings is
BUFFER_ALIGN: constant := 16; BUFFER_ALIGN: constant := 16;
@ -126,7 +128,7 @@ package body H3.Strings is
end Prepare_Buffer; end Prepare_Buffer;
-- prepare the buffer for writing -- prepare the buffer for writing
procedure Prepare_Buffer (Str: in out Elastic_String; Req_Hard_Capa: in System_Size) is procedure Prepare_Buffer (Str: in out Elastic_String; Req_Hard_Capa: in System_Size; Shift_Pos: in System_Size := 0; Shift_Size: in System_Size := 0) is
Tmp: Elastic_String; Tmp: Elastic_String;
First, Last: System_Size; First, Last: System_Size;
Hard_Capa: System_Size; Hard_Capa: System_Size;
@ -134,6 +136,28 @@ package body H3.Strings is
First := Get_First_Index(Str); First := Get_First_Index(Str);
Last := Get_Last_Index(Str); Last := Get_Last_Index(Str);
-- if Str.Buffer /= Empty_Buffer'Access and then Is_Shared(Str) then
-- if Req_Hard_Capa < Get_Hard_Capacity(Str) then
-- Hard_Capa := Get_Hard_Capacity(Str);
-- else
-- Hard_Capa := Req_Hard_Capa;
-- end if;
--
-- Tmp := New_Buffer_Container(Hard_Capa);
-- Tmp.Buffer.Slot(First .. Last + 1) := Str.Buffer.Slot(First .. Last + 1);
-- Tmp.Buffer.Last := Last;
--
-- Str := Tmp;
-- else
-- if Req_Hard_Capa > Get_Hard_Capacity(Str) then
-- Tmp := Str;
-- Str := New_Buffer_Container(Req_Hard_Capa);
--
-- Str.Buffer.Slot(First .. Last + 1) := Tmp.Buffer.Slot(First .. Last + 1);
-- Str.Buffer.Last := Last;
-- end if;
-- end if;
if Str.Buffer /= Empty_Buffer'Access and then Is_Shared(Str) then if Str.Buffer /= Empty_Buffer'Access and then Is_Shared(Str) then
if Req_Hard_Capa < Get_Hard_Capacity(Str) then if Req_Hard_Capa < Get_Hard_Capacity(Str) then
Hard_Capa := Get_Hard_Capacity(Str); Hard_Capa := Get_Hard_Capacity(Str);
@ -141,19 +165,38 @@ package body H3.Strings is
Hard_Capa := Req_Hard_Capa; Hard_Capa := Req_Hard_Capa;
end if; end if;
Tmp := New_Buffer_Container(Hard_Capa); Tmp := Str;
Tmp.Buffer.Slot(First .. Last + 1) := Str.Buffer.Slot(First .. Last + 1); Str := New_Buffer_Container(Hard_Capa);
Tmp.Buffer.Last := Last; goto COPY_OVER;
Str := Tmp;
else else
if Req_Hard_Capa > Get_Hard_Capacity(Str) then if Req_Hard_Capa > Get_Hard_Capacity(Str) then
Tmp := Str; Tmp := Str;
Str := New_Buffer_Container(Req_Hard_Capa); Str := New_Buffer_Container(Req_Hard_Capa);
Str.Buffer.Slot(First .. Last + 1) := Tmp.Buffer.Slot(First .. Last + 1); goto COPY_OVER;
Str.Buffer.Last := Last; elsif Shift_Pos > 0 then
Tmp := Str;
goto COPY_OVER;
end if; end if;
end if; end if;
return;
<<COPY_OVER>>
if Shift_Pos > 0 then
-- it is an internal function. perform no sanity check.
-- if Shift_Pos or Shift_Size is beyond the allocated capacity,
-- it will end up in an exception.
Str.Buffer.Slot(First .. Shift_Pos - 1) := Tmp.Buffer.Slot(First .. Shift_Pos - 1);
ada.text_io.put_line ("Shift_Pos " & Shift_Pos'Img);
ada.text_io.put_line ("Shift_Size " & Shift_Size'Img);
ada.text_io.put_line ("Last " & Last'Img);
ada.text_io.put_line ("Capa " & Get_Hard_Capacity(Tmp)'Img);
Str.Buffer.Slot(Shift_Pos + Shift_Size .. Last + Shift_Size + 1) := Tmp.Buffer.Slot(Shift_Pos .. Last + 1);
Str.Buffer.Last := Last + Shift_Size;
else
Str.Buffer.Slot(First .. Last + 1) := Tmp.Buffer.Slot(First .. Last + 1);
Str.Buffer.Last := Last;
end if;
end Prepare_Buffer; end Prepare_Buffer;
procedure Clear (Str: in out Elastic_String) is procedure Clear (Str: in out Elastic_String) is
@ -194,10 +237,11 @@ package body H3.Strings is
end if; end if;
end Delete; end Delete;
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; Char: in Character_Type) is procedure Insert (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type) is
begin begin
if Pos <= Str.Buffer.Last then if Pos <= Str.Buffer.Last then
Prepare_Buffer (Str, H3.Align(Get_Length(Str) + V'Length + 1, BUFFER_ALIGN)); ada.text_io.put_line ( "INSERT ");
Prepare_Buffer (Str, H3.Align(Get_Length(Str) + 1, BUFFER_ALIGN), Pos, 1);
Str.Buffer.Slot(Pos) := New_Char; Str.Buffer.Slot(Pos) := New_Char;
end if; end if;
end Insert; end Insert;

1
lib2/h3-strings.ads
View File

@ -45,6 +45,7 @@ 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_Array);
procedure Append (Str: in out Elastic_String; V: in Character_Type); procedure Append (Str: in out Elastic_String; V: in Character_Type);
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type);
procedure Replace (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type); procedure Replace (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type);
private private

2
lib2/hello.adb
View File

@ -161,6 +161,8 @@ begin
S.Append (Str2, " THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR H3"); S.Append (Str2, " THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR H3");
S.Replace (Str2, 1, 'Q'); S.Replace (Str2, 1, 'Q');
S.Insert (Str2, 1, 'B');
S.Insert (Str2, 1, 'A');
--S.Replace (Str2, 10000, 'Q'); -- constraint error --S.Replace (Str2, 10000, 'Q'); -- constraint error
declare declare