Skip to content

R
riscv-gcc-1
Commit 1f5a9324 by Laurent Pautet Committed by Arnaud Charlet
Options

g-pehage.ads, [...] (Select_Char_Position): When no character position set is provided... 

2005-09-01  Laurent Pautet  <pautet@adacore.com>

	* g-pehage.ads, g-pehage.adb (Select_Char_Position): When no character
	position set is provided, we compute one in order to reduce the maximum
	length of the keys.  This computation first selects a character
	position between 1 and the minimum length of the keys in order to
	avoid reducing one of the keys to an empty string.
	(Initialize, Compute): When the ratio V to K is too low, the algorithm
	does not converge. The initialization procedure now comes with a
	maximum number of iterations such that when exceeded, an exception is
	raised in Compute. The user can initialize this ratio to another value
	and try again
	Reformating and updated headers.

From-SVN: r103867
parent dd52e06a
Showing with 819 additions and 755 deletions
gcc/ada/g-pehage.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2002-2004 Ada Core Technologies, Inc. -- -- Copyright (C) 2002-2005 Ada Core Technologies, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -40,24 +40,24 @@ with GNAT.Table; ...@@ -40,24 +40,24 @@ with GNAT.Table;
package body GNAT.Perfect_Hash_Generators is package body GNAT.Perfect_Hash_Generators is
-- We are using the algorithm of J. Czech as described in Zbigniew -- We are using the algorithm of J. Czech as described in Zbigniew J.
-- J. Czech, George Havas, and Bohdan S. Majewski ``An Optimal -- Czech, George Havas, and Bohdan S. Majewski ``An Optimal Algorithm for
-- Algorithm for Generating Minimal Perfect Hash Functions'', -- Generating Minimal Perfect Hash Functions'', Information Processing
-- Information Processing Letters, 43(1992) pp.257-264, Oct.1992 -- Letters, 43(1992) pp.257-264, Oct.1992
-- This minimal perfect hash function generator is based on random -- This minimal perfect hash function generator is based on random graphs
-- graphs and produces a hash function of the form: -- and produces a hash function of the form:
-- h (w) = (g (f1 (w)) + g (f2 (w))) mod m -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
-- where f1 and f2 are functions that map strings into integers, -- where f1 and f2 are functions that map strings into integers, and g is a
-- and g is a function that maps integers into [0, m-1]. h can be -- function that maps integers into [0, m-1]. h can be order preserving.
-- order preserving. For instance, let W = {w_0, ..., w_i, ..., -- For instance, let W = {w_0, ..., w_i, ...,
-- w_m-1}, h can be defined such that h (w_i) = i. -- w_m-1}, h can be defined such that h (w_i) = i.
-- This algorithm defines two possible constructions of f1 and -- This algorithm defines two possible constructions of f1 and f2. Method
-- f2. Method b) stores the hash function in less memory space at -- b) stores the hash function in less memory space at the expense of
-- the expense of greater CPU time. -- greater CPU time.
-- a) fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n -- a) fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
...@@ -65,36 +65,33 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -65,36 +65,33 @@ package body GNAT.Perfect_Hash_Generators is
-- b) fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n -- b) fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
-- size (Tk) = max (for w in W) (length (w)) but the table -- size (Tk) = max (for w in W) (length (w)) but the table lookups are
-- lookups are replaced by multiplications. -- replaced by multiplications.
-- where Tk values are randomly generated. n is defined later on -- where Tk values are randomly generated. n is defined later on but the
-- but the algorithm recommends to use a value a little bit -- algorithm recommends to use a value a little bit greater than 2m. Note
-- greater than 2m. Note that for large values of m, the main -- that for large values of m, the main memory space requirements comes
-- memory space requirements comes from the memory space for -- from the memory space for storing function g (>= 2m entries).
-- storing function g (>= 2m entries).
-- Random graphs are frequently used to solve difficult problems that do
-- Random graphs are frequently used to solve difficult problems -- not have polynomial solutions. This algorithm is based on a weighted
-- that do not have polynomial solutions. This algorithm is based -- undirected graph. It comprises two steps: mapping and assigment.
-- on a weighted undirected graph. It comprises two steps: mapping
-- and assigment. -- In the mapping step, a graph G = (V, E) is constructed, where = {0, 1,
-- ..., n-1} and E = {(for w in W) (f1 (w), f2 (w))}. In order for the
-- In the mapping step, a graph G = (V, E) is constructed, where V -- assignment step to be successful, G has to be acyclic. To have a high
-- = {0, 1, ..., n-1} and E = {(for w in W) (f1 (w), f2 (w))}. In -- probability of generating an acyclic graph, n >= 2m. If it is not
-- order for the assignment step to be successful, G has to be -- acyclic, Tk have to be regenerated.
-- acyclic. To have a high probability of generating an acyclic
-- graph, n >= 2m. If it is not acyclic, Tk have to be regenerated. -- In the assignment step, the algorithm builds function g. As is acyclic,
-- there is a vertex v1 with only one neighbor v2. Let w_i be the word such
-- In the assignment step, the algorithm builds function g. As G -- that v1 = f1 (w_i) and v2 = f2 (w_i). Let g (v1) = 0 by construction and
-- is acyclic, there is a vertex v1 with only one neighbor v2. Let -- g (v2) = (i - g (v1)) mod n (or to be general, (h (i) - g (v1) mod n).
-- w_i be the word such that v1 = f1 (w_i) and v2 = f2 (w_i). Let -- If word w_j is such that v2 = f1 (w_j) and v3 = f2 (w_j), g (v3) = (j -
-- g (v1) = 0 by construction and g (v2) = (i - g (v1)) mod n (or -- g (v2)) mod (or to be general, (h (j) - g (v2)) mod n). If w_i has no
-- to be general, (h (i) - g (v1) mod n). If word w_j is such that -- neighbor, then another vertex is selected. The algorithm traverses G to
-- v2 = f1 (w_j) and v3 = f2 (w_j), g (v3) = (j - g (v2)) mod n -- assign values to all the vertices. It cannot assign a value to an
-- (or to be general, (h (j) - g (v2)) mod n). If w_i has no -- already assigned vertex as G is acyclic.
-- neighbor, then another vertex is selected. The algorithm
-- traverses G to assign values to all the vertices. It cannot
-- assign a value to an already assigned vertex as G is acyclic.
subtype Word_Id is Integer; subtype Word_Id is Integer;
subtype Key_Id is Integer; subtype Key_Id is Integer;
...@@ -109,42 +106,44 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -109,42 +106,44 @@ package body GNAT.Perfect_Hash_Generators is
Max_Word_Length : constant := 32; Max_Word_Length : constant := 32;
subtype Word_Type is String (1 .. Max_Word_Length); subtype Word_Type is String (1 .. Max_Word_Length);
Null_Word : constant Word_Type := (others => ASCII.NUL); Null_Word : constant Word_Type := (others => ASCII.NUL);
-- Store keyword in a word. Note that the length of word is -- Store keyword in a word. Note that the length of word is limited to 32
-- limited to 32 characters. -- characters.
type Key_Type is record type Key_Type is record
Edge : Edge_Id; Edge : Edge_Id;
end record; end record;
-- A key corresponds to an edge in the algorithm graph. -- A key corresponds to an edge in the algorithm graph
type Vertex_Type is record type Vertex_Type is record
First : Edge_Id; First : Edge_Id;
Last : Edge_Id; Last : Edge_Id;
end record; end record;
-- A vertex can be involved in several edges. First and Last are -- A vertex can be involved in several edges. First and Last are the bounds
-- the bounds of an array of edges stored in a global edge table. -- of an array of edges stored in a global edge table.
type Edge_Type is record type Edge_Type is record
X : Vertex_Id; X : Vertex_Id;
Y : Vertex_Id; Y : Vertex_Id;
Key : Key_Id; Key : Key_Id;
end record; end record;
-- An edge is a peer of vertices. In the algorithm, a key -- An edge is a peer of vertices. In the algorithm, a key is associated to
-- is associated to an edge. -- an edge.
package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32); package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32);
package IT is new GNAT.Table (Integer, Integer, 0, 32, 32); package IT is new GNAT.Table (Integer, Integer, 0, 32, 32);
-- The two main tables. IT is used to store several tables of -- The two main tables. IT is used to store several tables of components
-- components containing only integers. -- containing only integers.
function Image (Int : Integer; W : Natural := 0) return String; function Image (Int : Integer; W : Natural := 0) return String;
function Image (Str : String; W : Natural := 0) return String; function Image (Str : String; W : Natural := 0) return String;
-- Return a string which includes string Str or integer Int -- Return a string which includes string Str or integer Int preceded by
-- preceded by leading spaces if required by width W. -- leading spaces if required by width W.
Output : File_Descriptor renames GNAT.OS_Lib.Standout; Output : File_Descriptor renames GNAT.OS_Lib.Standout;
-- Shortcuts -- Shortcuts
EOL : constant Character := ASCII.LF;
Max : constant := 78; Max : constant := 78;
Last : Natural := 0; Last : Natural := 0;
Line : String (1 .. Max); Line : String (1 .. Max);
...@@ -163,24 +162,23 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -163,24 +162,23 @@ package body GNAT.Perfect_Hash_Generators is
F2 : Natural; F2 : Natural;
L2 : Natural; L2 : Natural;
C2 : Natural); C2 : Natural);
-- Write string S into file F as a element of an array of one or -- Write string S into file F as a element of an array of one or two
-- two dimensions. Fk (resp. Lk and Ck) indicates the first (resp -- dimensions. Fk (resp. Lk and Ck) indicates the first (resp last and
-- last and current) index in the k-th dimension. If F1 = L1 the -- current) index in the k-th dimension. If F1 = L1 the array is considered
-- array is considered as a one dimension array. This dimension is -- as a one dimension array. This dimension is described by F2 and L2. This
-- described by F2 and L2. This routine takes care of all the -- routine takes care of all the parenthesis, spaces and commas needed to
-- parenthesis, spaces and commas needed to format correctly the -- format correctly the array. Moreover, the array is well indented and is
-- array. Moreover, the array is well indented and is wrapped to -- wrapped to fit in a 80 col line. When the line is full, the routine
-- fit in a 80 col line. When the line is full, the routine writes -- writes it into file F. When the array is completed, the routine adds
-- it into file F. When the array is completed, the routine adds a
-- semi-colon and writes the line into file F. -- semi-colon and writes the line into file F.
procedure New_Line procedure New_Line
(F : File_Descriptor); (File : File_Descriptor);
-- Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib -- Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib
procedure Put procedure Put
(F : File_Descriptor; (File : File_Descriptor;
S : String); Str : String);
-- Simulate Ada.Text_IO.Put with GNAT.OS_Lib -- Simulate Ada.Text_IO.Put with GNAT.OS_Lib
procedure Put_Used_Char_Set procedure Put_Used_Char_Set
...@@ -191,16 +189,18 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -191,16 +189,18 @@ package body GNAT.Perfect_Hash_Generators is
procedure Put_Int_Vector procedure Put_Int_Vector
(File : File_Descriptor; (File : File_Descriptor;
Title : String; Title : String;
Root : Integer; Vector : Integer;
Length : Natural); Length : Natural);
-- Output a title and a vector -- Output a title and a vector
procedure Put_Int_Matrix procedure Put_Int_Matrix
(File : File_Descriptor; (File : File_Descriptor;
Title : String; Title : String;
Table : Table_Id); Table : Table_Id;
-- Output a title and a matrix. When the matrix has only one Len_1 : Natural;
-- non-empty dimension, it is output as a vector. Len_2 : Natural);
-- Output a title and a matrix. When the matrix has only one non-empty
-- dimension (Len_2 = 0), output a vector.
procedure Put_Edges procedure Put_Edges
(File : File_Descriptor; (File : File_Descriptor;
...@@ -226,82 +226,79 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -226,82 +226,79 @@ package body GNAT.Perfect_Hash_Generators is
-- Character Position Selection -- -- Character Position Selection --
---------------------------------- ----------------------------------
-- We reduce the maximum key size by selecting representative -- We reduce the maximum key size by selecting representative positions
-- positions in these keys. We build a matrix with one word per -- in these keys. We build a matrix with one word per line. We fill the
-- line. We fill the remaining space of a line with ASCII.NUL. The -- remaining space of a line with ASCII.NUL. The heuristic selects the
-- heuristic selects the position that induces the minimum number -- position that induces the minimum number of collisions. If there are
-- of collisions. If there are collisions, select another position -- collisions, select another position on the reduced key set responsible
-- on the reduced key set responsible of the collisions. Apply the -- of the collisions. Apply the heuristic until there is no more collision.
-- heuristic until there is no more collision.
procedure Apply_Position_Selection; procedure Apply_Position_Selection;
-- Apply Position selection and build the reduced key table -- Apply Position selection and build the reduced key table
procedure Parse_Position_Selection (Argument : String); procedure Parse_Position_Selection (Argument : String);
-- Parse Argument and compute the position set. Argument is a -- Parse Argument and compute the position set. Argument is list of
-- list of substrings separated by commas. Each substring -- substrings separated by commas. Each substring represents a position
-- represents a position or a range of positions (like x-y). -- or a range of positions (like x-y).
procedure Select_Character_Set; procedure Select_Character_Set;
-- Define an optimized used character set like Character'Pos in -- Define an optimized used character set like Character'Pos in order not
-- order not to allocate tables of 256 entries. -- to allocate tables of 256 entries.
procedure Select_Char_Position; procedure Select_Char_Position;
-- Find a min char position set in order to reduce the max key -- Find a min char position set in order to reduce the max key length. The
-- length. The heuristic selects the position that induces the -- heuristic selects the position that induces the minimum number of
-- minimum number of collisions. If there are collisions, select -- collisions. If there are collisions, select another position on the
-- another position on the reduced key set responsible of the -- reduced key set responsible of the collisions. Apply the heuristic until
-- collisions. Apply the heuristic until there is no collision. -- there is no collision.
----------------------------- -----------------------------
-- Random Graph Generation -- -- Random Graph Generation --
----------------------------- -----------------------------
procedure Random (Seed : in out Natural); procedure Random (Seed : in out Natural);
-- Simulate Ada.Discrete_Numerics.Random. -- Simulate Ada.Discrete_Numerics.Random
procedure Generate_Mapping_Table procedure Generate_Mapping_Table
(T : Table_Id; (Tab : Table_Id;
L1 : Natural; L1 : Natural;
L2 : Natural; L2 : Natural;
S : in out Natural); Seed : in out Natural);
-- Random generation of the tables below. T is already allocated. -- Random generation of the tables below. T is already allocated
procedure Generate_Mapping_Tables procedure Generate_Mapping_Tables
(Opt : Optimization; (Opt : Optimization;
S : in out Natural); Seed : in out Natural);
-- Generate the mapping tables T1 and T2. They are used to define : -- Generate the mapping tables T1 and T2. They are used to define fk (w) =
-- fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n. -- sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n. Keys, NK and Chars
-- Keys, NK and Chars are used to compute the matrix size. -- are used to compute the matrix size.
--------------------------- ---------------------------
-- Algorithm Computation -- -- Algorithm Computation --
--------------------------- ---------------------------
procedure Compute_Edges_And_Vertices (Opt : Optimization); procedure Compute_Edges_And_Vertices (Opt : Optimization);
-- Compute the edge and vertex tables. These are empty when a self -- Compute the edge and vertex tables. These are empty when a self loop is
-- loop is detected (f1 (w) = f2 (w)). The edge table is sorted by -- detected (f1 (w) = f2 (w)). The edge table is sorted by X value and then
-- X value and then Y value. Keys is the key table and NK the -- Y value. Keys is the key table and NK the number of keys. Chars is the
-- number of keys. Chars is the set of characters really used in -- set of characters really used in Keys. NV is the number of vertices
-- Keys. NV is the number of vertices recommended by the -- recommended by the algorithm. T1 and T2 are the mapping tables needed to
-- algorithm. T1 and T2 are the mapping tables needed to compute -- compute f1 (w) and f2 (w).
-- f1 (w) and f2 (w).
function Acyclic return Boolean; function Acyclic return Boolean;
-- Return True when the graph is acyclic. Vertices is the current -- Return True when the graph is acyclic. Vertices is the current vertex
-- vertex table and Edges the current edge table. -- table and Edges the current edge table.
procedure Assign_Values_To_Vertices; procedure Assign_Values_To_Vertices;
-- Execute the assignment step of the algorithm. Keys is the -- Execute the assignment step of the algorithm. Keys is the current key
-- current key table. Vertices and Edges represent the random -- table. Vertices and Edges represent the random graph. G is the result of
-- graph. G is the result of the assignment step such that: -- the assignment step such that:
-- h (w) = (g (f1 (w)) + g (f2 (w))) mod m -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
function Sum function Sum
(Word : Word_Type; (Word : Word_Type;
Table : Table_Id; Table : Table_Id;
Opt : Optimization) Opt : Optimization) return Natural;
return Natural;
-- For an optimization of CPU_Time return -- For an optimization of CPU_Time return
-- fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n -- fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
-- For an optimization of Memory_Space return -- For an optimization of Memory_Space return
...@@ -312,16 +309,18 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -312,16 +309,18 @@ package body GNAT.Perfect_Hash_Generators is
-- Internal Table Management -- -- Internal Table Management --
------------------------------- -------------------------------
function Allocate (N : Natural; S : Natural) return Table_Id; function Allocate (N : Natural; S : Natural := 1) return Table_Id;
-- procedure Deallocate (N : Natural; S : Natural); -- Allocate N * S ints from IT table
procedure Free_Tmp_Tables;
-- Deallocate the tables used by the algorithm (but not the keys table)
---------- ----------
-- Keys -- -- Keys --
---------- ----------
Key_Size : constant := 1; Keys : Table_Id := No_Table;
Keys : Table_Id := No_Table; NK : Natural := 0;
NK : Natural;
-- NK : Number of Keys -- NK : Number of Keys
function Initial (K : Key_Id) return Word_Id; function Initial (K : Key_Id) return Word_Id;
...@@ -330,64 +329,63 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -330,64 +329,63 @@ package body GNAT.Perfect_Hash_Generators is
function Reduced (K : Key_Id) return Word_Id; function Reduced (K : Key_Id) return Word_Id;
pragma Inline (Reduced); pragma Inline (Reduced);
function Get_Key (F : Key_Id) return Key_Type; function Get_Key (N : Key_Id) return Key_Type;
procedure Set_Key (F : Key_Id; Item : Key_Type); procedure Set_Key (N : Key_Id; Item : Key_Type);
-- Comments needed here ??? -- Get or Set Nth element of Keys table
------------------ ------------------
-- Char_Pos_Set -- -- Char_Pos_Set --
------------------ ------------------
Char_Pos_Size : constant := 1;
Char_Pos_Set : Table_Id := No_Table; Char_Pos_Set : Table_Id := No_Table;
Char_Pos_Set_Len : Natural; Char_Pos_Set_Len : Natural;
-- Character Selected Position Set -- Character Selected Position Set
function Get_Char_Pos (P : Natural) return Natural; function Get_Char_Pos (P : Natural) return Natural;
procedure Set_Char_Pos (P : Natural; Item : Natural); procedure Set_Char_Pos (P : Natural; Item : Natural);
-- Comments needed here ??? -- Get or Set the string position of the Pth selected character
------------------- -------------------
-- Used_Char_Set -- -- Used_Char_Set --
------------------- -------------------
Used_Char_Size : constant := 1;
Used_Char_Set : Table_Id := No_Table; Used_Char_Set : Table_Id := No_Table;
Used_Char_Set_Len : Natural; Used_Char_Set_Len : Natural;
-- Used Character Set : Define a new character mapping. When all -- Used Character Set : Define a new character mapping. When all the
-- the characters are not present in the keys, in order to reduce -- characters are not present in the keys, in order to reduce the size
-- the size of some tables, we redefine the character mapping. -- of some tables, we redefine the character mapping.
function Get_Used_Char (C : Character) return Natural; function Get_Used_Char (C : Character) return Natural;
procedure Set_Used_Char (C : Character; Item : Natural); procedure Set_Used_Char (C : Character; Item : Natural);
------------------- ------------
-- Random Tables -- -- Tables --
------------------- ------------
Rand_Tab_Item_Size : constant := 1; T1 : Table_Id := No_Table;
T1 : Table_Id := No_Table; T2 : Table_Id := No_Table;
T2 : Table_Id := No_Table; T1_Len : Natural;
Rand_Tab_Len_1 : Natural; T2_Len : Natural;
Rand_Tab_Len_2 : Natural;
-- T1 : Values table to compute F1 -- T1 : Values table to compute F1
-- T2 : Values table to compute F2 -- T2 : Values table to compute F2
function Get_Rand_Tab (T : Integer; X, Y : Natural) return Natural; function Get_Table (T : Integer; X, Y : Natural) return Natural;
procedure Set_Rand_Tab (T : Integer; X, Y : Natural; Item : Natural); procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural);
------------------ -----------
-- Random Graph -- -- Graph --
------------------ -----------
Graph_Item_Size : constant := 1; G : Table_Id := No_Table;
G : Table_Id := No_Table; G_Len : Natural;
Graph_Len : Natural; -- Values table to compute G
-- G : Values table to compute G
function Get_Graph (F : Natural) return Integer; NT : Natural := Default_Tries;
procedure Set_Graph (F : Natural; Item : Integer); -- Number of tries running the algorithm before raising an error
-- Comments needed ???
function Get_Graph (N : Natural) return Integer;
procedure Set_Graph (N : Natural; Item : Integer);
-- Get or Set Nth element of graph
----------- -----------
-- Edges -- -- Edges --
...@@ -423,8 +421,9 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -423,8 +421,9 @@ package body GNAT.Perfect_Hash_Generators is
Opt : Optimization; Opt : Optimization;
-- Optimization mode (memory vs CPU) -- Optimization mode (memory vs CPU)
MKL : Natural; Max_Key_Len : Natural := 0;
-- Maximum of all the word length Min_Key_Len : Natural := Max_Word_Length;
-- Maximum and minimum of all the word length
S : Natural; S : Natural;
-- Seed -- Seed
...@@ -436,26 +435,23 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -436,26 +435,23 @@ package body GNAT.Perfect_Hash_Generators is
-- Acyclic -- -- Acyclic --
------------- -------------
function Acyclic return Boolean function Acyclic return Boolean is
is
Marks : array (0 .. NV - 1) of Vertex_Id := (others => No_Vertex); Marks : array (0 .. NV - 1) of Vertex_Id := (others => No_Vertex);
function Traverse function Traverse
(Edge : Edge_Id; (Edge : Edge_Id;
Mark : Vertex_Id) Mark : Vertex_Id) return Boolean;
return Boolean; -- Propagate Mark from X to Y. X is already marked. Mark Y and propagate
-- Propagate Mark from X to Y. X is already marked. Mark Y and -- it to the edges of Y except the one representing the same key. Return
-- propagate it to the edges of Y except the one representing -- False when Y is marked with Mark.
-- the same key. Return False when Y is marked with Mark.
-------------- --------------
-- Traverse -- -- Traverse --
-------------- --------------
function Traverse function Traverse
(Edge : Edge_Id; (Edge : Edge_Id;
Mark : Vertex_Id) Mark : Vertex_Id) return Boolean
return Boolean
is is
E : constant Edge_Type := Get_Edges (Edge); E : constant Edge_Type := Get_Edges (Edge);
K : constant Key_Id := E.Key; K : constant Key_Id := E.Key;
...@@ -473,7 +469,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -473,7 +469,7 @@ package body GNAT.Perfect_Hash_Generators is
for J in V.First .. V.Last loop for J in V.First .. V.Last loop
-- Do not propagate to the edge representing the same key. -- Do not propagate to the edge representing the same key
if Get_Edges (J).Key /= K if Get_Edges (J).Key /= K
and then not Traverse (J, Mark) and then not Traverse (J, Mark)
...@@ -531,7 +527,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -531,7 +527,6 @@ package body GNAT.Perfect_Hash_Generators is
procedure Add (S : String) is procedure Add (S : String) is
Len : constant Natural := S'Length; Len : constant Natural := S'Length;
begin begin
Line (Last + 1 .. Last + Len) := S; Line (Last + 1 .. Last + Len) := S;
Last := Last + Len; Last := Last + Len;
...@@ -541,9 +536,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -541,9 +536,8 @@ package body GNAT.Perfect_Hash_Generators is
-- Allocate -- -- Allocate --
-------------- --------------
function Allocate (N : Natural; S : Natural) return Table_Id is function Allocate (N : Natural; S : Natural := 1) return Table_Id is
L : constant Integer := IT.Last; L : constant Integer := IT.Last;
begin begin
IT.Set_Last (L + N * S); IT.Set_Last (L + N * S);
return L + 1; return L + 1;
...@@ -555,7 +549,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -555,7 +549,7 @@ package body GNAT.Perfect_Hash_Generators is
procedure Apply_Position_Selection is procedure Apply_Position_Selection is
begin begin
WT.Set_Last (2 * NK - 1); WT.Set_Last (2 * NK);
for J in 0 .. NK - 1 loop for J in 0 .. NK - 1 loop
declare declare
I_Word : constant Word_Type := WT.Table (Initial (J)); I_Word : constant Word_Type := WT.Table (Initial (J));
...@@ -563,8 +557,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -563,8 +557,8 @@ package body GNAT.Perfect_Hash_Generators is
Index : Natural := I_Word'First - 1; Index : Natural := I_Word'First - 1;
begin begin
-- Select the characters of Word included in the -- Select the characters of Word included in the position
-- position selection. -- selection.
for C in 0 .. Char_Pos_Set_Len - 1 loop for C in 0 .. Char_Pos_Set_Len - 1 loop
exit when I_Word (Get_Char_Pos (C)) = ASCII.NUL; exit when I_Word (Get_Char_Pos (C)) = ASCII.NUL;
...@@ -580,56 +574,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -580,56 +574,6 @@ package body GNAT.Perfect_Hash_Generators is
end loop; end loop;
end Apply_Position_Selection; end Apply_Position_Selection;
-------------
-- Compute --
-------------
procedure Compute (Position : String := Default_Position) is
begin
Keys := Allocate (NK, Key_Size);
if Verbose then
Put_Initial_Keys (Output, "Initial Key Table");
end if;
if Position'Length /= 0 then
Parse_Position_Selection (Position);
else
Select_Char_Position;
end if;
if Verbose then
Put_Int_Vector
(Output, "Char Position Set", Char_Pos_Set, Char_Pos_Set_Len);
end if;
Apply_Position_Selection;
if Verbose then
Put_Reduced_Keys (Output, "Reduced Keys Table");
end if;
Select_Character_Set;
if Verbose then
Put_Used_Char_Set (Output, "Character Position Table");
end if;
-- Perform Czech's algorithm
loop
Generate_Mapping_Tables (Opt, S);
Compute_Edges_And_Vertices (Opt);
-- When graph is not empty (no self-loop from previous
-- operation) and not acyclic.
exit when 0 < Edges_Len and then Acyclic;
end loop;
Assign_Values_To_Vertices;
end Compute;
------------------------------- -------------------------------
-- Assign_Values_To_Vertices -- -- Assign_Values_To_Vertices --
------------------------------- -------------------------------
...@@ -638,8 +582,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -638,8 +582,8 @@ package body GNAT.Perfect_Hash_Generators is
X : Vertex_Id; X : Vertex_Id;
procedure Assign (X : Vertex_Id); procedure Assign (X : Vertex_Id);
-- Execute assignment on X's neighbors except the vertex that -- Execute assignment on X's neighbors except the vertex that we are
-- we are coming from which is already assigned. -- coming from which is already assigned.
------------ ------------
-- Assign -- -- Assign --
...@@ -649,7 +593,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -649,7 +593,6 @@ package body GNAT.Perfect_Hash_Generators is
is is
E : Edge_Type; E : Edge_Type;
V : constant Vertex_Type := Get_Vertices (X); V : constant Vertex_Type := Get_Vertices (X);
begin begin
for J in V.First .. V.Last loop for J in V.First .. V.Last loop
E := Get_Edges (J); E := Get_Edges (J);
...@@ -667,11 +610,11 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -667,11 +610,11 @@ package body GNAT.Perfect_Hash_Generators is
-- be in the range 0 .. NK. -- be in the range 0 .. NK.
if G = No_Table then if G = No_Table then
Graph_Len := NV; G_Len := NV;
G := Allocate (Graph_Len, Graph_Item_Size); G := Allocate (G_Len, 1);
end if; end if;
for J in 0 .. Graph_Len - 1 loop for J in 0 .. G_Len - 1 loop
Set_Graph (J, -1); Set_Graph (J, -1);
end loop; end loop;
...@@ -684,17 +627,80 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -684,17 +627,80 @@ package body GNAT.Perfect_Hash_Generators is
end if; end if;
end loop; end loop;
for J in 0 .. Graph_Len - 1 loop for J in 0 .. G_Len - 1 loop
if Get_Graph (J) = -1 then if Get_Graph (J) = -1 then
Set_Graph (J, 0); Set_Graph (J, 0);
end if; end if;
end loop; end loop;
if Verbose then if Verbose then
Put_Int_Vector (Output, "Assign Values To Vertices", G, Graph_Len); Put_Int_Vector (Output, "Assign Values To Vertices", G, G_Len);
end if; end if;
end Assign_Values_To_Vertices; end Assign_Values_To_Vertices;
-------------
-- Compute --
-------------
procedure Compute
(Position : String := Default_Position)
is
Success : Boolean := False;
begin
NV := Natural (K2V * Float (NK));
Keys := Allocate (NK);
if Verbose then
Put_Initial_Keys (Output, "Initial Key Table");
end if;
if Position'Length /= 0 then
Parse_Position_Selection (Position);
else
Select_Char_Position;
end if;
if Verbose then
Put_Int_Vector
(Output, "Char Position Set", Char_Pos_Set, Char_Pos_Set_Len);
end if;
Apply_Position_Selection;
if Verbose then
Put_Reduced_Keys (Output, "Reduced Keys Table");
end if;
Select_Character_Set;
if Verbose then
Put_Used_Char_Set (Output, "Character Position Table");
end if;
-- Perform Czech's algorithm
for J in 1 .. NT loop
Generate_Mapping_Tables (Opt, S);
Compute_Edges_And_Vertices (Opt);
-- When graph is not empty (no self-loop from previous operation) and
-- not acyclic.
if 0 < Edges_Len and then Acyclic then
Success := True;
exit;
end if;
end loop;
if not Success then
raise Too_Many_Tries;
end if;
Assign_Values_To_Vertices;
end Compute;
-------------------------------- --------------------------------
-- Compute_Edges_And_Vertices -- -- Compute_Edges_And_Vertices --
-------------------------------- --------------------------------
...@@ -711,15 +717,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -711,15 +717,6 @@ package body GNAT.Perfect_Hash_Generators is
function Lt (L, R : Natural) return Boolean; function Lt (L, R : Natural) return Boolean;
-- Subprograms needed for GNAT.Heap_Sort_A -- Subprograms needed for GNAT.Heap_Sort_A
----------
-- Move --
----------
procedure Move (From : Natural; To : Natural) is
begin
Set_Edges (To, Get_Edges (From));
end Move;
-------- --------
-- Lt -- -- Lt --
-------- --------
...@@ -727,16 +724,24 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -727,16 +724,24 @@ package body GNAT.Perfect_Hash_Generators is
function Lt (L, R : Natural) return Boolean is function Lt (L, R : Natural) return Boolean is
EL : constant Edge_Type := Get_Edges (L); EL : constant Edge_Type := Get_Edges (L);
ER : constant Edge_Type := Get_Edges (R); ER : constant Edge_Type := Get_Edges (R);
begin begin
return EL.X < ER.X or else (EL.X = ER.X and then EL.Y < ER.Y); return EL.X < ER.X or else (EL.X = ER.X and then EL.Y < ER.Y);
end Lt; end Lt;
----------
-- Move --
----------
procedure Move (From : Natural; To : Natural) is
begin
Set_Edges (To, Get_Edges (From));
end Move;
-- Start of processing for Compute_Edges_And_Vertices -- Start of processing for Compute_Edges_And_Vertices
begin begin
-- We store edges from 1 to 2 * NK and leave -- We store edges from 1 to 2 * NK and leave zero alone in order to use
-- zero alone in order to use GNAT.Heap_Sort_A. -- GNAT.Heap_Sort_A.
Edges_Len := 2 * NK + 1; Edges_Len := 2 * NK + 1;
...@@ -783,14 +788,16 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -783,14 +788,16 @@ package body GNAT.Perfect_Hash_Generators is
else else
if Verbose then if Verbose then
Put_Edges (Output, "Unsorted Edge Table"); Put_Edges (Output, "Unsorted Edge Table");
Put_Int_Matrix (Output, "Function Table 1", T1); Put_Int_Matrix (Output, "Function Table 1", T1,
Put_Int_Matrix (Output, "Function Table 2", T2); T1_Len, T2_Len);
Put_Int_Matrix (Output, "Function Table 2", T2,
T1_Len, T2_Len);
end if; end if;
-- Enforce consistency between edges and keys. Construct -- Enforce consistency between edges and keys. Construct Vertices and
-- Vertices and compute the list of neighbors of a vertex -- compute the list of neighbors of a vertex First .. Last as Edges
-- First .. Last as Edges is sorted by X and then Y. To -- is sorted by X and then Y. To compute the neighbor list, sort the
-- compute the neighbor list, sort the edges. -- edges.
Sort Sort
(Edges_Len - 1, (Edges_Len - 1,
...@@ -799,8 +806,10 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -799,8 +806,10 @@ package body GNAT.Perfect_Hash_Generators is
if Verbose then if Verbose then
Put_Edges (Output, "Sorted Edge Table"); Put_Edges (Output, "Sorted Edge Table");
Put_Int_Matrix (Output, "Function Table 1", T1); Put_Int_Matrix (Output, "Function Table 1", T1,
Put_Int_Matrix (Output, "Function Table 2", T2); T1_Len, T2_Len);
Put_Int_Matrix (Output, "Function Table 2", T2,
T1_Len, T2_Len);
end if; end if;
-- Edges valid range is 1 .. 2 * NK -- Edges valid range is 1 .. 2 * NK
...@@ -857,8 +866,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -857,8 +866,8 @@ package body GNAT.Perfect_Hash_Generators is
when Function_Table_1 when Function_Table_1
| Function_Table_2 => | Function_Table_2 =>
Item_Size := Type_Size (NV); Item_Size := Type_Size (NV);
Length_1 := Rand_Tab_Len_1; Length_1 := T1_Len;
Length_2 := Rand_Tab_Len_2; Length_2 := T2_Len;
when Graph_Table => when Graph_Table =>
Item_Size := Type_Size (NK); Item_Size := Type_Size (NK);
...@@ -873,11 +882,25 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -873,11 +882,25 @@ package body GNAT.Perfect_Hash_Generators is
procedure Finalize is procedure Finalize is
begin begin
Free_Tmp_Tables;
WT.Release; WT.Release;
IT.Release; IT.Release;
NK := 0;
Max_Key_Len := 0;
Min_Key_Len := Max_Word_Length;
end Finalize;
---------------------
-- Free_Tmp_Tables --
---------------------
procedure Free_Tmp_Tables is
begin
IT.Init;
Keys := No_Table; Keys := No_Table;
NK := 0;
Char_Pos_Set := No_Table; Char_Pos_Set := No_Table;
Char_Pos_Set_Len := 0; Char_Pos_Set_Len := 0;
...@@ -888,34 +911,34 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -888,34 +911,34 @@ package body GNAT.Perfect_Hash_Generators is
T1 := No_Table; T1 := No_Table;
T2 := No_Table; T2 := No_Table;
Rand_Tab_Len_1 := 0; T1_Len := 0;
Rand_Tab_Len_2 := 0; T2_Len := 0;
G := No_Table; G := No_Table;
Graph_Len := 0; G_Len := 0;
Edges := No_Table; Edges := No_Table;
Edges_Len := 0; Edges_Len := 0;
Vertices := No_Table; Vertices := No_Table;
NV := 0; NV := 0;
end Finalize; end Free_Tmp_Tables;
---------------------------- ----------------------------
-- Generate_Mapping_Table -- -- Generate_Mapping_Table --
---------------------------- ----------------------------
procedure Generate_Mapping_Table procedure Generate_Mapping_Table
(T : Integer; (Tab : Integer;
L1 : Natural; L1 : Natural;
L2 : Natural; L2 : Natural;
S : in out Natural) Seed : in out Natural)
is is
begin begin
for J in 0 .. L1 - 1 loop for J in 0 .. L1 - 1 loop
for K in 0 .. L2 - 1 loop for K in 0 .. L2 - 1 loop
Random (S); Random (Seed);
Set_Rand_Tab (T, J, K, S mod NV); Set_Table (Tab, J, K, Seed mod NV);
end loop; end loop;
end loop; end loop;
end Generate_Mapping_Table; end Generate_Mapping_Table;
...@@ -925,12 +948,12 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -925,12 +948,12 @@ package body GNAT.Perfect_Hash_Generators is
----------------------------- -----------------------------
procedure Generate_Mapping_Tables procedure Generate_Mapping_Tables
(Opt : Optimization; (Opt : Optimization;
S : in out Natural) Seed : in out Natural)
is is
begin begin
-- If T1 and T2 are already allocated no need to do it -- If T1 and T2 are already allocated no need to do it twice. Reuse them
-- twice. Reuse them as their size has not changes. -- as their size has not changed.
if T1 = No_Table and then T2 = No_Table then if T1 = No_Table and then T2 = No_Table then
declare declare
...@@ -948,22 +971,22 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -948,22 +971,22 @@ package body GNAT.Perfect_Hash_Generators is
end loop; end loop;
end if; end if;
Rand_Tab_Len_1 := Char_Pos_Set_Len; T1_Len := Char_Pos_Set_Len;
Rand_Tab_Len_2 := Used_Char_Last + 1; T2_Len := Used_Char_Last + 1;
T1 := Allocate (Rand_Tab_Len_1 * Rand_Tab_Len_2, T1 := Allocate (T1_Len * T2_Len);
Rand_Tab_Item_Size); T2 := Allocate (T1_Len * T2_Len);
T2 := Allocate (Rand_Tab_Len_1 * Rand_Tab_Len_2,
Rand_Tab_Item_Size);
end; end;
end if; end if;
Generate_Mapping_Table (T1, Rand_Tab_Len_1, Rand_Tab_Len_2, S); Generate_Mapping_Table (T1, T1_Len, T2_Len, Seed);
Generate_Mapping_Table (T2, Rand_Tab_Len_1, Rand_Tab_Len_2, S); Generate_Mapping_Table (T2, T1_Len, T2_Len, Seed);
if Verbose then if Verbose then
Put_Used_Char_Set (Output, "Used Character Set"); Put_Used_Char_Set (Output, "Used Character Set");
Put_Int_Matrix (Output, "Function Table 1", T1); Put_Int_Matrix (Output, "Function Table 1", T1,
Put_Int_Matrix (Output, "Function Table 2", T2); T1_Len, T2_Len);
Put_Int_Matrix (Output, "Function Table 2", T2,
T1_Len, T2_Len);
end if; end if;
end Generate_Mapping_Tables; end Generate_Mapping_Tables;
...@@ -973,7 +996,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -973,7 +996,6 @@ package body GNAT.Perfect_Hash_Generators is
function Get_Char_Pos (P : Natural) return Natural is function Get_Char_Pos (P : Natural) return Natural is
N : constant Natural := Char_Pos_Set + P; N : constant Natural := Char_Pos_Set + P;
begin begin
return IT.Table (N); return IT.Table (N);
end Get_Char_Pos; end Get_Char_Pos;
...@@ -985,7 +1007,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -985,7 +1007,6 @@ package body GNAT.Perfect_Hash_Generators is
function Get_Edges (F : Natural) return Edge_Type is function Get_Edges (F : Natural) return Edge_Type is
N : constant Natural := Edges + (F * Edge_Size); N : constant Natural := Edges + (F * Edge_Size);
E : Edge_Type; E : Edge_Type;
begin begin
E.X := IT.Table (N); E.X := IT.Table (N);
E.Y := IT.Table (N + 1); E.Y := IT.Table (N + 1);
...@@ -997,46 +1018,38 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -997,46 +1018,38 @@ package body GNAT.Perfect_Hash_Generators is
-- Get_Graph -- -- Get_Graph --
--------------- ---------------
function Get_Graph (F : Natural) return Integer is function Get_Graph (N : Natural) return Integer is
N : constant Natural := G + F * Graph_Item_Size;
begin begin
return IT.Table (N); return IT.Table (G + N);
end Get_Graph; end Get_Graph;
------------- -------------
-- Get_Key -- -- Get_Key --
------------- -------------
function Get_Key (F : Key_Id) return Key_Type is function Get_Key (N : Key_Id) return Key_Type is
N : constant Natural := Keys + F * Key_Size;
K : Key_Type; K : Key_Type;
begin begin
K.Edge := IT.Table (N); K.Edge := IT.Table (Keys + N);
return K; return K;
end Get_Key; end Get_Key;
------------------ ---------------
-- Get_Rand_Tab -- -- Get_Table --
------------------ ---------------
function Get_Rand_Tab (T : Integer; X, Y : Natural) return Natural is
N : constant Natural :=
T + ((Y * Rand_Tab_Len_1) + X) * Rand_Tab_Item_Size;
function Get_Table (T : Integer; X, Y : Natural) return Natural is
N : constant Natural := T + (Y * T1_Len) + X;
begin begin
return IT.Table (N); return IT.Table (N);
end Get_Rand_Tab; end Get_Table;
------------------- -------------------
-- Get_Used_Char -- -- Get_Used_Char --
------------------- -------------------
function Get_Used_Char (C : Character) return Natural is function Get_Used_Char (C : Character) return Natural is
N : constant Natural := N : constant Natural := Used_Char_Set + Character'Pos (C);
Used_Char_Set + Character'Pos (C) * Used_Char_Size;
begin begin
return IT.Table (N); return IT.Table (N);
end Get_Used_Char; end Get_Used_Char;
...@@ -1048,7 +1061,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1048,7 +1061,6 @@ package body GNAT.Perfect_Hash_Generators is
function Get_Vertices (F : Natural) return Vertex_Type is function Get_Vertices (F : Natural) return Vertex_Type is
N : constant Natural := Vertices + (F * Vertex_Size); N : constant Natural := Vertices + (F * Vertex_Size);
V : Vertex_Type; V : Vertex_Type;
begin begin
V.First := IT.Table (N); V.First := IT.Table (N);
V.Last := IT.Table (N + 1); V.Last := IT.Table (N + 1);
...@@ -1135,22 +1147,24 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1135,22 +1147,24 @@ package body GNAT.Perfect_Hash_Generators is
procedure Initialize procedure Initialize
(Seed : Natural; (Seed : Natural;
K_To_V : Float := Default_K_To_V; K_To_V : Float := Default_K_To_V;
Optim : Optimization := CPU_Time) Optim : Optimization := CPU_Time;
Tries : Positive := Default_Tries)
is is
begin begin
WT.Init; -- Free previous tables (the settings may have changed between two runs)
IT.Init;
S := Seed;
Keys := No_Table; Free_Tmp_Tables;
NK := 0;
Char_Pos_Set := No_Table; if K_To_V <= 2.0 then
Char_Pos_Set_Len := 0; Put (Output, "K to V ratio cannot be lower than 2.0");
New_Line (Output);
raise Program_Error;
end if;
K2V := K_To_V; S := Seed;
Opt := Optim; K2V := K_To_V;
MKL := 0; Opt := Optim;
NT := Tries;
end Initialize; end Initialize;
------------ ------------
...@@ -1170,8 +1184,19 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1170,8 +1184,19 @@ package body GNAT.Perfect_Hash_Generators is
NK := NK + 1; NK := NK + 1;
NV := Natural (Float (NK) * K2V); NV := Natural (Float (NK) * K2V);
if MKL < Len then -- Do not accept a value of K2V too close to 2.0 such that once rounded
MKL := Len; -- up, NV = 2 * NK because the algorithm would not converge.
if NV <= 2 * NK then
NV := 2 * NK + 1;
end if;
if Max_Key_Len < Len then
Max_Key_Len := Len;
end if;
if Len < Min_Key_Len then
Min_Key_Len := Len;
end if; end if;
end Insert; end Insert;
...@@ -1179,11 +1204,9 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1179,11 +1204,9 @@ package body GNAT.Perfect_Hash_Generators is
-- New_Line -- -- New_Line --
-------------- --------------
procedure New_Line (F : File_Descriptor) is procedure New_Line (File : File_Descriptor) is
EOL : constant Character := ASCII.LF;
begin begin
if Write (F, EOL'Address, 1) /= 1 then if Write (File, EOL'Address, 1) /= 1 then
raise Program_Error; raise Program_Error;
end if; end if;
end New_Line; end New_Line;
...@@ -1195,7 +1218,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1195,7 +1218,7 @@ package body GNAT.Perfect_Hash_Generators is
procedure Parse_Position_Selection (Argument : String) is procedure Parse_Position_Selection (Argument : String) is
N : Natural := Argument'First; N : Natural := Argument'First;
L : constant Natural := Argument'Last; L : constant Natural := Argument'Last;
M : constant Natural := MKL; M : constant Natural := Max_Key_Len;
T : array (1 .. M) of Boolean := (others => False); T : array (1 .. M) of Boolean := (others => False);
...@@ -1206,8 +1229,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1206,8 +1229,7 @@ package body GNAT.Perfect_Hash_Generators is
-- Parse_Index -- -- Parse_Index --
----------------- -----------------
function Parse_Index return Natural function Parse_Index return Natural is
is
C : Character := Argument (N); C : Character := Argument (N);
V : Natural := 0; V : Natural := 0;
...@@ -1235,13 +1257,12 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1235,13 +1257,12 @@ package body GNAT.Perfect_Hash_Generators is
-- Start of processing for Parse_Position_Selection -- Start of processing for Parse_Position_Selection
begin begin
Char_Pos_Set_Len := 2 * NK;
-- Empty specification means all the positions -- Empty specification means all the positions
if L < N then if L < N then
Char_Pos_Set_Len := M; Char_Pos_Set_Len := M;
Char_Pos_Set := Allocate (Char_Pos_Set_Len, Char_Pos_Size); Char_Pos_Set := Allocate (Char_Pos_Set_Len);
for C in 0 .. Char_Pos_Set_Len - 1 loop for C in 0 .. Char_Pos_Set_Len - 1 loop
Set_Char_Pos (C, C + 1); Set_Char_Pos (C, C + 1);
...@@ -1292,7 +1313,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1292,7 +1313,7 @@ package body GNAT.Perfect_Hash_Generators is
-- Fill position selection -- Fill position selection
Char_Pos_Set_Len := N; Char_Pos_Set_Len := N;
Char_Pos_Set := Allocate (Char_Pos_Set_Len, Char_Pos_Size); Char_Pos_Set := Allocate (Char_Pos_Set_Len);
N := 0; N := 0;
for J in T'Range loop for J in T'Range loop
...@@ -1312,34 +1333,42 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1312,34 +1333,42 @@ package body GNAT.Perfect_Hash_Generators is
File : File_Descriptor; File : File_Descriptor;
Status : Boolean; Status : Boolean;
-- For call to Close; -- For call to Close
function Type_Img (L : Natural) return String; function Array_Img (N, T, R1 : String; R2 : String := "") return String;
-- Return the larger unsigned type T such that T'Last < L -- Return string "N : constant array (R1[, R2]) of T;"
function Range_Img (F, L : Natural; T : String := "") return String; function Range_Img (F, L : Natural; T : String := "") return String;
-- Return string "[T range ]F .. L" -- Return string "[T range ]F .. L"
function Array_Img (N, T, R1 : String; R2 : String := "") return String; function Type_Img (L : Natural) return String;
-- Return string "N : constant array (R1[, R2]) of T;" -- Return the larger unsigned type T such that T'Last < L
--------------
-- Type_Img --
--------------
function Type_Img (L : Natural) return String is ---------------
S : constant String := Image (Type_Size (L)); -- Array_Img --
U : String := "Unsigned_ "; ---------------
N : Natural := 9;
function Array_Img
(N, T, R1 : String;
R2 : String := "") return String
is
begin begin
for J in S'Range loop Last := 0;
N := N + 1; Add (" ");
U (N) := S (J); Add (N);
end loop; Add (" : constant array (");
Add (R1);
return U (1 .. N); if R2 /= "" then
end Type_Img; Add (", ");
Add (R2);
end if;
Add (") of ");
Add (T);
Add (" :=");
return Line (1 .. Last);
end Array_Img;
--------------- ---------------
-- Range_Img -- -- Range_Img --
...@@ -1371,32 +1400,23 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1371,32 +1400,23 @@ package body GNAT.Perfect_Hash_Generators is
return RI (1 .. Len); return RI (1 .. Len);
end Range_Img; end Range_Img;
--------------- --------------
-- Array_Img -- -- Type_Img --
--------------- --------------
function Array_Img function Type_Img (L : Natural) return String is
(N, T, R1 : String; S : constant String := Image (Type_Size (L));
R2 : String := "") U : String := "Unsigned_ ";
return String N : Natural := 9;
is
begin
Last := 0;
Add (" ");
Add (N);
Add (" : constant array (");
Add (R1);
if R2 /= "" then begin
Add (", "); for J in S'Range loop
Add (R2); N := N + 1;
end if; U (N) := S (J);
end loop;
Add (") of "); return U (1 .. N);
Add (T); end Type_Img;
Add (" :=");
return Line (1 .. Last);
end Array_Img;
F : Natural; F : Natural;
L : Natural; L : Natural;
...@@ -1460,7 +1480,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1460,7 +1480,7 @@ package body GNAT.Perfect_Hash_Generators is
for J in Character'Range loop for J in Character'Range loop
P := Get_Used_Char (J); P := Get_Used_Char (J);
Put (File, Image (P), 0, 0, 0, F, L, Character'Pos (J)); Put (File, Image (P), 1, 0, 1, F, L, Character'Pos (J));
end loop; end loop;
New_Line (File); New_Line (File);
...@@ -1473,7 +1493,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1473,7 +1493,7 @@ package body GNAT.Perfect_Hash_Generators is
New_Line (File); New_Line (File);
for J in F .. L loop for J in F .. L loop
Put (File, Image (Get_Char_Pos (J)), 0, 0, 0, F, L, J); Put (File, Image (Get_Char_Pos (J)), 1, 0, 1, F, L, J);
end loop; end loop;
New_Line (File); New_Line (File);
...@@ -1482,17 +1502,16 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1482,17 +1502,16 @@ package body GNAT.Perfect_Hash_Generators is
Put_Int_Matrix Put_Int_Matrix
(File, (File,
Array_Img ("T1", Type_Img (NV), Array_Img ("T1", Type_Img (NV),
Range_Img (0, Rand_Tab_Len_1 - 1), Range_Img (0, T1_Len - 1),
Range_Img (0, Rand_Tab_Len_2 - 1, Range_Img (0, T2_Len - 1, Type_Img (256))),
Type_Img (256))), T1, T1_Len, T2_Len);
T1);
else else
Put_Int_Matrix Put_Int_Matrix
(File, (File,
Array_Img ("T1", Type_Img (NV), Array_Img ("T1", Type_Img (NV),
Range_Img (0, Rand_Tab_Len_1 - 1)), Range_Img (0, T1_Len - 1)),
T1); T1, T1_Len, 0);
end if; end if;
New_Line (File); New_Line (File);
...@@ -1501,17 +1520,16 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1501,17 +1520,16 @@ package body GNAT.Perfect_Hash_Generators is
Put_Int_Matrix Put_Int_Matrix
(File, (File,
Array_Img ("T2", Type_Img (NV), Array_Img ("T2", Type_Img (NV),
Range_Img (0, Rand_Tab_Len_1 - 1), Range_Img (0, T1_Len - 1),
Range_Img (0, Rand_Tab_Len_2 - 1, Range_Img (0, T2_Len - 1, Type_Img (256))),
Type_Img (256))), T2, T1_Len, T2_Len);
T2);
else else
Put_Int_Matrix Put_Int_Matrix
(File, (File,
Array_Img ("T2", Type_Img (NV), Array_Img ("T2", Type_Img (NV),
Range_Img (0, Rand_Tab_Len_1 - 1)), Range_Img (0, T1_Len - 1)),
T2); T2, T1_Len, 0);
end if; end if;
New_Line (File); New_Line (File);
...@@ -1519,8 +1537,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1519,8 +1537,8 @@ package body GNAT.Perfect_Hash_Generators is
Put_Int_Vector Put_Int_Vector
(File, (File,
Array_Img ("G", Type_Img (NK), Array_Img ("G", Type_Img (NK),
Range_Img (0, Graph_Len - 1)), Range_Img (0, G_Len - 1)),
G, Graph_Len); G, G_Len);
New_Line (File); New_Line (File);
Put (File, " function Hash (S : String) return Natural is"); Put (File, " function Hash (S : String) return Natural is");
...@@ -1621,11 +1639,11 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1621,11 +1639,11 @@ package body GNAT.Perfect_Hash_Generators is
-- Put -- -- Put --
--------- ---------
procedure Put (F : File_Descriptor; S : String) is procedure Put (File : File_Descriptor; Str : String) is
Len : constant Natural := S'Length; Len : constant Natural := Str'Length;
begin begin
if Write (F, S'Address, Len) /= Len then if Write (File, Str'Address, Len) /= Len then
raise Program_Error; raise Program_Error;
end if; end if;
end Put; end Put;
...@@ -1647,6 +1665,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1647,6 +1665,7 @@ package body GNAT.Perfect_Hash_Generators is
Len : constant Natural := S'Length; Len : constant Natural := S'Length;
procedure Flush; procedure Flush;
-- Write current line, followed by LF
----------- -----------
-- Flush -- -- Flush --
...@@ -1674,9 +1693,12 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1674,9 +1693,12 @@ package body GNAT.Perfect_Hash_Generators is
Line (Last + 1 .. Last + 5) := " "; Line (Last + 1 .. Last + 5) := " ";
Last := Last + 5; Last := Last + 5;
if F1 /= L1 then if F1 <= L1 then
if C1 = F1 and then C2 = F2 then if C1 = F1 and then C2 = F2 then
Add ('('); Add ('(');
if F1 = L1 then
Add ("0 .. 0 => ");
end if;
else else
Add (' '); Add (' ');
end if; end if;
...@@ -1685,6 +1707,9 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1685,6 +1707,9 @@ package body GNAT.Perfect_Hash_Generators is
if C2 = F2 then if C2 = F2 then
Add ('('); Add ('(');
if F2 = L2 then
Add ("0 .. 0 => ");
end if;
else else
Add (' '); Add (' ');
end if; end if;
...@@ -1695,7 +1720,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1695,7 +1720,7 @@ package body GNAT.Perfect_Hash_Generators is
if C2 = L2 then if C2 = L2 then
Add (')'); Add (')');
if F1 = L1 then if F1 > L1 then
Add (';'); Add (';');
Flush; Flush;
elsif C1 /= L1 then elsif C1 /= L1 then
...@@ -1712,56 +1737,91 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1712,56 +1737,91 @@ package body GNAT.Perfect_Hash_Generators is
end if; end if;
end Put; end Put;
----------------------- ---------------
-- Put_Used_Char_Set -- -- Put_Edges --
----------------------- ---------------
procedure Put_Used_Char_Set procedure Put_Edges
(File : File_Descriptor; (File : File_Descriptor;
Title : String) Title : String)
is is
F : constant Natural := Character'Pos (Character'First); E : Edge_Type;
L : constant Natural := Character'Pos (Character'Last); F1 : constant Natural := 1;
L1 : constant Natural := Edges_Len - 1;
M : constant Natural := Max / 5;
begin begin
Put (File, Title); Put (File, Title);
New_Line (File); New_Line (File);
for J in Character'Range loop -- Edges valid range is 1 .. Edge_Len - 1
Put
(File, Image (Get_Used_Char (J)), 0, 0, 0, F, L, Character'Pos (J)); for J in F1 .. L1 loop
E := Get_Edges (J);
Put (File, Image (J, M), F1, L1, J, 1, 4, 1);
Put (File, Image (E.X, M), F1, L1, J, 1, 4, 2);
Put (File, Image (E.Y, M), F1, L1, J, 1, 4, 3);
Put (File, Image (E.Key, M), F1, L1, J, 1, 4, 4);
end loop; end loop;
end Put_Used_Char_Set; end Put_Edges;
---------- ----------------------
-- Put -- -- Put_Initial_Keys --
---------- ----------------------
procedure Put_Initial_Keys
(File : File_Descriptor;
Title : String)
is
F1 : constant Natural := 0;
L1 : constant Natural := NK - 1;
M : constant Natural := Max / 5;
K : Key_Type;
begin
Put (File, Title);
New_Line (File);
for J in F1 .. L1 loop
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, WT.Table (Initial (J)), F1, L1, J, 1, 3, 3);
end loop;
end Put_Initial_Keys;
--------------------
-- Put_Int_Matrix --
--------------------
procedure Put_Int_Matrix procedure Put_Int_Matrix
(File : File_Descriptor; (File : File_Descriptor;
Title : String; Title : String;
Table : Integer) Table : Integer;
Len_1 : Natural;
Len_2 : Natural)
is is
F1 : constant Natural := 0; F1 : constant Integer := 0;
L1 : constant Natural := Rand_Tab_Len_1 - 1; L1 : constant Integer := Len_1 - 1;
F2 : constant Natural := 0; F2 : constant Integer := 0;
L2 : constant Natural := Rand_Tab_Len_2 - 1; L2 : constant Integer := Len_2 - 1;
I : Natural;
begin begin
Put (File, Title); Put (File, Title);
New_Line (File); New_Line (File);
if L2 = F2 then if Len_2 = 0 then
for J in F1 .. L1 loop for J in F1 .. L1 loop
Put (File, I := IT.Table (Table + J);
Image (Get_Rand_Tab (Table, J, F2)), 0, 0, 0, F1, L1, J); Put (File, Image (I), 1, 0, 1, F1, L1, J);
end loop; end loop;
else else
for J in F1 .. L1 loop for J in F1 .. L1 loop
for K in F2 .. L2 loop for K in F2 .. L2 loop
Put (File, I := IT.Table (Table + J + K * Len_1);
Image (Get_Rand_Tab (Table, J, K)), F1, L1, J, F2, L2, K); Put (File, Image (I), F1, L1, J, F2, L2, K);
end loop; end loop;
end loop; end loop;
end if; end if;
...@@ -1774,7 +1834,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1774,7 +1834,7 @@ package body GNAT.Perfect_Hash_Generators is
procedure Put_Int_Vector procedure Put_Int_Vector
(File : File_Descriptor; (File : File_Descriptor;
Title : String; Title : String;
Root : Integer; Vector : Integer;
Length : Natural) Length : Natural)
is is
F2 : constant Natural := 0; F2 : constant Natural := 0;
...@@ -1785,43 +1845,15 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1785,43 +1845,15 @@ package body GNAT.Perfect_Hash_Generators is
New_Line (File); New_Line (File);
for J in F2 .. L2 loop for J in F2 .. L2 loop
Put (File, Image (IT.Table (Root + J)), 0, 0, 0, F2, L2, J); Put (File, Image (IT.Table (Vector + J)), 1, 0, 1, F2, L2, J);
end loop; end loop;
end Put_Int_Vector; end Put_Int_Vector;
--------------- ----------------------
-- Put_Edges -- -- Put_Reduced_Keys --
--------------- ----------------------
procedure Put_Edges
(File : File_Descriptor;
Title : String)
is
E : Edge_Type;
F1 : constant Natural := 1;
L1 : constant Natural := Edges_Len - 1;
M : constant Natural := Max / 5;
begin
Put (File, Title);
New_Line (File);
-- Edges valid range is 1 .. Edge_Len - 1
for J in F1 .. L1 loop
E := Get_Edges (J);
Put (File, Image (J, M), F1, L1, J, 1, 4, 1);
Put (File, Image (E.X, M), F1, L1, J, 1, 4, 2);
Put (File, Image (E.Y, M), F1, L1, J, 1, 4, 3);
Put (File, Image (E.Key, M), F1, L1, J, 1, 4, 4);
end loop;
end Put_Edges;
---------------------------
-- Put_Initial_Keys --
---------------------------
procedure Put_Initial_Keys procedure Put_Reduced_Keys
(File : File_Descriptor; (File : File_Descriptor;
Title : String) Title : String)
is is
...@@ -1838,34 +1870,30 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1838,34 +1870,30 @@ package body GNAT.Perfect_Hash_Generators is
K := Get_Key (J); K := Get_Key (J);
Put (File, Image (J, M), F1, L1, J, 1, 3, 1); 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, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
Put (File, WT.Table (Initial (J)), F1, L1, J, 1, 3, 3); Put (File, WT.Table (Reduced (J)), F1, L1, J, 1, 3, 3);
end loop; end loop;
end Put_Initial_Keys; end Put_Reduced_Keys;
--------------------------- -----------------------
-- Put_Reduced_Keys -- -- Put_Used_Char_Set --
--------------------------- -----------------------
procedure Put_Reduced_Keys procedure Put_Used_Char_Set
(File : File_Descriptor; (File : File_Descriptor;
Title : String) Title : String)
is is
F1 : constant Natural := 0; F : constant Natural := Character'Pos (Character'First);
L1 : constant Natural := NK - 1; L : constant Natural := Character'Pos (Character'Last);
M : constant Natural := Max / 5;
K : Key_Type;
begin begin
Put (File, Title); Put (File, Title);
New_Line (File); New_Line (File);
for J in F1 .. L1 loop for J in Character'Range loop
K := Get_Key (J); Put
Put (File, Image (J, M), F1, L1, J, 1, 3, 1); (File, Image (Get_Used_Char (J)), 1, 0, 1, F, L, Character'Pos (J));
Put (File, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
Put (File, WT.Table (Reduced (J)), F1, L1, J, 1, 3, 3);
end loop; end loop;
end Put_Reduced_Keys; end Put_Used_Char_Set;
---------------------- ----------------------
-- Put_Vertex_Table -- -- Put_Vertex_Table --
...@@ -1898,8 +1926,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1898,8 +1926,8 @@ package body GNAT.Perfect_Hash_Generators is
procedure Random (Seed : in out Natural) procedure Random (Seed : in out Natural)
is is
-- Park & Miller Standard Minimal using Schrage's algorithm to -- Park & Miller Standard Minimal using Schrage's algorithm to avoid
-- avoid overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1) -- overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1)
R : Natural; R : Natural;
Q : Natural; Q : Natural;
...@@ -1923,40 +1951,10 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1923,40 +1951,10 @@ package body GNAT.Perfect_Hash_Generators is
function Reduced (K : Key_Id) return Word_Id is function Reduced (K : Key_Id) return Word_Id is
begin begin
return K + NK; return K + NK + 1;
end Reduced; end Reduced;
-------------------------- --------------------------
-- Select_Character_Set --
--------------------------
procedure Select_Character_Set
is
Last : Natural := 0;
Used : array (Character) of Boolean := (others => False);
begin
for J in 0 .. NK - 1 loop
for K in 1 .. Max_Word_Length loop
exit when WT.Table (Initial (J))(K) = ASCII.NUL;
Used (WT.Table (Initial (J))(K)) := True;
end loop;
end loop;
Used_Char_Set_Len := 256;
Used_Char_Set := Allocate (Used_Char_Set_Len, Used_Char_Size);
for J in Used'Range loop
if Used (J) then
Set_Used_Char (J, Last);
Last := Last + 1;
else
Set_Used_Char (J, 0);
end if;
end loop;
end Select_Character_Set;
--------------------------
-- Select_Char_Position -- -- Select_Char_Position --
-------------------------- --------------------------
...@@ -1968,21 +1966,21 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1968,21 +1966,21 @@ package body GNAT.Perfect_Hash_Generators is
(Table : in out Vertex_Table_Type; (Table : in out Vertex_Table_Type;
Last : in out Natural; Last : in out Natural;
Pos : in Natural); Pos : in Natural);
-- Build a list of keys subsets that are identical with the -- Build a list of keys subsets that are identical with the current
-- current position selection plus Pos. Once this routine is -- position selection plus Pos. Once this routine is called, reduced
-- called, reduced words are sorted by subsets and each item -- words are sorted by subsets and each item (First, Last) in Sets
-- (First, Last) in Sets defines the range of identical keys. -- defines the range of identical keys.
function Count_Identical_Keys function Count_Different_Keys
(Table : Vertex_Table_Type; (Table : Vertex_Table_Type;
Last : Natural; Last : Natural;
Pos : Natural) Pos : Natural) return Natural;
return Natural; -- For each subset in Sets, count the number of different keys if we add
-- For each subset in Sets, count the number of identical keys -- Pos to the current position selection.
-- if we add Pos to the current position selection.
Sel_Position : IT.Table_Type (1 .. Max_Key_Len);
Sel_Position : IT.Table_Type (1 .. MKL);
Last_Sel_Pos : Natural := 0; Last_Sel_Pos : Natural := 0;
Max_Sel_Pos : Natural := 0;
------------------------------- -------------------------------
-- Build_Identical_Keys_Sets -- -- Build_Identical_Keys_Sets --
...@@ -2001,123 +1999,122 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2001,123 +1999,122 @@ package body GNAT.Perfect_Hash_Generators is
L : Integer; L : Integer;
-- First and last words of a subset -- First and last words of a subset
begin Offset : Natural;
Last := 0; -- GNAT.Heap_Sort assumes that the first array index is 1. Offset
-- defines the translation to operate.
-- For each subset in S, extract the new subsets we have by function Lt (L, R : Natural) return Boolean;
-- adding C in the position selection. procedure Move (From : Natural; To : Natural);
-- Subprograms needed by GNAT.Heap_Sort_A
for J in S'Range loop --------
declare -- Lt --
Offset : Natural; --------
-- GNAT.Heap_Sort assumes that the first array index
-- is 1. Offset defines the translation to operate.
procedure Move (From : Natural; To : Natural);
function Lt (L, R : Natural) return Boolean;
-- Subprograms needed by GNAT.Heap_Sort_A
----------
-- Move --
----------
procedure Move (From : Natural; To : Natural) is
Target, Source : Natural;
begin
if From = 0 then
Source := 0;
Target := Offset + To;
elsif To = 0 then
Source := Offset + From;
Target := 0;
else
Source := Offset + From;
Target := Offset + To;
end if;
WT.Table (Reduced (Target)) := WT.Table (Reduced (Source)); function Lt (L, R : Natural) return Boolean is
end Move; C : constant Natural := Pos;
Left : Natural;
-------- Right : Natural;
-- Lt --
--------
function Lt (L, R : Natural) return Boolean is
C : constant Natural := Pos;
Left : Natural;
Right : Natural;
begin
if L = 0 then
Left := 0;
Right := Offset + R;
elsif R = 0 then
Left := Offset + L;
Right := 0;
else
Left := Offset + L;
Right := Offset + R;
end if;
return WT.Table (Reduced (Left))(C) begin
< WT.Table (Reduced (Right))(C); if L = 0 then
end Lt; Left := Reduced (0) - 1;
Right := Offset + R;
elsif R = 0 then
Left := Offset + L;
Right := Reduced (0) - 1;
else
Left := Offset + L;
Right := Offset + R;
end if;
-- Start of processing for Build_Identical_Key_Sets return WT.Table (Left)(C) < WT.Table (Right)(C);
end Lt;
begin ----------
Offset := S (J).First - 1; -- Move --
----------
procedure Move (From : Natural; To : Natural) is
Target, Source : Natural;
begin
if From = 0 then
Source := Reduced (0) - 1;
Target := Offset + To;
elsif To = 0 then
Source := Offset + From;
Target := Reduced (0) - 1;
else
Source := Offset + From;
Target := Offset + To;
end if;
WT.Table (Target) := WT.Table (Source);
end Move;
-- Start of processing for Build_Identical_Key_Sets
begin
Last := 0;
-- For each subset in S, extract the new subsets we have by adding C
-- in the position selection.
for J in S'Range loop
if S (J).First = S (J).Last then
F := S (J).First;
L := S (J).Last;
Last := Last + 1;
Table (Last) := (F, L);
else
Offset := Reduced (S (J).First) - 1;
Sort Sort
(S (J).Last - S (J).First + 1, (S (J).Last - S (J).First + 1,
Move'Unrestricted_Access, Move'Unrestricted_Access,
Lt'Unrestricted_Access); Lt'Unrestricted_Access);
F := -1; F := S (J).First;
L := -1; L := F;
for N in S (J).First .. S (J).Last - 1 loop for N in S (J).First .. S (J).Last loop
-- Two contiguous words are identical -- For the last item, close the last subset
if WT.Table (Reduced (N))(C) = if N = S (J).Last then
WT.Table (Reduced (N + 1))(C) Last := Last + 1;
then Table (Last) := (F, N);
-- This is the first word of the subset
if F = -1 then -- Two contiguous words are identical when they have the
F := N; -- same Cth character.
end if;
elsif WT.Table (Reduced (N))(C) =
WT.Table (Reduced (N + 1))(C)
then
L := N + 1; L := N + 1;
-- This is the last word of the subset -- Find a new subset of identical keys. Store the current
-- one and create a new subset.
elsif F /= -1 then else
Last := Last + 1; Last := Last + 1;
Table (Last) := (F, L); Table (Last) := (F, L);
F := -1; F := N + 1;
L := F;
end if; end if;
end loop; end loop;
end if;
-- This is the last word of the subset and of the set
if F /= -1 then
Last := Last + 1;
Table (Last) := (F, L);
end if;
end;
end loop; end loop;
end Build_Identical_Keys_Sets; end Build_Identical_Keys_Sets;
-------------------------- --------------------------
-- Count_Identical_Keys -- -- Count_Different_Keys --
-------------------------- --------------------------
function Count_Identical_Keys function Count_Different_Keys
(Table : Vertex_Table_Type; (Table : Vertex_Table_Type;
Last : Natural; Last : Natural;
Pos : Natural) Pos : Natural) return Natural
return Natural
is is
N : array (Character) of Natural; N : array (Character) of Natural;
C : Character; C : Character;
...@@ -2125,9 +2122,9 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2125,9 +2122,9 @@ package body GNAT.Perfect_Hash_Generators is
begin begin
-- For each subset, count the number of words that are still -- For each subset, count the number of words that are still
-- identical when we include Sel_Position (Last_Sel_Pos) in -- different when we include Pos in the position selection. Only
-- the position selection. Only focus on this position as the -- focus on this position as the other positions already produce
-- other positions already produce identical keys. -- identical keys.
for S in 1 .. Last loop for S in 1 .. Last loop
...@@ -2139,68 +2136,85 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2139,68 +2136,85 @@ package body GNAT.Perfect_Hash_Generators is
N (C) := N (C) + 1; N (C) := N (C) + 1;
end loop; end loop;
-- Add to the total when there are two identical keys -- Update the number of different keys. Each character used
-- denotes a different key.
for J in N'Range loop for J in N'Range loop
if N (J) > 1 then if N (J) > 0 then
T := T + N (J); T := T + 1;
end if; end if;
end loop; end loop;
end loop; end loop;
return T; return T;
end Count_Identical_Keys; end Count_Different_Keys;
-- Start of processing for Select_Char_Position -- Start of processing for Select_Char_Position
begin begin
for C in Sel_Position'Range loop -- Initialize the reduced words set
Sel_Position (C) := C;
end loop;
-- Initialization of Words
WT.Set_Last (2 * NK - 1);
WT.Set_Last (2 * NK);
for K in 0 .. NK - 1 loop for K in 0 .. NK - 1 loop
WT.Table (Reduced (K) + 1) := WT.Table (Initial (K)); WT.Table (Reduced (K)) := WT.Table (Initial (K));
end loop; end loop;
declare declare
Collisions : Natural; Differences : Natural;
Min_Collisions : Natural := NK; Max_Differences : Natural := 0;
Old_Collisions : Natural; Old_Differences : Natural;
Min_Coll_Sel_Pos : Natural := 0; -- init to kill warning Max_Diff_Sel_Pos : Natural := 0; -- init to kill warning
Min_Coll_Sel_Pos_Idx : Natural := 0; -- init to kill warning Max_Diff_Sel_Pos_Idx : Natural := 0; -- init to kill warning
Same_Keys_Sets_Table : Vertex_Table_Type (1 .. NK); Same_Keys_Sets_Table : Vertex_Table_Type (1 .. NK);
Same_Keys_Sets_Last : Natural := 1; Same_Keys_Sets_Last : Natural := 1;
begin begin
Same_Keys_Sets_Table (1) := (1, NK); for C in Sel_Position'Range loop
Sel_Position (C) := C;
end loop;
Same_Keys_Sets_Table (1) := (0, NK - 1);
loop loop
-- Preserve minimum identical keys and check later on -- Preserve maximum number of different keys and check later on
-- that this value is strictly decrementing. Otherwise, -- that this value is strictly incrementing. Otherwise, it means
-- it means that two keys are stricly identical. -- that two keys are stricly identical.
Old_Differences := Max_Differences;
Old_Collisions := Min_Collisions; -- The first position should not exceed the minimum key length.
-- Otherwise, we may end up with an empty word once reduced.
-- Find which position reduces the most of collisions if Last_Sel_Pos = 0 then
Max_Sel_Pos := Min_Key_Len;
else
Max_Sel_Pos := Max_Key_Len;
end if;
for J in Last_Sel_Pos + 1 .. Sel_Position'Last loop -- Find which position increases more the number of differences
Collisions := Count_Identical_Keys
for J in Last_Sel_Pos + 1 .. Max_Sel_Pos loop
Differences := Count_Different_Keys
(Same_Keys_Sets_Table, (Same_Keys_Sets_Table,
Same_Keys_Sets_Last, Same_Keys_Sets_Last,
Sel_Position (J)); Sel_Position (J));
if Collisions < Min_Collisions then if Verbose then
Min_Collisions := Collisions; Put (Output,
Min_Coll_Sel_Pos := Sel_Position (J); "Selecting position" & Sel_Position (J)'Img &
Min_Coll_Sel_Pos_Idx := J; " results in" & Differences'Img &
" differences");
New_Line (Output);
end if;
if Differences > Max_Differences then
Max_Differences := Differences;
Max_Diff_Sel_Pos := Sel_Position (J);
Max_Diff_Sel_Pos_Idx := J;
end if; end if;
end loop; end loop;
if Old_Collisions = Min_Collisions then if Old_Differences = Max_Differences then
Raise_Exception Raise_Exception
(Program_Error'Identity, "some keys are identical"); (Program_Error'Identity, "some keys are identical");
end if; end if;
...@@ -2208,43 +2222,95 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2208,43 +2222,95 @@ package body GNAT.Perfect_Hash_Generators is
-- Insert selected position and sort Sel_Position table -- Insert selected position and sort Sel_Position table
Last_Sel_Pos := Last_Sel_Pos + 1; Last_Sel_Pos := Last_Sel_Pos + 1;
Sel_Position (Last_Sel_Pos + 1 .. Min_Coll_Sel_Pos_Idx) := Sel_Position (Last_Sel_Pos + 1 .. Max_Diff_Sel_Pos_Idx) :=
Sel_Position (Last_Sel_Pos .. Min_Coll_Sel_Pos_Idx - 1); Sel_Position (Last_Sel_Pos .. Max_Diff_Sel_Pos_Idx - 1);
Sel_Position (Last_Sel_Pos) := Min_Coll_Sel_Pos; Sel_Position (Last_Sel_Pos) := Max_Diff_Sel_Pos;
for P in 1 .. Last_Sel_Pos - 1 loop for P in 1 .. Last_Sel_Pos - 1 loop
if Min_Coll_Sel_Pos < Sel_Position (P) then if Max_Diff_Sel_Pos < Sel_Position (P) then
Sel_Position (P + 1 .. Last_Sel_Pos) := Sel_Position (P + 1 .. Last_Sel_Pos) :=
Sel_Position (P .. Last_Sel_Pos - 1); Sel_Position (P .. Last_Sel_Pos - 1);
Sel_Position (P) := Min_Coll_Sel_Pos; Sel_Position (P) := Max_Diff_Sel_Pos;
exit; exit;
end if; end if;
end loop; end loop;
exit when Min_Collisions = 0; exit when Max_Differences = NK;
Build_Identical_Keys_Sets Build_Identical_Keys_Sets
(Same_Keys_Sets_Table, (Same_Keys_Sets_Table,
Same_Keys_Sets_Last, Same_Keys_Sets_Last,
Min_Coll_Sel_Pos); Max_Diff_Sel_Pos);
if Verbose then
Put (Output,
"Selecting position" & Max_Diff_Sel_Pos'Img &
" results in" & Max_Differences'Img &
" differences");
New_Line (Output);
Put (Output, "--");
New_Line (Output);
for J in 1 .. Same_Keys_Sets_Last loop
for K in
Same_Keys_Sets_Table (J).First ..
Same_Keys_Sets_Table (J).Last
loop
Put (Output, WT.Table (Reduced (K)));
New_Line (Output);
end loop;
Put (Output, "--");
New_Line (Output);
end loop;
end if;
end loop; end loop;
end; end;
Char_Pos_Set_Len := Last_Sel_Pos; Char_Pos_Set_Len := Last_Sel_Pos;
Char_Pos_Set := Allocate (Char_Pos_Set_Len, Char_Pos_Size); Char_Pos_Set := Allocate (Char_Pos_Set_Len);
for C in 1 .. Last_Sel_Pos loop for C in 1 .. Last_Sel_Pos loop
Set_Char_Pos (C - 1, Sel_Position (C)); Set_Char_Pos (C - 1, Sel_Position (C));
end loop; end loop;
end Select_Char_Position; end Select_Char_Position;
--------------------------
-- Select_Character_Set --
--------------------------
procedure Select_Character_Set
is
Last : Natural := 0;
Used : array (Character) of Boolean := (others => False);
Char : Character;
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));
exit when Char = ASCII.NUL;
Used (Char) := True;
end loop;
end loop;
Used_Char_Set_Len := 256;
Used_Char_Set := Allocate (Used_Char_Set_Len);
for J in Used'Range loop
if Used (J) then
Set_Used_Char (J, Last);
Last := Last + 1;
else
Set_Used_Char (J, 0);
end if;
end loop;
end Select_Character_Set;
------------------ ------------------
-- Set_Char_Pos -- -- Set_Char_Pos --
------------------ ------------------
procedure Set_Char_Pos (P : Natural; Item : Natural) is procedure Set_Char_Pos (P : Natural; Item : Natural) is
N : constant Natural := Char_Pos_Set + P; N : constant Natural := Char_Pos_Set + P;
begin begin
IT.Table (N) := Item; IT.Table (N) := Item;
end Set_Char_Pos; end Set_Char_Pos;
...@@ -2255,7 +2321,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2255,7 +2321,6 @@ package body GNAT.Perfect_Hash_Generators is
procedure Set_Edges (F : Natural; Item : Edge_Type) is procedure Set_Edges (F : Natural; Item : Edge_Type) is
N : constant Natural := Edges + (F * Edge_Size); N : constant Natural := Edges + (F * Edge_Size);
begin begin
IT.Table (N) := Item.X; IT.Table (N) := Item.X;
IT.Table (N + 1) := Item.Y; IT.Table (N + 1) := Item.Y;
...@@ -2266,44 +2331,36 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2266,44 +2331,36 @@ package body GNAT.Perfect_Hash_Generators is
-- Set_Graph -- -- Set_Graph --
--------------- ---------------
procedure Set_Graph (F : Natural; Item : Integer) is procedure Set_Graph (N : Natural; Item : Integer) is
N : constant Natural := G + (F * Graph_Item_Size);
begin begin
IT.Table (N) := Item; IT.Table (G + N) := Item;
end Set_Graph; end Set_Graph;
------------- -------------
-- Set_Key -- -- Set_Key --
------------- -------------
procedure Set_Key (F : Key_Id; Item : Key_Type) is procedure Set_Key (N : Key_Id; Item : Key_Type) is
N : constant Natural := Keys + F * Key_Size;
begin begin
IT.Table (N) := Item.Edge; IT.Table (Keys + N) := Item.Edge;
end Set_Key; end Set_Key;
------------------ ---------------
-- Set_Rand_Tab -- -- Set_Table --
------------------ ---------------
procedure Set_Rand_Tab (T : Integer; X, Y : Natural; Item : Natural) is
N : constant Natural :=
T + ((Y * Rand_Tab_Len_1) + X) * Rand_Tab_Item_Size;
procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural) is
N : constant Natural := T + ((Y * T1_Len) + X);
begin begin
IT.Table (N) := Item; IT.Table (N) := Item;
end Set_Rand_Tab; end Set_Table;
------------------- -------------------
-- Set_Used_Char -- -- Set_Used_Char --
------------------- -------------------
procedure Set_Used_Char (C : Character; Item : Natural) is procedure Set_Used_Char (C : Character; Item : Natural) is
N : constant Natural := N : constant Natural := Used_Char_Set + Character'Pos (C);
Used_Char_Set + Character'Pos (C) * Used_Char_Size;
begin begin
IT.Table (N) := Item; IT.Table (N) := Item;
end Set_Used_Char; end Set_Used_Char;
...@@ -2314,7 +2371,6 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2314,7 +2371,6 @@ package body GNAT.Perfect_Hash_Generators is
procedure Set_Vertices (F : Natural; Item : Vertex_Type) is procedure Set_Vertices (F : Natural; Item : Vertex_Type) is
N : constant Natural := Vertices + (F * Vertex_Size); N : constant Natural := Vertices + (F * Vertex_Size);
begin begin
IT.Table (N) := Item.First; IT.Table (N) := Item.First;
IT.Table (N + 1) := Item.Last; IT.Table (N + 1) := Item.Last;
...@@ -2327,24 +2383,23 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2327,24 +2383,23 @@ package body GNAT.Perfect_Hash_Generators is
function Sum function Sum
(Word : Word_Type; (Word : Word_Type;
Table : Table_Id; Table : Table_Id;
Opt : Optimization) Opt : Optimization) return Natural
return Natural
is is
S : Natural := 0; S : Natural := 0;
R : Natural; R : Natural;
begin begin
if Opt = CPU_Time then if Opt = CPU_Time then
for J in 0 .. Rand_Tab_Len_1 - 1 loop for J in 0 .. T1_Len - 1 loop
exit when Word (J + 1) = ASCII.NUL; exit when Word (J + 1) = ASCII.NUL;
R := Get_Rand_Tab (Table, J, Get_Used_Char (Word (J + 1))); R := Get_Table (Table, J, Get_Used_Char (Word (J + 1)));
S := (S + R) mod NV; S := (S + R) mod NV;
end loop; end loop;
else else
for J in 0 .. Rand_Tab_Len_1 - 1 loop for J in 0 .. T1_Len - 1 loop
exit when Word (J + 1) = ASCII.NUL; exit when Word (J + 1) = ASCII.NUL;
R := Get_Rand_Tab (Table, J, 0); R := Get_Table (Table, J, 0);
S := (S + R * Character'Pos (Word (J + 1))) mod NV; S := (S + R * Character'Pos (Word (J + 1))) mod NV;
end loop; end loop;
end if; end if;
...@@ -2373,9 +2428,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2373,9 +2428,8 @@ package body GNAT.Perfect_Hash_Generators is
function Value function Value
(Name : Table_Name; (Name : Table_Name;
J : Natural; J : Natural;
K : Natural := 0) K : Natural := 0) return Natural
return Natural
is is
begin begin
case Name is case Name is
...@@ -2386,10 +2440,10 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2386,10 +2440,10 @@ package body GNAT.Perfect_Hash_Generators is
return Get_Used_Char (Character'Val (J)); return Get_Used_Char (Character'Val (J));
when Function_Table_1 => when Function_Table_1 =>
return Get_Rand_Tab (T1, J, K); return Get_Table (T1, J, K);
when Function_Table_2 => when Function_Table_2 =>
return Get_Rand_Tab (T2, J, K); return Get_Table (T2, J, K);
when Graph_Table => when Graph_Table =>
return Get_Graph (J); return Get_Graph (J);
......
gcc/ada/g-pehage.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2002-2004 Ada Core Technologies, Inc. -- -- Copyright (C) 2002-2005 Ada Core Technologies, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -31,122 +31,133 @@ ...@@ -31,122 +31,133 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package provides a generator of static minimal perfect hash -- This package provides a generator of static minimal perfect hash functions.
-- functions. To understand what a perfect hash function is, we -- To understand what a perfect hash function is, we define several notions.
-- define several notions. These definitions are inspired from the -- These definitions are inspired from the following paper:
-- following paper:
-- Zbigniew J. Czech, George Havas, and Bohdan S. Majewski ``An Optimal
-- Zbigniew J. Czech, George Havas, and Bohdan S. Majewski ``An -- Algorithm for Generating Minimal Perfect Hash Functions'', Information
-- Optimal Algorithm for Generating Minimal Perfect Hash Functions'', -- Processing Letters, 43(1992) pp.257-264, Oct.1992
-- Information Processing Letters, 43(1992) pp.257-264, Oct.1992
-- Let W be a set of m words. A hash function h is a function that maps the
-- Let W be a set of m words. A hash function h is a function that -- set of words W into some given interval of integers [0, k-1], where k is an
-- maps the set of words W into some given interval of integers -- integer, usually k >= m. h (w) where is a word computes an address or an
-- [0, k-1], where k is an integer, usually k >= m. h (w) where w -- integer from I for the storage or the retrieval of that item. The storage
-- is a word computes an address or an integer from I for the -- area used to store items is known as a hash table. Words for which the same
-- storage or the retrieval of that item. The storage area used to -- address is computed are called synonyms. Due to the existence of synonyms a
-- store items is known as a hash table. Words for which the same -- situation called collision may arise in which two items w1 and w2 have the
-- address is computed are called synonyms. Due to the existence -- same address. Several schemes for resolving known. A perfect hash function
-- of synonyms a situation called collision may arise in which two -- is an injection from the word set W to the integer interval I with k >= m.
-- items w1 and w2 have the same address. Several schemes for -- If k = m, then h is a minimal perfect hash function. A hash function is
-- resolving known. A perfect hash function is an injection from -- order preserving if it puts entries into the hash table in prespecified
-- the word set W to the integer interval I with k >= m. If k = m, -- order.
-- then h is a minimal perfect hash function. A hash function is
-- order preserving if it puts entries into the hash table in a
-- prespecified order.
-- A minimal perfect hash function is defined by two properties: -- A minimal perfect hash function is defined by two properties:
-- Since no collisions occur each item can be retrieved from the -- Since no collisions occur each item can be retrieved from the table in
-- table in *one* probe. This represents the "perfect" property. -- *one* probe. This represents the "perfect" property.
-- The hash table size corresponds to the exact size of W and -- The hash table size corresponds to the exact size of W and *no larger*.
-- *no larger*. This represents the "minimal" property. -- This represents the "minimal" property.
-- The functions generated by this package require the key set to -- The functions generated by this package require the key set to be known in
-- be known in advance (they are "static" hash functions). -- advance (they are "static" hash functions). The hash functions are also
-- The hash functions are also order preservering. If w2 is inserted -- order preservering. If w2 is inserted after w1 in the generator, then (w1)
-- after w1 in the generator, then f (w1) < f (w2). These hashing -- < f (w2). These hashing functions are convenient for use with realtime
-- functions are convenient for use with realtime applications. -- applications.
package GNAT.Perfect_Hash_Generators is package GNAT.Perfect_Hash_Generators is
Default_K_To_V : constant Float := 2.05; Default_K_To_V : constant Float := 2.05;
-- Default ratio for the algorithm. When K is the number of keys, -- Default ratio for the algorithm. When K is the number of keys, V =
-- V = (K_To_V) * K is the size of the main table of the hash function. -- (K_To_V) * K is the size of the main table of the hash function. To
-- converge, the algorithm requires K_To_V to be stricly greater than 2.0.
Default_Pkg_Name : constant String := "Perfect_Hash"; Default_Pkg_Name : constant String := "Perfect_Hash";
-- Default package name in which the hash function is defined. -- Default package name in which the hash function is defined
Default_Position : constant String := ""; Default_Position : constant String := "";
-- The generator allows selection of the character positions used -- The generator allows selection of the character positions used in the
-- in the hash function. By default, all positions are selected. -- hash function. By default, all positions are selected.
Default_Tries : constant Positive := 20;
-- This algorithm may not succeed to find a possible mapping on the first
-- try and may have to iterate a number of times. This constant bounds the
-- number of tries.
type Optimization is (Memory_Space, CPU_Time); type Optimization is (Memory_Space, CPU_Time);
Default_Optimization : constant Optimization := CPU_Time; Default_Optimization : constant Optimization := CPU_Time;
-- Optimize either the memory space or the execution time. -- Optimize either the memory space or the execution time
Verbose : Boolean := False; Verbose : Boolean := False;
-- Comment required ??? -- Output the status of the algorithm. For instance, the tables, the random
-- graph (edges, vertices) and selected char positions are output between
-- two iterations.
procedure Initialize procedure Initialize
(Seed : Natural; (Seed : Natural;
K_To_V : Float := Default_K_To_V; K_To_V : Float := Default_K_To_V;
Optim : Optimization := CPU_Time); Optim : Optimization := CPU_Time;
-- Initialize the generator and its internal structures. Set the Tries : Positive := Default_Tries);
-- ratio of vertices over keys in the random graphs. This value -- Initialize the generator and its internal structures. Set the ratio of
-- has to be greater than 2.0 in order for the algorithm to succeed. -- vertices over keys in the random graphs. This value has to be greater
-- than 2.0 in order for the algorithm to succeed. The key set is not
-- modified (in particular when it is already set). For instance, it is
-- possible to run several times the generator with different settings on
-- the same key set.
procedure Finalize; procedure Finalize;
-- Deallocate the internal structures. -- Deallocate the internal structures and the key table
procedure Insert (Value : String); procedure Insert (Value : String);
-- Insert a new key in the table. -- Insert a new key in the table
Too_Many_Tries : exception;
-- Raised after Tries unsuccessfull runs
procedure Compute (Position : String := Default_Position); procedure Compute (Position : String := Default_Position);
-- Compute the hash function. Position allows to define a -- Compute the hash function. Position allows to define selection of
-- selection of character positions used in the keywords hash -- character positions used in the keywords hash function. Positions can be
-- function. Positions can be separated by commas and range like -- separated by commas and range like x-y may be used. Character '$'
-- x-y may be used. Character '$' represents the final character -- represents the final character of a key. With an empty position, the
-- of a key. With an empty position, the generator automatically -- generator automatically produces positions to reduce the memory usage.
-- produces positions to reduce the memory usage. -- Raise Too_Many_Tries in case that the algorithm does not succeed in less
-- than Tries attempts (see Initialize).
procedure Produce (Pkg_Name : String := Default_Pkg_Name); procedure Produce (Pkg_Name : String := Default_Pkg_Name);
-- Generate the hash function package Pkg_Name. This package -- Generate the hash function package Pkg_Name. This package includes the
-- includes the minimal perfect Hash function. -- minimal perfect Hash function.
-- The routines and structures defined below allow producing the -- The routines and structures defined below allow producing the hash
-- hash function using a different way from the procedure above. -- function using a different way from the procedure above. The procedure
-- The procedure Define returns the lengths of an internal table -- Define returns the lengths of an internal table and its item type size.
-- and its item type size. The function Value returns the value of -- The function Value returns the value of each item in the table.
-- each item in the table.
-- The hash function has the following form: -- The hash function has the following form:
-- h (w) = (g (f1 (w)) + g (f2 (w))) mod m -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
-- G is a function based on a graph table [0,n-1] -> [0,m-1]. m is -- G is a function based on a graph table [0,n-1] -> [0,m-1]. m is the
-- the number of keys. n is an internally computed value and it -- number of keys. n is an internally computed value and it can be obtained
-- can be obtained as the length of vector G. -- as the length of vector G.
-- F1 and F2 are two functions based on two function tables T1 and -- F1 and F2 are two functions based on two function tables T1 and T2.
-- T2. Their definition depends on the chosen optimization mode. -- Their definition depends on the chosen optimization mode.
-- Only some character positions are used in the keys because they -- Only some character positions are used in the keys because they are
-- are significant. They are listed in a character position table -- significant. They are listed in a character position table (P in the
-- (P in the pseudo-code below). For instance, in {"jan", "feb", -- pseudo-code below). For instance, in {"jan", "feb", "mar", "apr", "jun",
-- "mar", "apr", "jun", "jul", "aug", "sep", "oct", "nov", "dec"}, -- "jul", "aug", "sep", "oct", "nov", "dec"}, only positions 2 and 3 are
-- only positions 2 and 3 are significant (the first character can -- significant (the first character can be ignored). In this example, P =
-- be ignored). In this example, P = {2, 3} -- {2, 3}
-- When Optimization is CPU_Time, the first dimension of T1 and T2 -- When Optimization is CPU_Time, the first dimension of T1 and T2
-- corresponds to the character position in the key and the second -- corresponds to the character position in the key and the second to the
-- to the character set. As all the character set is not used, we -- character set. As all the character set is not used, we define a used
-- define a used character table which associates a distinct index -- character table which associates a distinct index to each used character
-- to each used character (unused characters are mapped to -- (unused characters are mapped to zero). In this case, the second
-- zero). In this case, the second dimension of T1 and T2 is -- dimension of T1 and T2 is reduced to the used character set (C in the
-- reduced to the used character set (C in the pseudo-code -- pseudo-code below). Therefore, the hash function has the following:
-- below). Therefore, the hash function has the following:
-- function Hash (S : String) return Natural is -- function Hash (S : String) return Natural is
-- F : constant Natural := S'First - 1; -- F : constant Natural := S'First - 1;
...@@ -165,11 +176,11 @@ package GNAT.Perfect_Hash_Generators is ...@@ -165,11 +176,11 @@ package GNAT.Perfect_Hash_Generators is
-- return (Natural (G (F1)) + Natural (G (F2))) mod <m>; -- return (Natural (G (F1)) + Natural (G (F2))) mod <m>;
-- end Hash; -- end Hash;
-- When Optimization is Memory_Space, the first dimension of T1 -- When Optimization is Memory_Space, the first dimension of T1 and T2
-- and T2 corresponds to the character position in the key and the -- corresponds to the character position in the key and the second
-- second dimension is ignored. T1 and T2 are no longer matrices -- dimension is ignored. T1 and T2 are no longer matrices but vectors.
-- but vectors. Therefore, the used character table is not -- Therefore, the used character table is not available. The hash function
-- available. The hash function has the following form: -- has the following form:
-- function Hash (S : String) return Natural is -- function Hash (S : String) return Natural is
-- F : constant Natural := S'First - 1; -- F : constant Natural := S'First - 1;
...@@ -200,17 +211,16 @@ package GNAT.Perfect_Hash_Generators is ...@@ -200,17 +211,16 @@ package GNAT.Perfect_Hash_Generators is
Item_Size : out Natural; Item_Size : out Natural;
Length_1 : out Natural; Length_1 : out Natural;
Length_2 : out Natural); Length_2 : out Natural);
-- Return the definition of the table Name. This includes the -- Return the definition of the table Name. This includes the length of
-- length of dimensions 1 and 2 and the size of an unsigned -- dimensions 1 and 2 and the size of an unsigned integer item. When
-- integer item. When Length_2 is zero, the table has only one -- Length_2 is zero, the table has only one dimension. All the ranges start
-- dimension. All the ranges start from zero. -- from zero.
function Value function Value
(Name : Table_Name; (Name : Table_Name;
J : Natural; J : Natural;
K : Natural := 0) K : Natural := 0) return Natural;
return Natural; -- Return the value of the component (I, J) of the table Name. When the
-- Return the value of the component (I, J) of the table -- table has only one dimension, J is ignored.
-- Name. When the table has only one dimension, J is ignored.
end GNAT.Perfect_Hash_Generators; end GNAT.Perfect_Hash_Generators;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment