1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . P E R F E C T _ H A S H _ G E N E R A T O R S --
9 -- Copyright (C) 2002-2007, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada
.Exceptions
; use Ada
.Exceptions
;
35 with Ada
.IO_Exceptions
; use Ada
.IO_Exceptions
;
37 with GNAT
.Heap_Sort_A
; use GNAT
.Heap_Sort_A
;
38 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
41 package body GNAT
.Perfect_Hash_Generators
is
43 -- We are using the algorithm of J. Czech as described in Zbigniew J.
44 -- Czech, George Havas, and Bohdan S. Majewski ``An Optimal Algorithm for
45 -- Generating Minimal Perfect Hash Functions'', Information Processing
46 -- Letters, 43(1992) pp.257-264, Oct.1992
48 -- This minimal perfect hash function generator is based on random graphs
49 -- and produces a hash function of the form:
51 -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
53 -- where f1 and f2 are functions that map strings into integers, and g is a
54 -- function that maps integers into [0, m-1]. h can be order preserving.
55 -- For instance, let W = {w_0, ..., w_i, ...,
56 -- w_m-1}, h can be defined such that h (w_i) = i.
58 -- This algorithm defines two possible constructions of f1 and f2. Method
59 -- b) stores the hash function in less memory space at the expense of
62 -- a) fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
64 -- size (Tk) = max (for w in W) (length (w)) * size (used char set)
66 -- b) fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
68 -- size (Tk) = max (for w in W) (length (w)) but the table lookups are
69 -- replaced by multiplications.
71 -- where Tk values are randomly generated. n is defined later on but the
72 -- algorithm recommends to use a value a little bit greater than 2m. Note
73 -- that for large values of m, the main memory space requirements comes
74 -- from the memory space for storing function g (>= 2m entries).
76 -- Random graphs are frequently used to solve difficult problems that do
77 -- not have polynomial solutions. This algorithm is based on a weighted
78 -- undirected graph. It comprises two steps: mapping and assigment.
80 -- In the mapping step, a graph G = (V, E) is constructed, where = {0, 1,
81 -- ..., n-1} and E = {(for w in W) (f1 (w), f2 (w))}. In order for the
82 -- assignment step to be successful, G has to be acyclic. To have a high
83 -- probability of generating an acyclic graph, n >= 2m. If it is not
84 -- acyclic, Tk have to be regenerated.
86 -- In the assignment step, the algorithm builds function g. As is acyclic,
87 -- there is a vertex v1 with only one neighbor v2. Let w_i be the word such
88 -- that v1 = f1 (w_i) and v2 = f2 (w_i). Let g (v1) = 0 by construction and
89 -- g (v2) = (i - g (v1)) mod n (or to be general, (h (i) - g (v1) mod n).
90 -- If word w_j is such that v2 = f1 (w_j) and v3 = f2 (w_j), g (v3) = (j -
91 -- g (v2)) mod (or to be general, (h (j) - g (v2)) mod n). If w_i has no
92 -- neighbor, then another vertex is selected. The algorithm traverses G to
93 -- assign values to all the vertices. It cannot assign a value to an
94 -- already assigned vertex as G is acyclic.
96 subtype Word_Id
is Integer;
97 subtype Key_Id
is Integer;
98 subtype Vertex_Id
is Integer;
99 subtype Edge_Id
is Integer;
100 subtype Table_Id
is Integer;
102 No_Vertex
: constant Vertex_Id
:= -1;
103 No_Edge
: constant Edge_Id
:= -1;
104 No_Table
: constant Table_Id
:= -1;
106 Max_Word_Length
: constant := 32;
107 subtype Word_Type
is String (1 .. Max_Word_Length
);
108 Null_Word
: constant Word_Type
:= (others => ASCII
.NUL
);
109 -- Store keyword in a word. Note that the length of word is limited to 32
112 type Key_Type
is record
115 -- A key corresponds to an edge in the algorithm graph
117 type Vertex_Type
is record
121 -- A vertex can be involved in several edges. First and Last are the bounds
122 -- of an array of edges stored in a global edge table.
124 type Edge_Type
is record
129 -- An edge is a peer of vertices. In the algorithm, a key is associated to
132 package WT
is new GNAT
.Table
(Word_Type
, Word_Id
, 0, 32, 32);
133 package IT
is new GNAT
.Table
(Integer, Integer, 0, 32, 32);
134 -- The two main tables. IT is used to store several tables of components
135 -- containing only integers.
137 function Image
(Int
: Integer; W
: Natural := 0) return String;
138 function Image
(Str
: String; W
: Natural := 0) return String;
139 -- Return a string which includes string Str or integer Int preceded by
140 -- leading spaces if required by width W.
142 Output
: File_Descriptor
renames GNAT
.OS_Lib
.Standout
;
145 EOL
: constant Character := ASCII
.LF
;
147 Max
: constant := 78;
149 Line
: String (1 .. Max
);
150 -- Use this line to provide buffered IO
152 procedure Add
(C
: Character);
153 procedure Add
(S
: String);
154 -- Add a character or a string in Line and update Last
157 (F
: File_Descriptor
;
165 -- Write string S into file F as a element of an array of one or two
166 -- dimensions. Fk (resp. Lk and Ck) indicates the first (resp last and
167 -- current) index in the k-th dimension. If F1 = L1 the array is considered
168 -- as a one dimension array. This dimension is described by F2 and L2. This
169 -- routine takes care of all the parenthesis, spaces and commas needed to
170 -- format correctly the array. Moreover, the array is well indented and is
171 -- wrapped to fit in a 80 col line. When the line is full, the routine
172 -- writes it into file F. When the array is completed, the routine adds
173 -- semi-colon and writes the line into file F.
175 procedure New_Line
(File
: File_Descriptor
);
176 -- Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib
178 procedure Put
(File
: File_Descriptor
; Str
: String);
179 -- Simulate Ada.Text_IO.Put with GNAT.OS_Lib
181 procedure Put_Used_Char_Set
(File
: File_Descriptor
; Title
: String);
182 -- Output a title and a used character set
184 procedure Put_Int_Vector
185 (File
: File_Descriptor
;
189 -- Output a title and a vector
191 procedure Put_Int_Matrix
192 (File
: File_Descriptor
;
197 -- Output a title and a matrix. When the matrix has only one non-empty
198 -- dimension (Len_2 = 0), output a vector.
200 procedure Put_Edges
(File
: File_Descriptor
; Title
: String);
201 -- Output a title and an edge table
203 procedure Put_Initial_Keys
(File
: File_Descriptor
; Title
: String);
204 -- Output a title and a key table
206 procedure Put_Reduced_Keys
(File
: File_Descriptor
; Title
: String);
207 -- Output a title and a key table
209 procedure Put_Vertex_Table
(File
: File_Descriptor
; Title
: String);
210 -- Output a title and a vertex table
212 ----------------------------------
213 -- Character Position Selection --
214 ----------------------------------
216 -- We reduce the maximum key size by selecting representative positions
217 -- in these keys. We build a matrix with one word per line. We fill the
218 -- remaining space of a line with ASCII.NUL. The heuristic selects the
219 -- position that induces the minimum number of collisions. If there are
220 -- collisions, select another position on the reduced key set responsible
221 -- of the collisions. Apply the heuristic until there is no more collision.
223 procedure Apply_Position_Selection
;
224 -- Apply Position selection and build the reduced key table
226 procedure Parse_Position_Selection
(Argument
: String);
227 -- Parse Argument and compute the position set. Argument is list of
228 -- substrings separated by commas. Each substring represents a position
229 -- or a range of positions (like x-y).
231 procedure Select_Character_Set
;
232 -- Define an optimized used character set like Character'Pos in order not
233 -- to allocate tables of 256 entries.
235 procedure Select_Char_Position
;
236 -- Find a min char position set in order to reduce the max key length. The
237 -- heuristic selects the position that induces the minimum number of
238 -- collisions. If there are collisions, select another position on the
239 -- reduced key set responsible of the collisions. Apply the heuristic until
240 -- there is no collision.
242 -----------------------------
243 -- Random Graph Generation --
244 -----------------------------
246 procedure Random
(Seed
: in out Natural);
247 -- Simulate Ada.Discrete_Numerics.Random
249 procedure Generate_Mapping_Table
253 Seed
: in out Natural);
254 -- Random generation of the tables below. T is already allocated
256 procedure Generate_Mapping_Tables
258 Seed
: in out Natural);
259 -- Generate the mapping tables T1 and T2. They are used to define fk (w) =
260 -- sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n. Keys, NK and Chars
261 -- are used to compute the matrix size.
263 ---------------------------
264 -- Algorithm Computation --
265 ---------------------------
267 procedure Compute_Edges_And_Vertices
(Opt
: Optimization
);
268 -- Compute the edge and vertex tables. These are empty when a self loop is
269 -- detected (f1 (w) = f2 (w)). The edge table is sorted by X value and then
270 -- Y value. Keys is the key table and NK the number of keys. Chars is the
271 -- set of characters really used in Keys. NV is the number of vertices
272 -- recommended by the algorithm. T1 and T2 are the mapping tables needed to
273 -- compute f1 (w) and f2 (w).
275 function Acyclic
return Boolean;
276 -- Return True when the graph is acyclic. Vertices is the current vertex
277 -- table and Edges the current edge table.
279 procedure Assign_Values_To_Vertices
;
280 -- Execute the assignment step of the algorithm. Keys is the current key
281 -- table. Vertices and Edges represent the random graph. G is the result of
282 -- the assignment step such that:
283 -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
288 Opt
: Optimization
) return Natural;
289 -- For an optimization of CPU_Time return
290 -- fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
291 -- For an optimization of Memory_Space return
292 -- fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
295 -------------------------------
296 -- Internal Table Management --
297 -------------------------------
299 function Allocate
(N
: Natural; S
: Natural := 1) return Table_Id
;
300 -- Allocate N * S ints from IT table
302 procedure Free_Tmp_Tables
;
303 -- Deallocate the tables used by the algorithm (but not the keys table)
309 Keys
: Table_Id
:= No_Table
;
311 -- NK : Number of Keys
313 function Initial
(K
: Key_Id
) return Word_Id
;
314 pragma Inline
(Initial
);
316 function Reduced
(K
: Key_Id
) return Word_Id
;
317 pragma Inline
(Reduced
);
319 function Get_Key
(N
: Key_Id
) return Key_Type
;
320 procedure Set_Key
(N
: Key_Id
; Item
: Key_Type
);
321 -- Get or Set Nth element of Keys table
327 Char_Pos_Set
: Table_Id
:= No_Table
;
328 Char_Pos_Set_Len
: Natural;
329 -- Character Selected Position Set
331 function Get_Char_Pos
(P
: Natural) return Natural;
332 procedure Set_Char_Pos
(P
: Natural; Item
: Natural);
333 -- Get or Set the string position of the Pth selected character
339 Used_Char_Set
: Table_Id
:= No_Table
;
340 Used_Char_Set_Len
: Natural;
341 -- Used Character Set : Define a new character mapping. When all the
342 -- characters are not present in the keys, in order to reduce the size
343 -- of some tables, we redefine the character mapping.
345 function Get_Used_Char
(C
: Character) return Natural;
346 procedure Set_Used_Char
(C
: Character; Item
: Natural);
352 T1
: Table_Id
:= No_Table
;
353 T2
: Table_Id
:= No_Table
;
356 -- T1 : Values table to compute F1
357 -- T2 : Values table to compute F2
359 function Get_Table
(T
: Integer; X
, Y
: Natural) return Natural;
360 procedure Set_Table
(T
: Integer; X
, Y
: Natural; Item
: Natural);
366 G
: Table_Id
:= No_Table
;
368 -- Values table to compute G
370 NT
: Natural := Default_Tries
;
371 -- Number of tries running the algorithm before raising an error
373 function Get_Graph
(N
: Natural) return Integer;
374 procedure Set_Graph
(N
: Natural; Item
: Integer);
375 -- Get or Set Nth element of graph
381 Edge_Size
: constant := 3;
382 Edges
: Table_Id
:= No_Table
;
384 -- Edges : Edge table of the random graph G
386 function Get_Edges
(F
: Natural) return Edge_Type
;
387 procedure Set_Edges
(F
: Natural; Item
: Edge_Type
);
393 Vertex_Size
: constant := 2;
395 Vertices
: Table_Id
:= No_Table
;
396 -- Vertex table of the random graph G
399 -- Number of Vertices
401 function Get_Vertices
(F
: Natural) return Vertex_Type
;
402 procedure Set_Vertices
(F
: Natural; Item
: Vertex_Type
);
403 -- Comments needed ???
406 -- Ratio between Keys and Vertices (parameter of Czech's algorithm)
409 -- Optimization mode (memory vs CPU)
411 Max_Key_Len
: Natural := 0;
412 Min_Key_Len
: Natural := Max_Word_Length
;
413 -- Maximum and minimum of all the word length
418 function Type_Size
(L
: Natural) return Natural;
419 -- Given the last L of an unsigned integer type T, return its size
425 function Acyclic
return Boolean is
426 Marks
: array (0 .. NV
- 1) of Vertex_Id
:= (others => No_Vertex
);
428 function Traverse
(Edge
: Edge_Id
; Mark
: Vertex_Id
) return Boolean;
429 -- Propagate Mark from X to Y. X is already marked. Mark Y and propagate
430 -- it to the edges of Y except the one representing the same key. Return
431 -- False when Y is marked with Mark.
437 function Traverse
(Edge
: Edge_Id
; Mark
: Vertex_Id
) return Boolean is
438 E
: constant Edge_Type
:= Get_Edges
(Edge
);
439 K
: constant Key_Id
:= E
.Key
;
440 Y
: constant Vertex_Id
:= E
.Y
;
441 M
: constant Vertex_Id
:= Marks
(E
.Y
);
448 elsif M
= No_Vertex
then
450 V
:= Get_Vertices
(Y
);
452 for J
in V
.First
.. V
.Last
loop
454 -- Do not propagate to the edge representing the same key
456 if Get_Edges
(J
).Key
/= K
457 and then not Traverse
(J
, Mark
)
469 -- Start of processing for Acyclic
472 -- Edges valid range is
474 for J
in 1 .. Edges_Len
- 1 loop
476 Edge
:= Get_Edges
(J
);
478 -- Mark X of E when it has not been already done
480 if Marks
(Edge
.X
) = No_Vertex
then
481 Marks
(Edge
.X
) := Edge
.X
;
484 -- Traverse E when this has not already been done
486 if Marks
(Edge
.Y
) = No_Vertex
487 and then not Traverse
(J
, Edge
.X
)
500 procedure Add
(C
: Character) is
502 Line
(Last
+ 1) := C
;
510 procedure Add
(S
: String) is
511 Len
: constant Natural := S
'Length;
513 Line
(Last
+ 1 .. Last
+ Len
) := S
;
521 function Allocate
(N
: Natural; S
: Natural := 1) return Table_Id
is
522 L
: constant Integer := IT
.Last
;
524 IT
.Set_Last
(L
+ N
* S
);
528 ------------------------------
529 -- Apply_Position_Selection --
530 ------------------------------
532 procedure Apply_Position_Selection
is
534 WT
.Set_Last
(2 * NK
);
535 for J
in 0 .. NK
- 1 loop
537 I_Word
: constant Word_Type
:= WT
.Table
(Initial
(J
));
538 R_Word
: Word_Type
:= Null_Word
;
539 Index
: Natural := I_Word
'First - 1;
542 -- Select the characters of Word included in the position
545 for C
in 0 .. Char_Pos_Set_Len
- 1 loop
546 exit when I_Word
(Get_Char_Pos
(C
)) = ASCII
.NUL
;
548 R_Word
(Index
) := I_Word
(Get_Char_Pos
(C
));
551 -- Build the new table with the reduced word
553 WT
.Table
(Reduced
(J
)) := R_Word
;
554 Set_Key
(J
, (Edge
=> No_Edge
));
557 end Apply_Position_Selection
;
559 -------------------------------
560 -- Assign_Values_To_Vertices --
561 -------------------------------
563 procedure Assign_Values_To_Vertices
is
566 procedure Assign
(X
: Vertex_Id
);
567 -- Execute assignment on X's neighbors except the vertex that we are
568 -- coming from which is already assigned.
574 procedure Assign
(X
: Vertex_Id
) is
576 V
: constant Vertex_Type
:= Get_Vertices
(X
);
579 for J
in V
.First
.. V
.Last
loop
582 if Get_Graph
(E
.Y
) = -1 then
583 Set_Graph
(E
.Y
, (E
.Key
- Get_Graph
(X
)) mod NK
);
589 -- Start of processing for Assign_Values_To_Vertices
592 -- Value -1 denotes an unitialized value as it is supposed to
593 -- be in the range 0 .. NK.
597 G
:= Allocate
(G_Len
, 1);
600 for J
in 0 .. G_Len
- 1 loop
604 for K
in 0 .. NK
- 1 loop
605 X
:= Get_Edges
(Get_Key
(K
).Edge
).X
;
607 if Get_Graph
(X
) = -1 then
613 for J
in 0 .. G_Len
- 1 loop
614 if Get_Graph
(J
) = -1 then
620 Put_Int_Vector
(Output
, "Assign Values To Vertices", G
, G_Len
);
622 end Assign_Values_To_Vertices
;
628 procedure Compute
(Position
: String := Default_Position
) is
629 Success
: Boolean := False;
632 NV
:= Natural (K2V
* Float (NK
));
634 Keys
:= Allocate
(NK
);
637 Put_Initial_Keys
(Output
, "Initial Key Table");
640 if Position
'Length /= 0 then
641 Parse_Position_Selection
(Position
);
643 Select_Char_Position
;
648 (Output
, "Char Position Set", Char_Pos_Set
, Char_Pos_Set_Len
);
651 Apply_Position_Selection
;
654 Put_Reduced_Keys
(Output
, "Reduced Keys Table");
657 Select_Character_Set
;
660 Put_Used_Char_Set
(Output
, "Character Position Table");
663 -- Perform Czech's algorithm
665 for J
in 1 .. NT
loop
666 Generate_Mapping_Tables
(Opt
, S
);
667 Compute_Edges_And_Vertices
(Opt
);
669 -- When graph is not empty (no self-loop from previous operation) and
672 if 0 < Edges_Len
and then Acyclic
then
679 raise Too_Many_Tries
;
682 Assign_Values_To_Vertices
;
685 --------------------------------
686 -- Compute_Edges_And_Vertices --
687 --------------------------------
689 procedure Compute_Edges_And_Vertices
(Opt
: Optimization
) is
694 Vertex
: Vertex_Type
;
695 Not_Acyclic
: Boolean := False;
697 procedure Move
(From
: Natural; To
: Natural);
698 function Lt
(L
, R
: Natural) return Boolean;
699 -- Subprograms needed for GNAT.Heap_Sort_A
705 function Lt
(L
, R
: Natural) return Boolean is
706 EL
: constant Edge_Type
:= Get_Edges
(L
);
707 ER
: constant Edge_Type
:= Get_Edges
(R
);
709 return EL
.X
< ER
.X
or else (EL
.X
= ER
.X
and then EL
.Y
< ER
.Y
);
716 procedure Move
(From
: Natural; To
: Natural) is
718 Set_Edges
(To
, Get_Edges
(From
));
721 -- Start of processing for Compute_Edges_And_Vertices
724 -- We store edges from 1 to 2 * NK and leave zero alone in order to use
727 Edges_Len
:= 2 * NK
+ 1;
729 if Edges
= No_Table
then
730 Edges
:= Allocate
(Edges_Len
, Edge_Size
);
733 if Vertices
= No_Table
then
734 Vertices
:= Allocate
(NV
, Vertex_Size
);
737 for J
in 0 .. NV
- 1 loop
738 Set_Vertices
(J
, (No_Vertex
, No_Vertex
- 1));
741 -- For each w, X = f1 (w) and Y = f2 (w)
743 for J
in 0 .. NK
- 1 loop
748 X
:= Sum
(WT
.Table
(Reduced
(J
)), T1
, Opt
);
749 Y
:= Sum
(WT
.Table
(Reduced
(J
)), T2
, Opt
);
751 -- Discard T1 and T2 as soon as we discover a self loop
758 -- We store (X, Y) and (Y, X) to ease assignment step
760 Set_Edges
(2 * J
+ 1, (X
, Y
, J
));
761 Set_Edges
(2 * J
+ 2, (Y
, X
, J
));
764 -- Return an empty graph when self loop detected
771 Put_Edges
(Output
, "Unsorted Edge Table");
772 Put_Int_Matrix
(Output
, "Function Table 1", T1
,
774 Put_Int_Matrix
(Output
, "Function Table 2", T2
,
778 -- Enforce consistency between edges and keys. Construct Vertices and
779 -- compute the list of neighbors of a vertex First .. Last as Edges
780 -- is sorted by X and then Y. To compute the neighbor list, sort the
785 Move
'Unrestricted_Access,
786 Lt
'Unrestricted_Access);
789 Put_Edges
(Output
, "Sorted Edge Table");
790 Put_Int_Matrix
(Output
, "Function Table 1", T1
,
792 Put_Int_Matrix
(Output
, "Function Table 2", T2
,
796 -- Edges valid range is 1 .. 2 * NK
798 for E
in 1 .. Edges_Len
- 1 loop
799 Edge
:= Get_Edges
(E
);
800 Key
:= Get_Key
(Edge
.Key
);
802 if Key
.Edge
= No_Edge
then
804 Set_Key
(Edge
.Key
, Key
);
807 Vertex
:= Get_Vertices
(Edge
.X
);
809 if Vertex
.First
= No_Edge
then
814 Set_Vertices
(Edge
.X
, Vertex
);
818 Put_Reduced_Keys
(Output
, "Key Table");
819 Put_Edges
(Output
, "Edge Table");
820 Put_Vertex_Table
(Output
, "Vertex Table");
823 end Compute_Edges_And_Vertices
;
831 Item_Size
: out Natural;
832 Length_1
: out Natural;
833 Length_2
: out Natural)
837 when Character_Position
=>
839 Length_1
:= Char_Pos_Set_Len
;
842 when Used_Character_Set
=>
847 when Function_Table_1
848 | Function_Table_2
=>
849 Item_Size
:= Type_Size
(NV
);
854 Item_Size
:= Type_Size
(NK
);
864 procedure Finalize
is
873 Min_Key_Len
:= Max_Word_Length
;
876 ---------------------
877 -- Free_Tmp_Tables --
878 ---------------------
880 procedure Free_Tmp_Tables
is
886 Char_Pos_Set
:= No_Table
;
887 Char_Pos_Set_Len
:= 0;
889 Used_Char_Set
:= No_Table
;
890 Used_Char_Set_Len
:= 0;
904 Vertices
:= No_Table
;
908 ----------------------------
909 -- Generate_Mapping_Table --
910 ----------------------------
912 procedure Generate_Mapping_Table
916 Seed
: in out Natural)
919 for J
in 0 .. L1
- 1 loop
920 for K
in 0 .. L2
- 1 loop
922 Set_Table
(Tab
, J
, K
, Seed
mod NV
);
925 end Generate_Mapping_Table
;
927 -----------------------------
928 -- Generate_Mapping_Tables --
929 -----------------------------
931 procedure Generate_Mapping_Tables
933 Seed
: in out Natural)
936 -- If T1 and T2 are already allocated no need to do it twice. Reuse them
937 -- as their size has not changed.
939 if T1
= No_Table
and then T2
= No_Table
then
941 Used_Char_Last
: Natural := 0;
945 if Opt
= CPU_Time
then
946 for P
in reverse Character'Range loop
947 Used_Char
:= Get_Used_Char
(P
);
948 if Used_Char
/= 0 then
949 Used_Char_Last
:= Used_Char
;
955 T1_Len
:= Char_Pos_Set_Len
;
956 T2_Len
:= Used_Char_Last
+ 1;
957 T1
:= Allocate
(T1_Len
* T2_Len
);
958 T2
:= Allocate
(T1_Len
* T2_Len
);
962 Generate_Mapping_Table
(T1
, T1_Len
, T2_Len
, Seed
);
963 Generate_Mapping_Table
(T2
, T1_Len
, T2_Len
, Seed
);
966 Put_Used_Char_Set
(Output
, "Used Character Set");
967 Put_Int_Matrix
(Output
, "Function Table 1", T1
,
969 Put_Int_Matrix
(Output
, "Function Table 2", T2
,
972 end Generate_Mapping_Tables
;
978 function Get_Char_Pos
(P
: Natural) return Natural is
979 N
: constant Natural := Char_Pos_Set
+ P
;
988 function Get_Edges
(F
: Natural) return Edge_Type
is
989 N
: constant Natural := Edges
+ (F
* Edge_Size
);
993 E
.Y
:= IT
.Table
(N
+ 1);
994 E
.Key
:= IT
.Table
(N
+ 2);
1002 function Get_Graph
(N
: Natural) return Integer is
1004 return IT
.Table
(G
+ N
);
1011 function Get_Key
(N
: Key_Id
) return Key_Type
is
1014 K
.Edge
:= IT
.Table
(Keys
+ N
);
1022 function Get_Table
(T
: Integer; X
, Y
: Natural) return Natural is
1023 N
: constant Natural := T
+ (Y
* T1_Len
) + X
;
1025 return IT
.Table
(N
);
1032 function Get_Used_Char
(C
: Character) return Natural is
1033 N
: constant Natural := Used_Char_Set
+ Character'Pos (C
);
1035 return IT
.Table
(N
);
1042 function Get_Vertices
(F
: Natural) return Vertex_Type
is
1043 N
: constant Natural := Vertices
+ (F
* Vertex_Size
);
1046 V
.First
:= IT
.Table
(N
);
1047 V
.Last
:= IT
.Table
(N
+ 1);
1055 function Image
(Int
: Integer; W
: Natural := 0) return String is
1056 B
: String (1 .. 32);
1059 procedure Img
(V
: Natural);
1060 -- Compute image of V into B, starting at B (L), incrementing L
1066 procedure Img
(V
: Natural) is
1073 B
(L
) := Character'Val ((V
mod 10) + Character'Pos ('0'));
1076 -- Start of processing for Image
1087 return Image
(B
(1 .. L
), W
);
1094 function Image
(Str
: String; W
: Natural := 0) return String is
1095 Len
: constant Natural := Str
'Length;
1096 Max
: Natural := Len
;
1104 Buf
: String (1 .. Max
) := (1 .. Max
=> ' ');
1107 for J
in 0 .. Len
- 1 loop
1108 Buf
(Max
- Len
+ 1 + J
) := Str
(Str
'First + J
);
1119 function Initial
(K
: Key_Id
) return Word_Id
is
1128 procedure Initialize
1130 K_To_V
: Float := Default_K_To_V
;
1131 Optim
: Optimization
:= CPU_Time
;
1132 Tries
: Positive := Default_Tries
)
1135 -- Free previous tables (the settings may have changed between two runs)
1139 if K_To_V
<= 2.0 then
1140 Put
(Output
, "K to V ratio cannot be lower than 2.0");
1142 raise Program_Error
;
1155 procedure Insert
(Value
: String) is
1156 Word
: Word_Type
:= Null_Word
;
1157 Len
: constant Natural := Value
'Length;
1160 Word
(1 .. Len
) := Value
(Value
'First .. Value
'First + Len
- 1);
1162 WT
.Table
(NK
) := Word
;
1164 NV
:= Natural (Float (NK
) * K2V
);
1166 -- Do not accept a value of K2V too close to 2.0 such that once rounded
1167 -- up, NV = 2 * NK because the algorithm would not converge.
1169 if NV
<= 2 * NK
then
1173 if Max_Key_Len
< Len
then
1177 if Len
< Min_Key_Len
then
1186 procedure New_Line
(File
: File_Descriptor
) is
1188 if Write
(File
, EOL
'Address, 1) /= 1 then
1189 raise Program_Error
;
1193 ------------------------------
1194 -- Parse_Position_Selection --
1195 ------------------------------
1197 procedure Parse_Position_Selection
(Argument
: String) is
1198 N
: Natural := Argument
'First;
1199 L
: constant Natural := Argument
'Last;
1200 M
: constant Natural := Max_Key_Len
;
1202 T
: array (1 .. M
) of Boolean := (others => False);
1204 function Parse_Index
return Natural;
1205 -- Parse argument starting at index N to find an index
1211 function Parse_Index
return Natural is
1212 C
: Character := Argument
(N
);
1221 if C
not in '0' .. '9' then
1223 (Program_Error
'Identity, "cannot read position argument");
1226 while C
in '0' .. '9' loop
1227 V
:= V
* 10 + (Character'Pos (C
) - Character'Pos ('0'));
1236 -- Start of processing for Parse_Position_Selection
1239 -- Empty specification means all the positions
1242 Char_Pos_Set_Len
:= M
;
1243 Char_Pos_Set
:= Allocate
(Char_Pos_Set_Len
);
1245 for C
in 0 .. Char_Pos_Set_Len
- 1 loop
1246 Set_Char_Pos
(C
, C
+ 1);
1252 First
, Last
: Natural;
1255 First
:= Parse_Index
;
1260 if N
<= L
and then Argument
(N
) = '-' then
1262 Last
:= Parse_Index
;
1265 -- Include the positions in the selection
1267 for J
in First
.. Last
loop
1274 if Argument
(N
) /= ',' then
1276 (Program_Error
'Identity, "cannot read position argument");
1282 -- Compute position selection length
1285 for J
in T
'Range loop
1291 -- Fill position selection
1293 Char_Pos_Set_Len
:= N
;
1294 Char_Pos_Set
:= Allocate
(Char_Pos_Set_Len
);
1297 for J
in T
'Range loop
1299 Set_Char_Pos
(N
, J
);
1304 end Parse_Position_Selection
;
1310 procedure Produce
(Pkg_Name
: String := Default_Pkg_Name
) is
1311 File
: File_Descriptor
;
1314 -- For call to Close
1316 function Array_Img
(N
, T
, R1
: String; R2
: String := "") return String;
1317 -- Return string "N : constant array (R1[, R2]) of T;"
1319 function Range_Img
(F
, L
: Natural; T
: String := "") return String;
1320 -- Return string "[T range ]F .. L"
1322 function Type_Img
(L
: Natural) return String;
1323 -- Return the larger unsigned type T such that T'Last < L
1331 R2
: String := "") return String
1337 Add
(" : constant array (");
1348 return Line
(1 .. Last
);
1355 function Range_Img
(F
, L
: Natural; T
: String := "") return String is
1356 FI
: constant String := Image
(F
);
1357 FL
: constant Natural := FI
'Length;
1358 LI
: constant String := Image
(L
);
1359 LL
: constant Natural := LI
'Length;
1360 TL
: constant Natural := T
'Length;
1361 RI
: String (1 .. TL
+ 7 + FL
+ 4 + LL
);
1366 RI
(Len
+ 1 .. Len
+ TL
) := T
;
1368 RI
(Len
+ 1 .. Len
+ 7) := " range ";
1372 RI
(Len
+ 1 .. Len
+ FL
) := FI
;
1374 RI
(Len
+ 1 .. Len
+ 4) := " .. ";
1376 RI
(Len
+ 1 .. Len
+ LL
) := LI
;
1378 return RI
(1 .. Len
);
1385 function Type_Img
(L
: Natural) return String is
1386 S
: constant String := Image
(Type_Size
(L
));
1387 U
: String := "Unsigned_ ";
1391 for J
in S
'Range loop
1403 PLen
: constant Natural := Pkg_Name
'Length;
1404 FName
: String (1 .. PLen
+ 4);
1406 -- Start of processing for Produce
1409 FName
(1 .. PLen
) := Pkg_Name
;
1410 for J
in 1 .. PLen
loop
1411 if FName
(J
) in 'A' .. 'Z' then
1412 FName
(J
) := Character'Val (Character'Pos (FName
(J
))
1413 - Character'Pos ('A')
1414 + Character'Pos ('a'));
1416 elsif FName
(J
) = '.' then
1421 FName
(PLen
+ 1 .. PLen
+ 4) := ".ads";
1423 File
:= Create_File
(FName
, Binary
);
1425 Put
(File
, "package ");
1426 Put
(File
, Pkg_Name
);
1429 Put
(File
, " function Hash (S : String) return Natural;");
1432 Put
(File
, Pkg_Name
);
1435 Close
(File
, Status
);
1441 FName
(PLen
+ 4) := 'b';
1443 File
:= Create_File
(FName
, Binary
);
1445 Put
(File
, "with Interfaces; use Interfaces;");
1448 Put
(File
, "package body ");
1449 Put
(File
, Pkg_Name
);
1454 if Opt
= CPU_Time
then
1455 Put
(File
, Array_Img
("C", Type_Img
(256), "Character"));
1458 F
:= Character'Pos (Character'First);
1459 L
:= Character'Pos (Character'Last);
1461 for J
in Character'Range loop
1462 P
:= Get_Used_Char
(J
);
1463 Put
(File
, Image
(P
), 1, 0, 1, F
, L
, Character'Pos (J
));
1470 L
:= Char_Pos_Set_Len
- 1;
1472 Put
(File
, Array_Img
("P", "Natural", Range_Img
(F
, L
)));
1475 for J
in F
.. L
loop
1476 Put
(File
, Image
(Get_Char_Pos
(J
)), 1, 0, 1, F
, L
, J
);
1481 if Opt
= CPU_Time
then
1484 Array_Img
("T1", Type_Img
(NV
),
1485 Range_Img
(0, T1_Len
- 1),
1486 Range_Img
(0, T2_Len
- 1, Type_Img
(256))),
1487 T1
, T1_Len
, T2_Len
);
1492 Array_Img
("T1", Type_Img
(NV
),
1493 Range_Img
(0, T1_Len
- 1)),
1499 if Opt
= CPU_Time
then
1502 Array_Img
("T2", Type_Img
(NV
),
1503 Range_Img
(0, T1_Len
- 1),
1504 Range_Img
(0, T2_Len
- 1, Type_Img
(256))),
1505 T2
, T1_Len
, T2_Len
);
1510 Array_Img
("T2", Type_Img
(NV
),
1511 Range_Img
(0, T1_Len
- 1)),
1519 Array_Img
("G", Type_Img
(NK
),
1520 Range_Img
(0, G_Len
- 1)),
1524 Put
(File
, " function Hash (S : String) return Natural is");
1526 Put
(File
, " F : constant Natural := S'First - 1;");
1528 Put
(File
, " L : constant Natural := S'Length;");
1530 Put
(File
, " F1, F2 : Natural := 0;");
1533 Put
(File
, " J : ");
1535 if Opt
= CPU_Time
then
1536 Put
(File
, Type_Img
(256));
1538 Put
(File
, "Natural");
1544 Put
(File
, " begin");
1546 Put
(File
, " for K in P'Range loop");
1548 Put
(File
, " exit when L < P (K);");
1550 Put
(File
, " J := ");
1552 if Opt
= CPU_Time
then
1555 Put
(File
, "Character'Pos");
1558 Put
(File
, " (S (P (K) + F));");
1561 Put
(File
, " F1 := (F1 + Natural (T1 (K");
1563 if Opt
= CPU_Time
then
1569 if Opt
= Memory_Space
then
1573 Put
(File
, ") mod ");
1574 Put
(File
, Image
(NV
));
1578 Put
(File
, " F2 := (F2 + Natural (T2 (K");
1580 if Opt
= CPU_Time
then
1586 if Opt
= Memory_Space
then
1590 Put
(File
, ") mod ");
1591 Put
(File
, Image
(NV
));
1595 Put
(File
, " end loop;");
1599 " return (Natural (G (F1)) + Natural (G (F2))) mod ");
1601 Put
(File
, Image
(NK
));
1604 Put
(File
, " end Hash;");
1608 Put
(File
, Pkg_Name
);
1611 Close
(File
, Status
);
1622 procedure Put
(File
: File_Descriptor
; Str
: String) is
1623 Len
: constant Natural := Str
'Length;
1625 if Write
(File
, Str
'Address, Len
) /= Len
then
1626 raise Program_Error
;
1635 (F
: File_Descriptor
;
1644 Len
: constant Natural := S
'Length;
1647 -- Write current line, followed by LF
1655 Put
(F
, Line
(1 .. Last
));
1660 -- Start of processing for Put
1663 if C1
= F1
and then C2
= F2
then
1667 if Last
+ Len
+ 3 > Max
then
1672 Line
(Last
+ 1 .. Last
+ 5) := " ";
1676 if C1
= F1
and then C2
= F2
then
1700 Line
(Last
+ 1 .. Last
+ Len
) := S
;
1729 procedure Put_Edges
(File
: File_Descriptor
; Title
: String) is
1731 F1
: constant Natural := 1;
1732 L1
: constant Natural := Edges_Len
- 1;
1733 M
: constant Natural := Max
/ 5;
1739 -- Edges valid range is 1 .. Edge_Len - 1
1741 for J
in F1
.. L1
loop
1743 Put
(File
, Image
(J
, M
), F1
, L1
, J
, 1, 4, 1);
1744 Put
(File
, Image
(E
.X
, M
), F1
, L1
, J
, 1, 4, 2);
1745 Put
(File
, Image
(E
.Y
, M
), F1
, L1
, J
, 1, 4, 3);
1746 Put
(File
, Image
(E
.Key
, M
), F1
, L1
, J
, 1, 4, 4);
1750 ----------------------
1751 -- Put_Initial_Keys --
1752 ----------------------
1754 procedure Put_Initial_Keys
(File
: File_Descriptor
; Title
: String) is
1755 F1
: constant Natural := 0;
1756 L1
: constant Natural := NK
- 1;
1757 M
: constant Natural := Max
/ 5;
1764 for J
in F1
.. L1
loop
1766 Put
(File
, Image
(J
, M
), F1
, L1
, J
, 1, 3, 1);
1767 Put
(File
, Image
(K
.Edge
, M
), F1
, L1
, J
, 1, 3, 2);
1768 Put
(File
, WT
.Table
(Initial
(J
)), F1
, L1
, J
, 1, 3, 3);
1770 end Put_Initial_Keys
;
1772 --------------------
1773 -- Put_Int_Matrix --
1774 --------------------
1776 procedure Put_Int_Matrix
1777 (File
: File_Descriptor
;
1783 F1
: constant Integer := 0;
1784 L1
: constant Integer := Len_1
- 1;
1785 F2
: constant Integer := 0;
1786 L2
: constant Integer := Len_2
- 1;
1794 for J
in F1
.. L1
loop
1795 Ix
:= IT
.Table
(Table
+ J
);
1796 Put
(File
, Image
(Ix
), 1, 0, 1, F1
, L1
, J
);
1800 for J
in F1
.. L1
loop
1801 for K
in F2
.. L2
loop
1802 Ix
:= IT
.Table
(Table
+ J
+ K
* Len_1
);
1803 Put
(File
, Image
(Ix
), F1
, L1
, J
, F2
, L2
, K
);
1809 --------------------
1810 -- Put_Int_Vector --
1811 --------------------
1813 procedure Put_Int_Vector
1814 (File
: File_Descriptor
;
1819 F2
: constant Natural := 0;
1820 L2
: constant Natural := Length
- 1;
1826 for J
in F2
.. L2
loop
1827 Put
(File
, Image
(IT
.Table
(Vector
+ J
)), 1, 0, 1, F2
, L2
, J
);
1831 ----------------------
1832 -- Put_Reduced_Keys --
1833 ----------------------
1835 procedure Put_Reduced_Keys
(File
: File_Descriptor
; Title
: String) is
1836 F1
: constant Natural := 0;
1837 L1
: constant Natural := NK
- 1;
1838 M
: constant Natural := Max
/ 5;
1845 for J
in F1
.. L1
loop
1847 Put
(File
, Image
(J
, M
), F1
, L1
, J
, 1, 3, 1);
1848 Put
(File
, Image
(K
.Edge
, M
), F1
, L1
, J
, 1, 3, 2);
1849 Put
(File
, WT
.Table
(Reduced
(J
)), F1
, L1
, J
, 1, 3, 3);
1851 end Put_Reduced_Keys
;
1853 -----------------------
1854 -- Put_Used_Char_Set --
1855 -----------------------
1857 procedure Put_Used_Char_Set
(File
: File_Descriptor
; Title
: String) is
1858 F
: constant Natural := Character'Pos (Character'First);
1859 L
: constant Natural := Character'Pos (Character'Last);
1865 for J
in Character'Range loop
1867 (File
, Image
(Get_Used_Char
(J
)), 1, 0, 1, F
, L
, Character'Pos (J
));
1869 end Put_Used_Char_Set
;
1871 ----------------------
1872 -- Put_Vertex_Table --
1873 ----------------------
1875 procedure Put_Vertex_Table
(File
: File_Descriptor
; Title
: String) is
1876 F1
: constant Natural := 0;
1877 L1
: constant Natural := NV
- 1;
1878 M
: constant Natural := Max
/ 4;
1885 for J
in F1
.. L1
loop
1886 V
:= Get_Vertices
(J
);
1887 Put
(File
, Image
(J
, M
), F1
, L1
, J
, 1, 3, 1);
1888 Put
(File
, Image
(V
.First
, M
), F1
, L1
, J
, 1, 3, 2);
1889 Put
(File
, Image
(V
.Last
, M
), F1
, L1
, J
, 1, 3, 3);
1891 end Put_Vertex_Table
;
1897 procedure Random
(Seed
: in out Natural) is
1899 -- Park & Miller Standard Minimal using Schrage's algorithm to avoid
1900 -- overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1)
1907 R
:= Seed
mod 127773;
1909 X
:= 16807 * R
- 2836 * Q
;
1912 Seed
:= X
+ 2147483647;
1922 function Reduced
(K
: Key_Id
) return Word_Id
is
1927 --------------------------
1928 -- Select_Char_Position --
1929 --------------------------
1931 procedure Select_Char_Position
is
1933 type Vertex_Table_Type
is array (Natural range <>) of Vertex_Type
;
1935 procedure Build_Identical_Keys_Sets
1936 (Table
: in out Vertex_Table_Type
;
1937 Last
: in out Natural;
1939 -- Build a list of keys subsets that are identical with the current
1940 -- position selection plus Pos. Once this routine is called, reduced
1941 -- words are sorted by subsets and each item (First, Last) in Sets
1942 -- defines the range of identical keys.
1943 -- Need comment saying exactly what Last is ???
1945 function Count_Different_Keys
1946 (Table
: Vertex_Table_Type
;
1948 Pos
: Natural) return Natural;
1949 -- For each subset in Sets, count the number of different keys if we add
1950 -- Pos to the current position selection.
1952 Sel_Position
: IT
.Table_Type
(1 .. Max_Key_Len
);
1953 Last_Sel_Pos
: Natural := 0;
1954 Max_Sel_Pos
: Natural := 0;
1956 -------------------------------
1957 -- Build_Identical_Keys_Sets --
1958 -------------------------------
1960 procedure Build_Identical_Keys_Sets
1961 (Table
: in out Vertex_Table_Type
;
1962 Last
: in out Natural;
1965 S
: constant Vertex_Table_Type
:= Table
(Table
'First .. Last
);
1966 C
: constant Natural := Pos
;
1967 -- Shortcuts (why are these not renames ???)
1971 -- First and last words of a subset
1974 -- GNAT.Heap_Sort assumes that the first array index is 1. Offset
1975 -- defines the translation to operate.
1977 function Lt
(L
, R
: Natural) return Boolean;
1978 procedure Move
(From
: Natural; To
: Natural);
1979 -- Subprograms needed by GNAT.Heap_Sort_A
1985 function Lt
(L
, R
: Natural) return Boolean is
1986 C
: constant Natural := Pos
;
1992 Left
:= Reduced
(0) - 1;
1993 Right
:= Offset
+ R
;
1996 Right
:= Reduced
(0) - 1;
1999 Right
:= Offset
+ R
;
2002 return WT
.Table
(Left
)(C
) < WT
.Table
(Right
)(C
);
2009 procedure Move
(From
: Natural; To
: Natural) is
2010 Target
, Source
: Natural;
2014 Source
:= Reduced
(0) - 1;
2015 Target
:= Offset
+ To
;
2017 Source
:= Offset
+ From
;
2018 Target
:= Reduced
(0) - 1;
2020 Source
:= Offset
+ From
;
2021 Target
:= Offset
+ To
;
2024 WT
.Table
(Target
) := WT
.Table
(Source
);
2027 -- Start of processing for Build_Identical_Key_Sets
2032 -- For each subset in S, extract the new subsets we have by adding C
2033 -- in the position selection.
2035 for J
in S
'Range loop
2036 if S
(J
).First
= S
(J
).Last
then
2040 Table
(Last
) := (F
, L
);
2043 Offset
:= Reduced
(S
(J
).First
) - 1;
2045 (S
(J
).Last
- S
(J
).First
+ 1,
2046 Move
'Unrestricted_Access,
2047 Lt
'Unrestricted_Access);
2051 for N
in S
(J
).First
.. S
(J
).Last
loop
2053 -- For the last item, close the last subset
2055 if N
= S
(J
).Last
then
2057 Table
(Last
) := (F
, N
);
2059 -- Two contiguous words are identical when they have the
2060 -- same Cth character.
2062 elsif WT
.Table
(Reduced
(N
))(C
) =
2063 WT
.Table
(Reduced
(N
+ 1))(C
)
2067 -- Find a new subset of identical keys. Store the current
2068 -- one and create a new subset.
2072 Table
(Last
) := (F
, L
);
2079 end Build_Identical_Keys_Sets
;
2081 --------------------------
2082 -- Count_Different_Keys --
2083 --------------------------
2085 function Count_Different_Keys
2086 (Table
: Vertex_Table_Type
;
2088 Pos
: Natural) return Natural
2090 N
: array (Character) of Natural;
2095 -- For each subset, count the number of words that are still
2096 -- different when we include Pos in the position selection. Only
2097 -- focus on this position as the other positions already produce
2100 for S
in 1 .. Last
loop
2102 -- Count the occurrences of the different characters
2105 for K
in Table
(S
).First
.. Table
(S
).Last
loop
2106 C
:= WT
.Table
(Reduced
(K
))(Pos
);
2110 -- Update the number of different keys. Each character used
2111 -- denotes a different key.
2113 for J
in N
'Range loop
2121 end Count_Different_Keys
;
2123 -- Start of processing for Select_Char_Position
2126 -- Initialize the reduced words set
2128 WT
.Set_Last
(2 * NK
);
2129 for K
in 0 .. NK
- 1 loop
2130 WT
.Table
(Reduced
(K
)) := WT
.Table
(Initial
(K
));
2134 Differences
: Natural;
2135 Max_Differences
: Natural := 0;
2136 Old_Differences
: Natural;
2137 Max_Diff_Sel_Pos
: Natural := 0; -- init to kill warning
2138 Max_Diff_Sel_Pos_Idx
: Natural := 0; -- init to kill warning
2139 Same_Keys_Sets_Table
: Vertex_Table_Type
(1 .. NK
);
2140 Same_Keys_Sets_Last
: Natural := 1;
2143 for C
in Sel_Position
'Range loop
2144 Sel_Position
(C
) := C
;
2147 Same_Keys_Sets_Table
(1) := (0, NK
- 1);
2150 -- Preserve maximum number of different keys and check later on
2151 -- that this value is strictly incrementing. Otherwise, it means
2152 -- that two keys are stricly identical.
2154 Old_Differences
:= Max_Differences
;
2156 -- The first position should not exceed the minimum key length.
2157 -- Otherwise, we may end up with an empty word once reduced.
2159 if Last_Sel_Pos
= 0 then
2160 Max_Sel_Pos
:= Min_Key_Len
;
2162 Max_Sel_Pos
:= Max_Key_Len
;
2165 -- Find which position increases more the number of differences
2167 for J
in Last_Sel_Pos
+ 1 .. Max_Sel_Pos
loop
2168 Differences
:= Count_Different_Keys
2169 (Same_Keys_Sets_Table
,
2170 Same_Keys_Sets_Last
,
2175 "Selecting position" & Sel_Position
(J
)'Img &
2176 " results in" & Differences
'Img &
2181 if Differences
> Max_Differences
then
2182 Max_Differences
:= Differences
;
2183 Max_Diff_Sel_Pos
:= Sel_Position
(J
);
2184 Max_Diff_Sel_Pos_Idx
:= J
;
2188 if Old_Differences
= Max_Differences
then
2190 (Program_Error
'Identity, "some keys are identical");
2193 -- Insert selected position and sort Sel_Position table
2195 Last_Sel_Pos
:= Last_Sel_Pos
+ 1;
2196 Sel_Position
(Last_Sel_Pos
+ 1 .. Max_Diff_Sel_Pos_Idx
) :=
2197 Sel_Position
(Last_Sel_Pos
.. Max_Diff_Sel_Pos_Idx
- 1);
2198 Sel_Position
(Last_Sel_Pos
) := Max_Diff_Sel_Pos
;
2200 for P
in 1 .. Last_Sel_Pos
- 1 loop
2201 if Max_Diff_Sel_Pos
< Sel_Position
(P
) then
2202 Sel_Position
(P
+ 1 .. Last_Sel_Pos
) :=
2203 Sel_Position
(P
.. Last_Sel_Pos
- 1);
2204 Sel_Position
(P
) := Max_Diff_Sel_Pos
;
2209 exit when Max_Differences
= NK
;
2211 Build_Identical_Keys_Sets
2212 (Same_Keys_Sets_Table
,
2213 Same_Keys_Sets_Last
,
2218 "Selecting position" & Max_Diff_Sel_Pos
'Img &
2219 " results in" & Max_Differences
'Img &
2224 for J
in 1 .. Same_Keys_Sets_Last
loop
2226 Same_Keys_Sets_Table
(J
).First
..
2227 Same_Keys_Sets_Table
(J
).Last
2229 Put
(Output
, WT
.Table
(Reduced
(K
)));
2239 Char_Pos_Set_Len
:= Last_Sel_Pos
;
2240 Char_Pos_Set
:= Allocate
(Char_Pos_Set_Len
);
2242 for C
in 1 .. Last_Sel_Pos
loop
2243 Set_Char_Pos
(C
- 1, Sel_Position
(C
));
2245 end Select_Char_Position
;
2247 --------------------------
2248 -- Select_Character_Set --
2249 --------------------------
2251 procedure Select_Character_Set
is
2252 Last
: Natural := 0;
2253 Used
: array (Character) of Boolean := (others => False);
2257 for J
in 0 .. NK
- 1 loop
2258 for K
in 0 .. Char_Pos_Set_Len
- 1 loop
2259 Char
:= WT
.Table
(Initial
(J
))(Get_Char_Pos
(K
));
2260 exit when Char
= ASCII
.NUL
;
2261 Used
(Char
) := True;
2265 Used_Char_Set_Len
:= 256;
2266 Used_Char_Set
:= Allocate
(Used_Char_Set_Len
);
2268 for J
in Used
'Range loop
2270 Set_Used_Char
(J
, Last
);
2273 Set_Used_Char
(J
, 0);
2276 end Select_Character_Set
;
2282 procedure Set_Char_Pos
(P
: Natural; Item
: Natural) is
2283 N
: constant Natural := Char_Pos_Set
+ P
;
2285 IT
.Table
(N
) := Item
;
2292 procedure Set_Edges
(F
: Natural; Item
: Edge_Type
) is
2293 N
: constant Natural := Edges
+ (F
* Edge_Size
);
2295 IT
.Table
(N
) := Item
.X
;
2296 IT
.Table
(N
+ 1) := Item
.Y
;
2297 IT
.Table
(N
+ 2) := Item
.Key
;
2304 procedure Set_Graph
(N
: Natural; Item
: Integer) is
2306 IT
.Table
(G
+ N
) := Item
;
2313 procedure Set_Key
(N
: Key_Id
; Item
: Key_Type
) is
2315 IT
.Table
(Keys
+ N
) := Item
.Edge
;
2322 procedure Set_Table
(T
: Integer; X
, Y
: Natural; Item
: Natural) is
2323 N
: constant Natural := T
+ ((Y
* T1_Len
) + X
);
2325 IT
.Table
(N
) := Item
;
2332 procedure Set_Used_Char
(C
: Character; Item
: Natural) is
2333 N
: constant Natural := Used_Char_Set
+ Character'Pos (C
);
2335 IT
.Table
(N
) := Item
;
2342 procedure Set_Vertices
(F
: Natural; Item
: Vertex_Type
) is
2343 N
: constant Natural := Vertices
+ (F
* Vertex_Size
);
2345 IT
.Table
(N
) := Item
.First
;
2346 IT
.Table
(N
+ 1) := Item
.Last
;
2356 Opt
: Optimization
) return Natural
2362 if Opt
= CPU_Time
then
2363 for J
in 0 .. T1_Len
- 1 loop
2364 exit when Word
(J
+ 1) = ASCII
.NUL
;
2365 R
:= Get_Table
(Table
, J
, Get_Used_Char
(Word
(J
+ 1)));
2366 S
:= (S
+ R
) mod NV
;
2370 for J
in 0 .. T1_Len
- 1 loop
2371 exit when Word
(J
+ 1) = ASCII
.NUL
;
2372 R
:= Get_Table
(Table
, J
, 0);
2373 S
:= (S
+ R
* Character'Pos (Word
(J
+ 1))) mod NV
;
2384 function Type_Size
(L
: Natural) return Natural is
2388 elsif L
<= 2 ** 16 then
2402 K
: Natural := 0) return Natural
2406 when Character_Position
=>
2407 return Get_Char_Pos
(J
);
2409 when Used_Character_Set
=>
2410 return Get_Used_Char
(Character'Val (J
));
2412 when Function_Table_1
=>
2413 return Get_Table
(T1
, J
, K
);
2415 when Function_Table_2
=>
2416 return Get_Table
(T2
, J
, K
);
2419 return Get_Graph
(J
);
2424 end GNAT
.Perfect_Hash_Generators
;