diff mbox

ada/77535: GNAT.Perfect_Hash_Generators for non-1-based strings

Message ID 87d1keyydl.fsf@mid.deneb.enyo.de
State New
Headers show

Commit Message

Florian Weimer Sept. 8, 2016, 7:39 p.m. UTC 
This patch fixes GNAT.Perfect_Hash_Generators for strings which are
not 1-based.  It does this by introducing its own storage type which
fixes the first index as 1.  This is also a minor optimization because
it avoids the need to store the index.

Okay for trunk?

Should I try to construct a new test case for this?  I don't see any
existing tests for this package.

2016-09-08  Florian Weimer  <fw@deneb.enyo.de>

	PR ada/77535
	Make all word strings start with 1.
	* g-pehage.adb (Word_Storage): New type.
	(Word_Type): Use Word_Storage.
	(Free_Word): Instantiate Unchecked_Deallocation.
	(Apply_Position_Selection, Put_Initial_Keys, Put_Reduced_Keys)
	(Resize_Word, Select_Char_Position, Select_Character_Set): Adjust
	indirection through Word_Type.
	(New_Word): Allocate Word_Storage instead of String.

Comments

Florian Weimer Sept. 17, 2016, 3:29 p.m. UTC | #1 
* Florian Weimer:

> This patch fixes GNAT.Perfect_Hash_Generators for strings which are
> not 1-based.  It does this by introducing its own storage type which
> fixes the first index as 1.  This is also a minor optimization because
> it avoids the need to store the index.
>
> Okay for trunk?
>
> Should I try to construct a new test case for this?  I don't see any
> existing tests for this package.
>
> 2016-09-08  Florian Weimer  <fw@deneb.enyo.de>
>
> 	PR ada/77535
> 	Make all word strings start with 1.
> 	* g-pehage.adb (Word_Storage): New type.
> 	(Word_Type): Use Word_Storage.
> 	(Free_Word): Instantiate Unchecked_Deallocation.
> 	(Apply_Position_Selection, Put_Initial_Keys, Put_Reduced_Keys)
> 	(Resize_Word, Select_Char_Position, Select_Character_Set): Adjust
> 	indirection through Word_Type.
> 	(New_Word): Allocate Word_Storage instead of String.

Ping?

  <https://gcc.gnu.org/ml/gcc-patches/2016-09/msg00468.html>
diff mbox

Patch

Index: gcc/ada/g-pehage.adb
===================================================================
--- gcc/ada/g-pehage.adb	(revision 240038)
+++ gcc/ada/g-pehage.adb	(working copy)
@@ -32,6 +32,7 @@ 
 with Ada.IO_Exceptions;       use Ada.IO_Exceptions;
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 with Ada.Directories;
+with Ada.Unchecked_Deallocation;
 
 with GNAT.Heap_Sort_G;
 with GNAT.OS_Lib;      use GNAT.OS_Lib;
@@ -102,8 +103,12 @@ 
    No_Edge   : constant Edge_Id   := -1;
    No_Table  : constant Table_Id  := -1;
 
-   type Word_Type is new String_Access;
-   procedure Free_Word (W : in out Word_Type) renames Free;
+   type Word_Storage (Length : Natural) is record
+      Word : String (1 .. Length);
+   end record;
+   type Word_Type is access Word_Storage;
+   procedure Free_Word is
+      new Ada.Unchecked_Deallocation (Word_Storage, Word_Type);
    function New_Word (S : String) return Word_Type;
 
    procedure Resize_Word (W : in out Word_Type; Len : Natural);
@@ -574,7 +579,7 @@ 
    begin
       for J in 0 .. NK - 1 loop
          declare
-            IW : constant String := WT.Table (Initial (J)).all;
+            IW : constant String := WT.Table (Initial (J)).Word;
             RW : String (1 .. IW'Length) := (others => ASCII.NUL);
             N  : Natural := IW'First - 1;
 
@@ -1312,7 +1317,8 @@ 
 
    function New_Word (S : String) return Word_Type is
    begin
-      return new String'(S);
+      return new Word_Storage'(Length => S'Length,
+                               Word => S);
    end New_Word;
 
    ------------------------------
@@ -1913,7 +1919,7 @@ 
          K := Get_Key (J);
          Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
          Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
-         Put (File, Trim_Trailing_Nuls (WT.Table (Initial (J)).all),
+         Put (File, Trim_Trailing_Nuls (WT.Table (Initial (J)).Word),
                     F1, L1, J, 1, 3, 3);
       end loop;
    end Put_Initial_Keys;
@@ -1995,7 +2001,7 @@ 
          K := Get_Key (J);
          Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
          Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
-         Put (File, Trim_Trailing_Nuls (WT.Table (Reduced (J)).all),
+         Put (File, Trim_Trailing_Nuls (WT.Table (Reduced (J)).Word),
                     F1, L1, J, 1, 3, 3);
       end loop;
    end Put_Reduced_Keys;
@@ -2075,7 +2081,7 @@ 
    -----------------
 
    procedure Resize_Word (W : in out Word_Type; Len : Natural) is
-      S1 : constant String := W.all;
+      S1 : constant String := W.Word;
       S2 : String (1 .. Len) := (others => ASCII.NUL);
       L  : constant Natural := S1'Length;
    begin
@@ -2161,7 +2167,7 @@ 
                Right := Offset + R;
             end if;
 
-            return WT.Table (Left)(C) < WT.Table (Right)(C);
+            return WT.Table (Left).Word (C) < WT.Table (Right).Word (C);
          end Lt;
 
          ----------
@@ -2221,8 +2227,8 @@ 
                   --  Two contiguous words are identical when they have the
                   --  same Cth character.
 
-                  elsif WT.Table (Reduced (N))(C) =
-                        WT.Table (Reduced (N + 1))(C)
+                  elsif WT.Table (Reduced (N)).Word (C) =
+                        WT.Table (Reduced (N + 1)).Word (C)
                   then
                      L := N + 1;
 
@@ -2265,7 +2271,7 @@ 
 
             N := (others => 0);
             for K in Table (S).First .. Table (S).Last loop
-               C := WT.Table (Reduced (K))(Pos);
+               C := WT.Table (Reduced (K)).Word (Pos);
                N (C) := N (C) + 1;
             end loop;
 
@@ -2288,7 +2294,7 @@ 
       --  Initialize the reduced words set
 
       for K in 0 .. NK - 1 loop
-         WT.Table (Reduced (K)) := New_Word (WT.Table (Initial (K)).all);
+         WT.Table (Reduced (K)) := New_Word (WT.Table (Initial (K)).Word);
       end loop;
 
       declare
@@ -2384,7 +2390,7 @@ 
                     Same_Keys_Sets_Table (J).Last
                   loop
                      Put (Output,
-                          Trim_Trailing_Nuls (WT.Table (Reduced (K)).all));
+                          Trim_Trailing_Nuls (WT.Table (Reduced (K)).Word));
                      New_Line (Output);
                   end loop;
                   Put (Output, "--");
@@ -2414,7 +2420,7 @@ 
    begin
       for J in 0 .. NK - 1 loop
          for K in 0 .. Char_Pos_Set_Len - 1 loop
-            Char := WT.Table (Initial (J))(Get_Char_Pos (K));
+            Char := WT.Table (Initial (J)).Word (Get_Char_Pos (K));
             exit when Char = ASCII.NUL;
             Used (Char) := True;
          end loop;
@@ -2520,16 +2526,16 @@ 
       case Opt is
          when CPU_Time =>
             for J in 0 .. T1_Len - 1 loop
-               exit when Word (J + 1) = ASCII.NUL;
-               R := Get_Table (Table, J, Get_Used_Char (Word (J + 1)));
+               exit when Word.Word (J + 1) = ASCII.NUL;
+               R := Get_Table (Table, J, Get_Used_Char (Word.Word (J + 1)));
                S := (S + R) mod NV;
             end loop;
 
          when Memory_Space =>
             for J in 0 .. T1_Len - 1 loop
-               exit when Word (J + 1) = ASCII.NUL;
+               exit when Word.Word (J + 1) = ASCII.NUL;
                R := Get_Table (Table, J, 0);
-               S := (S + R * Character'Pos (Word (J + 1))) mod NV;
+               S := (S + R * Character'Pos (Word.Word (J + 1))) mod NV;
             end loop;
       end case;