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-2010, 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.IO_Exceptions; use Ada.IO_Exceptions;
35 with Ada.Characters.Handling; use Ada.Characters.Handling;
38 with GNAT.Heap_Sort_G;
39 with GNAT.OS_Lib; use GNAT.OS_Lib;
42 package body GNAT.Perfect_Hash_Generators is
44 -- We are using the algorithm of J. Czech as described in Zbigniew J.
45 -- Czech, George Havas, and Bohdan S. Majewski ``An Optimal Algorithm for
46 -- Generating Minimal Perfect Hash Functions'', Information Processing
47 -- Letters, 43(1992) pp.257-264, Oct.1992
49 -- This minimal perfect hash function generator is based on random graphs
50 -- and produces a hash function of the form:
52 -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
54 -- where f1 and f2 are functions that map strings into integers, and g is
55 -- a function that maps integers into [0, m-1]. h can be order preserving.
56 -- For instance, let W = {w_0, ..., w_i, ..., w_m-1}, h can be defined
57 -- such that h (w_i) = i.
59 -- This algorithm defines two possible constructions of f1 and f2. Method
60 -- b) stores the hash function in less memory space at the expense of
63 -- a) fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
65 -- size (Tk) = max (for w in W) (length (w)) * size (used char set)
67 -- b) fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
69 -- size (Tk) = max (for w in W) (length (w)) but the table lookups are
70 -- replaced by multiplications.
72 -- where Tk values are randomly generated. n is defined later on but the
73 -- algorithm recommends to use a value a little bit greater than 2m. Note
74 -- that for large values of m, the main memory space requirements comes
75 -- from the memory space for storing function g (>= 2m entries).
77 -- Random graphs are frequently used to solve difficult problems that do
78 -- not have polynomial solutions. This algorithm is based on a weighted
79 -- undirected graph. It comprises two steps: mapping and assignment.
81 -- In the mapping step, a graph G = (V, E) is constructed, where = {0, 1,
82 -- ..., n-1} and E = {(for w in W) (f1 (w), f2 (w))}. In order for the
83 -- assignment step to be successful, G has to be acyclic. To have a high
84 -- probability of generating an acyclic graph, n >= 2m. If it is not
85 -- acyclic, Tk have to be regenerated.
87 -- In the assignment step, the algorithm builds function g. As G is
88 -- acyclic, there is a vertex v1 with only one neighbor v2. Let w_i be
89 -- the word such that v1 = f1 (w_i) and v2 = f2 (w_i). Let g (v1) = 0 by
90 -- construction and g (v2) = (i - g (v1)) mod n (or h (i) - g (v1) mod n).
91 -- If word w_j is such that v2 = f1 (w_j) and v3 = f2 (w_j), g (v3) = (j -
92 -- g (v2)) mod (or to be general, (h (j) - g (v2)) mod n). If w_i has no
93 -- neighbor, then another vertex is selected. The algorithm traverses G to
94 -- assign values to all the vertices. It cannot assign a value to an
95 -- already assigned vertex as G is acyclic.
97 subtype Word_Id is Integer;
98 subtype Key_Id is Integer;
99 subtype Vertex_Id is Integer;
100 subtype Edge_Id is Integer;
101 subtype Table_Id is Integer;
103 No_Vertex : constant Vertex_Id := -1;
104 No_Edge : constant Edge_Id := -1;
105 No_Table : constant Table_Id := -1;
107 type Word_Type is new String_Access;
108 procedure Free_Word (W : in out Word_Type);
109 function New_Word (S : String) return Word_Type;
111 procedure Resize_Word (W : in out Word_Type; Len : Natural);
112 -- Resize string W to have a length Len
114 type Key_Type is record
117 -- A key corresponds to an edge in the algorithm graph
119 type Vertex_Type is record
123 -- A vertex can be involved in several edges. First and Last are the bounds
124 -- of an array of edges stored in a global edge table.
126 type Edge_Type is record
131 -- An edge is a peer of vertices. In the algorithm, a key is associated to
134 package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32);
135 package IT is new GNAT.Table (Integer, Integer, 0, 32, 32);
136 -- The two main tables. WT is used to store the words in their initial
137 -- version and in their reduced version (that is words reduced to their
138 -- significant characters). As an instance of GNAT.Table, WT does not
139 -- initialize string pointers to null. This initialization has to be done
140 -- manually when the table is allocated. IT is used to store several
141 -- tables of components containing only integers.
143 function Image (Int : Integer; W : Natural := 0) return String;
144 function Image (Str : String; W : Natural := 0) return String;
145 -- Return a string which includes string Str or integer Int preceded by
146 -- leading spaces if required by width W.
148 function Trim_Trailing_Nuls (Str : String) return String;
149 -- Return Str with trailing NUL characters removed
151 Output : File_Descriptor renames GNAT.OS_Lib.Standout;
154 EOL : constant Character := ASCII.LF;
156 Max : constant := 78;
158 Line : String (1 .. Max);
159 -- Use this line to provide buffered IO
161 procedure Add (C : Character);
162 procedure Add (S : String);
163 -- Add a character or a string in Line and update Last
166 (F : File_Descriptor;
174 -- Write string S into file F as a element of an array of one or two
175 -- dimensions. Fk (resp. Lk and Ck) indicates the first (resp last and
176 -- current) index in the k-th dimension. If F1 = L1 the array is considered
177 -- as a one dimension array. This dimension is described by F2 and L2. This
178 -- routine takes care of all the parenthesis, spaces and commas needed to
179 -- format correctly the array. Moreover, the array is well indented and is
180 -- wrapped to fit in a 80 col line. When the line is full, the routine
181 -- writes it into file F. When the array is completed, the routine adds
182 -- semi-colon and writes the line into file F.
184 procedure New_Line (File : File_Descriptor);
185 -- Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib
187 procedure Put (File : File_Descriptor; Str : String);
188 -- Simulate Ada.Text_IO.Put with GNAT.OS_Lib
190 procedure Put_Used_Char_Set (File : File_Descriptor; Title : String);
191 -- Output a title and a used character set
193 procedure Put_Int_Vector
194 (File : File_Descriptor;
198 -- Output a title and a vector
200 procedure Put_Int_Matrix
201 (File : File_Descriptor;
206 -- Output a title and a matrix. When the matrix has only one non-empty
207 -- dimension (Len_2 = 0), output a vector.
209 procedure Put_Edges (File : File_Descriptor; Title : String);
210 -- Output a title and an edge table
212 procedure Put_Initial_Keys (File : File_Descriptor; Title : String);
213 -- Output a title and a key table
215 procedure Put_Reduced_Keys (File : File_Descriptor; Title : String);
216 -- Output a title and a key table
218 procedure Put_Vertex_Table (File : File_Descriptor; Title : String);
219 -- Output a title and a vertex table
221 function Ada_File_Base_Name (Pkg_Name : String) return String;
222 -- Return the base file name (i.e. without .ads/.adb extension) for an
223 -- Ada source file containing the named package, using the standard GNAT
224 -- file-naming convention. For example, if Pkg_Name is "Parent.Child", we
225 -- return "parent-child".
227 ----------------------------------
228 -- Character Position Selection --
229 ----------------------------------
231 -- We reduce the maximum key size by selecting representative positions
232 -- in these keys. We build a matrix with one word per line. We fill the
233 -- remaining space of a line with ASCII.NUL. The heuristic selects the
234 -- position that induces the minimum number of collisions. If there are
235 -- collisions, select another position on the reduced key set responsible
236 -- of the collisions. Apply the heuristic until there is no more collision.
238 procedure Apply_Position_Selection;
239 -- Apply Position selection and build the reduced key table
241 procedure Parse_Position_Selection (Argument : String);
242 -- Parse Argument and compute the position set. Argument is list of
243 -- substrings separated by commas. Each substring represents a position
244 -- or a range of positions (like x-y).
246 procedure Select_Character_Set;
247 -- Define an optimized used character set like Character'Pos in order not
248 -- to allocate tables of 256 entries.
250 procedure Select_Char_Position;
251 -- Find a min char position set in order to reduce the max key length. The
252 -- heuristic selects the position that induces the minimum number of
253 -- collisions. If there are collisions, select another position on the
254 -- reduced key set responsible of the collisions. Apply the heuristic until
255 -- there is no collision.
257 -----------------------------
258 -- Random Graph Generation --
259 -----------------------------
261 procedure Random (Seed : in out Natural);
262 -- Simulate Ada.Discrete_Numerics.Random
264 procedure Generate_Mapping_Table
268 Seed : in out Natural);
269 -- Random generation of the tables below. T is already allocated
271 procedure Generate_Mapping_Tables
273 Seed : in out Natural);
274 -- Generate the mapping tables T1 and T2. They are used to define fk (w) =
275 -- sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n. Keys, NK and Chars
276 -- are used to compute the matrix size.
278 ---------------------------
279 -- Algorithm Computation --
280 ---------------------------
282 procedure Compute_Edges_And_Vertices (Opt : Optimization);
283 -- Compute the edge and vertex tables. These are empty when a self loop is
284 -- detected (f1 (w) = f2 (w)). The edge table is sorted by X value and then
285 -- Y value. Keys is the key table and NK the number of keys. Chars is the
286 -- set of characters really used in Keys. NV is the number of vertices
287 -- recommended by the algorithm. T1 and T2 are the mapping tables needed to
288 -- compute f1 (w) and f2 (w).
290 function Acyclic return Boolean;
291 -- Return True when the graph is acyclic. Vertices is the current vertex
292 -- table and Edges the current edge table.
294 procedure Assign_Values_To_Vertices;
295 -- Execute the assignment step of the algorithm. Keys is the current key
296 -- table. Vertices and Edges represent the random graph. G is the result of
297 -- the assignment step such that:
298 -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
303 Opt : Optimization) return Natural;
304 -- For an optimization of CPU_Time return
305 -- fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
306 -- For an optimization of Memory_Space return
307 -- fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
310 -------------------------------
311 -- Internal Table Management --
312 -------------------------------
314 function Allocate (N : Natural; S : Natural := 1) return Table_Id;
315 -- Allocate N * S ints from IT table
321 Keys : Table_Id := No_Table;
323 -- NK : Number of Keys
325 function Initial (K : Key_Id) return Word_Id;
326 pragma Inline (Initial);
328 function Reduced (K : Key_Id) return Word_Id;
329 pragma Inline (Reduced);
331 function Get_Key (N : Key_Id) return Key_Type;
332 procedure Set_Key (N : Key_Id; Item : Key_Type);
333 -- Get or Set Nth element of Keys table
339 Char_Pos_Set : Table_Id := No_Table;
340 Char_Pos_Set_Len : Natural;
341 -- Character Selected Position Set
343 function Get_Char_Pos (P : Natural) return Natural;
344 procedure Set_Char_Pos (P : Natural; Item : Natural);
345 -- Get or Set the string position of the Pth selected character
351 Used_Char_Set : Table_Id := No_Table;
352 Used_Char_Set_Len : Natural;
353 -- Used Character Set : Define a new character mapping. When all the
354 -- characters are not present in the keys, in order to reduce the size
355 -- of some tables, we redefine the character mapping.
357 function Get_Used_Char (C : Character) return Natural;
358 procedure Set_Used_Char (C : Character; Item : Natural);
364 T1 : Table_Id := No_Table;
365 T2 : Table_Id := No_Table;
368 -- T1 : Values table to compute F1
369 -- T2 : Values table to compute F2
371 function Get_Table (T : Integer; X, Y : Natural) return Natural;
372 procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural);
378 G : Table_Id := No_Table;
380 -- Values table to compute G
382 NT : Natural := Default_Tries;
383 -- Number of tries running the algorithm before raising an error
385 function Get_Graph (N : Natural) return Integer;
386 procedure Set_Graph (N : Natural; Item : Integer);
387 -- Get or Set Nth element of graph
393 Edge_Size : constant := 3;
394 Edges : Table_Id := No_Table;
396 -- Edges : Edge table of the random graph G
398 function Get_Edges (F : Natural) return Edge_Type;
399 procedure Set_Edges (F : Natural; Item : Edge_Type);
405 Vertex_Size : constant := 2;
407 Vertices : Table_Id := No_Table;
408 -- Vertex table of the random graph G
411 -- Number of Vertices
413 function Get_Vertices (F : Natural) return Vertex_Type;
414 procedure Set_Vertices (F : Natural; Item : Vertex_Type);
415 -- Comments needed ???
418 -- Ratio between Keys and Vertices (parameter of Czech's algorithm)
421 -- Optimization mode (memory vs CPU)
423 Max_Key_Len : Natural := 0;
424 Min_Key_Len : Natural := 0;
425 -- Maximum and minimum of all the word length
430 function Type_Size (L : Natural) return Natural;
431 -- Given the last L of an unsigned integer type T, return its size
437 function Acyclic return Boolean is
438 Marks : array (0 .. NV - 1) of Vertex_Id := (others => No_Vertex);
440 function Traverse (Edge : Edge_Id; Mark : Vertex_Id) return Boolean;
441 -- Propagate Mark from X to Y. X is already marked. Mark Y and propagate
442 -- it to the edges of Y except the one representing the same key. Return
443 -- False when Y is marked with Mark.
449 function Traverse (Edge : Edge_Id; Mark : Vertex_Id) return Boolean is
450 E : constant Edge_Type := Get_Edges (Edge);
451 K : constant Key_Id := E.Key;
452 Y : constant Vertex_Id := E.Y;
453 M : constant Vertex_Id := Marks (E.Y);
460 elsif M = No_Vertex then
462 V := Get_Vertices (Y);
464 for J in V.First .. V.Last loop
466 -- Do not propagate to the edge representing the same key
468 if Get_Edges (J).Key /= K
469 and then not Traverse (J, Mark)
481 -- Start of processing for Acyclic
484 -- Edges valid range is
486 for J in 1 .. Edges_Len - 1 loop
488 Edge := Get_Edges (J);
490 -- Mark X of E when it has not been already done
492 if Marks (Edge.X) = No_Vertex then
493 Marks (Edge.X) := Edge.X;
496 -- Traverse E when this has not already been done
498 if Marks (Edge.Y) = No_Vertex
499 and then not Traverse (J, Edge.X)
508 ------------------------
509 -- Ada_File_Base_Name --
510 ------------------------
512 function Ada_File_Base_Name (Pkg_Name : String) return String is
514 -- Convert to lower case, then replace '.' with '-'
516 return Result : String := To_Lower (Pkg_Name) do
517 for J in Result'Range loop
518 if Result (J) = '.' then
523 end Ada_File_Base_Name;
529 procedure Add (C : Character) is
530 pragma Assert (C /= ASCII.NUL);
532 Line (Last + 1) := C;
540 procedure Add (S : String) is
541 Len : constant Natural := S'Length;
543 for J in S'Range loop
544 pragma Assert (S (J) /= ASCII.NUL);
548 Line (Last + 1 .. Last + Len) := S;
556 function Allocate (N : Natural; S : Natural := 1) return Table_Id is
557 L : constant Integer := IT.Last;
559 IT.Set_Last (L + N * S);
563 ------------------------------
564 -- Apply_Position_Selection --
565 ------------------------------
567 procedure Apply_Position_Selection is
569 for J in 0 .. NK - 1 loop
571 IW : constant String := WT.Table (Initial (J)).all;
572 RW : String (1 .. IW'Length) := (others => ASCII.NUL);
573 N : Natural := IW'First - 1;
576 -- Select the characters of Word included in the position
579 for C in 0 .. Char_Pos_Set_Len - 1 loop
580 exit when IW (Get_Char_Pos (C)) = ASCII.NUL;
582 RW (N) := IW (Get_Char_Pos (C));
585 -- Build the new table with the reduced word. Be careful
586 -- to deallocate the old version to avoid memory leaks.
588 Free_Word (WT.Table (Reduced (J)));
589 WT.Table (Reduced (J)) := New_Word (RW);
590 Set_Key (J, (Edge => No_Edge));
593 end Apply_Position_Selection;
595 -------------------------------
596 -- Assign_Values_To_Vertices --
597 -------------------------------
599 procedure Assign_Values_To_Vertices is
602 procedure Assign (X : Vertex_Id);
603 -- Execute assignment on X's neighbors except the vertex that we are
604 -- coming from which is already assigned.
610 procedure Assign (X : Vertex_Id) is
612 V : constant Vertex_Type := Get_Vertices (X);
615 for J in V.First .. V.Last loop
618 if Get_Graph (E.Y) = -1 then
619 Set_Graph (E.Y, (E.Key - Get_Graph (X)) mod NK);
625 -- Start of processing for Assign_Values_To_Vertices
628 -- Value -1 denotes an uninitialized value as it is supposed to
629 -- be in the range 0 .. NK.
633 G := Allocate (G_Len, 1);
636 for J in 0 .. G_Len - 1 loop
640 for K in 0 .. NK - 1 loop
641 X := Get_Edges (Get_Key (K).Edge).X;
643 if Get_Graph (X) = -1 then
649 for J in 0 .. G_Len - 1 loop
650 if Get_Graph (J) = -1 then
656 Put_Int_Vector (Output, "Assign Values To Vertices", G, G_Len);
658 end Assign_Values_To_Vertices;
664 procedure Compute (Position : String := Default_Position) is
665 Success : Boolean := False;
669 raise Program_Error with "keywords set cannot be empty";
673 Put_Initial_Keys (Output, "Initial Key Table");
676 if Position'Length /= 0 then
677 Parse_Position_Selection (Position);
679 Select_Char_Position;
684 (Output, "Char Position Set", Char_Pos_Set, Char_Pos_Set_Len);
687 Apply_Position_Selection;
690 Put_Reduced_Keys (Output, "Reduced Keys Table");
693 Select_Character_Set;
696 Put_Used_Char_Set (Output, "Character Position Table");
699 -- Perform Czech's algorithm
701 for J in 1 .. NT loop
702 Generate_Mapping_Tables (Opt, S);
703 Compute_Edges_And_Vertices (Opt);
705 -- When graph is not empty (no self-loop from previous operation) and
708 if 0 < Edges_Len and then Acyclic then
715 raise Too_Many_Tries;
718 Assign_Values_To_Vertices;
721 --------------------------------
722 -- Compute_Edges_And_Vertices --
723 --------------------------------
725 procedure Compute_Edges_And_Vertices (Opt : Optimization) is
730 Vertex : Vertex_Type;
731 Not_Acyclic : Boolean := False;
733 procedure Move (From : Natural; To : Natural);
734 function Lt (L, R : Natural) return Boolean;
735 -- Subprograms needed for GNAT.Heap_Sort_G
741 function Lt (L, R : Natural) return Boolean is
742 EL : constant Edge_Type := Get_Edges (L);
743 ER : constant Edge_Type := Get_Edges (R);
745 return EL.X < ER.X or else (EL.X = ER.X and then EL.Y < ER.Y);
752 procedure Move (From : Natural; To : Natural) is
754 Set_Edges (To, Get_Edges (From));
757 package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
759 -- Start of processing for Compute_Edges_And_Vertices
762 -- We store edges from 1 to 2 * NK and leave zero alone in order to use
765 Edges_Len := 2 * NK + 1;
767 if Edges = No_Table then
768 Edges := Allocate (Edges_Len, Edge_Size);
771 if Vertices = No_Table then
772 Vertices := Allocate (NV, Vertex_Size);
775 for J in 0 .. NV - 1 loop
776 Set_Vertices (J, (No_Vertex, No_Vertex - 1));
779 -- For each w, X = f1 (w) and Y = f2 (w)
781 for J in 0 .. NK - 1 loop
786 X := Sum (WT.Table (Reduced (J)), T1, Opt);
787 Y := Sum (WT.Table (Reduced (J)), T2, Opt);
789 -- Discard T1 and T2 as soon as we discover a self loop
796 -- We store (X, Y) and (Y, X) to ease assignment step
798 Set_Edges (2 * J + 1, (X, Y, J));
799 Set_Edges (2 * J + 2, (Y, X, J));
802 -- Return an empty graph when self loop detected
809 Put_Edges (Output, "Unsorted Edge Table");
810 Put_Int_Matrix (Output, "Function Table 1", T1,
812 Put_Int_Matrix (Output, "Function Table 2", T2,
816 -- Enforce consistency between edges and keys. Construct Vertices and
817 -- compute the list of neighbors of a vertex First .. Last as Edges
818 -- is sorted by X and then Y. To compute the neighbor list, sort the
821 Sorting.Sort (Edges_Len - 1);
824 Put_Edges (Output, "Sorted Edge Table");
825 Put_Int_Matrix (Output, "Function Table 1", T1,
827 Put_Int_Matrix (Output, "Function Table 2", T2,
831 -- Edges valid range is 1 .. 2 * NK
833 for E in 1 .. Edges_Len - 1 loop
834 Edge := Get_Edges (E);
835 Key := Get_Key (Edge.Key);
837 if Key.Edge = No_Edge then
839 Set_Key (Edge.Key, Key);
842 Vertex := Get_Vertices (Edge.X);
844 if Vertex.First = No_Edge then
849 Set_Vertices (Edge.X, Vertex);
853 Put_Reduced_Keys (Output, "Key Table");
854 Put_Edges (Output, "Edge Table");
855 Put_Vertex_Table (Output, "Vertex Table");
858 end Compute_Edges_And_Vertices;
866 Item_Size : out Natural;
867 Length_1 : out Natural;
868 Length_2 : out Natural)
872 when Character_Position =>
874 Length_1 := Char_Pos_Set_Len;
877 when Used_Character_Set =>
882 when Function_Table_1
883 | Function_Table_2 =>
884 Item_Size := Type_Size (NV);
889 Item_Size := Type_Size (NK);
899 procedure Finalize is
902 Put (Output, "Finalize");
906 -- Deallocate all the WT components (both initial and reduced
907 -- ones) to avoid memory leaks.
909 for W in 0 .. WT.Last loop
910 Free_Word (WT.Table (W));
915 -- Reset all variables for next usage
919 Char_Pos_Set := No_Table;
920 Char_Pos_Set_Len := 0;
922 Used_Char_Set := No_Table;
923 Used_Char_Set_Len := 0;
937 Vertices := No_Table;
949 procedure Free_Word (W : in out Word_Type) is
956 ----------------------------
957 -- Generate_Mapping_Table --
958 ----------------------------
960 procedure Generate_Mapping_Table
964 Seed : in out Natural)
967 for J in 0 .. L1 - 1 loop
968 for K in 0 .. L2 - 1 loop
970 Set_Table (Tab, J, K, Seed mod NV);
973 end Generate_Mapping_Table;
975 -----------------------------
976 -- Generate_Mapping_Tables --
977 -----------------------------
979 procedure Generate_Mapping_Tables
981 Seed : in out Natural)
984 -- If T1 and T2 are already allocated no need to do it twice. Reuse them
985 -- as their size has not changed.
987 if T1 = No_Table and then T2 = No_Table then
989 Used_Char_Last : Natural := 0;
993 if Opt = CPU_Time then
994 for P in reverse Character'Range loop
995 Used_Char := Get_Used_Char (P);
996 if Used_Char /= 0 then
997 Used_Char_Last := Used_Char;
1003 T1_Len := Char_Pos_Set_Len;
1004 T2_Len := Used_Char_Last + 1;
1005 T1 := Allocate (T1_Len * T2_Len);
1006 T2 := Allocate (T1_Len * T2_Len);
1010 Generate_Mapping_Table (T1, T1_Len, T2_Len, Seed);
1011 Generate_Mapping_Table (T2, T1_Len, T2_Len, Seed);
1014 Put_Used_Char_Set (Output, "Used Character Set");
1015 Put_Int_Matrix (Output, "Function Table 1", T1,
1017 Put_Int_Matrix (Output, "Function Table 2", T2,
1020 end Generate_Mapping_Tables;
1026 function Get_Char_Pos (P : Natural) return Natural is
1027 N : constant Natural := Char_Pos_Set + P;
1029 return IT.Table (N);
1036 function Get_Edges (F : Natural) return Edge_Type is
1037 N : constant Natural := Edges + (F * Edge_Size);
1040 E.X := IT.Table (N);
1041 E.Y := IT.Table (N + 1);
1042 E.Key := IT.Table (N + 2);
1050 function Get_Graph (N : Natural) return Integer is
1052 return IT.Table (G + N);
1059 function Get_Key (N : Key_Id) return Key_Type is
1062 K.Edge := IT.Table (Keys + N);
1070 function Get_Table (T : Integer; X, Y : Natural) return Natural is
1071 N : constant Natural := T + (Y * T1_Len) + X;
1073 return IT.Table (N);
1080 function Get_Used_Char (C : Character) return Natural is
1081 N : constant Natural := Used_Char_Set + Character'Pos (C);
1083 return IT.Table (N);
1090 function Get_Vertices (F : Natural) return Vertex_Type is
1091 N : constant Natural := Vertices + (F * Vertex_Size);
1094 V.First := IT.Table (N);
1095 V.Last := IT.Table (N + 1);
1103 function Image (Int : Integer; W : Natural := 0) return String is
1104 B : String (1 .. 32);
1107 procedure Img (V : Natural);
1108 -- Compute image of V into B, starting at B (L), incrementing L
1114 procedure Img (V : Natural) is
1121 B (L) := Character'Val ((V mod 10) + Character'Pos ('0'));
1124 -- Start of processing for Image
1135 return Image (B (1 .. L), W);
1142 function Image (Str : String; W : Natural := 0) return String is
1143 Len : constant Natural := Str'Length;
1144 Max : Natural := Len;
1152 Buf : String (1 .. Max) := (1 .. Max => ' ');
1155 for J in 0 .. Len - 1 loop
1156 Buf (Max - Len + 1 + J) := Str (Str'First + J);
1167 function Initial (K : Key_Id) return Word_Id is
1176 procedure Initialize
1178 K_To_V : Float := Default_K_To_V;
1179 Optim : Optimization := Memory_Space;
1180 Tries : Positive := Default_Tries)
1184 Put (Output, "Initialize");
1188 -- Deallocate the part of the table concerning the reduced words.
1189 -- Initial words are already present in the table. We may have reduced
1190 -- words already there because a previous computation failed. We are
1191 -- currently retrying and the reduced words have to be deallocated.
1193 for W in Reduced (0) .. WT.Last loop
1194 Free_Word (WT.Table (W));
1199 -- Initialize of computation variables
1203 Char_Pos_Set := No_Table;
1204 Char_Pos_Set_Len := 0;
1206 Used_Char_Set := No_Table;
1207 Used_Char_Set_Len := 0;
1221 Vertices := No_Table;
1230 raise Program_Error with "K to V ratio cannot be lower than 2.0";
1233 -- Do not accept a value of K2V too close to 2.0 such that once
1234 -- rounded up, NV = 2 * NK because the algorithm would not converge.
1236 NV := Natural (Float (NK) * K2V);
1237 if NV <= 2 * NK then
1241 Keys := Allocate (NK);
1243 -- Resize initial words to have all of them at the same size
1244 -- (so the size of the largest one).
1246 for K in 0 .. NK - 1 loop
1247 Resize_Word (WT.Table (Initial (K)), Max_Key_Len);
1250 -- Allocated the table to store the reduced words. As WT is a
1251 -- GNAT.Table (using C memory management), pointers have to be
1252 -- explicitly initialized to null.
1254 WT.Set_Last (Reduced (NK - 1));
1255 for W in 0 .. NK - 1 loop
1256 WT.Table (Reduced (W)) := null;
1264 procedure Insert (Value : String) is
1265 Len : constant Natural := Value'Length;
1269 Put (Output, "Inserting """ & Value & """");
1273 for J in Value'Range loop
1274 pragma Assert (Value (J) /= ASCII.NUL);
1279 WT.Table (NK) := New_Word (Value);
1282 if Max_Key_Len < Len then
1286 if Min_Key_Len = 0 or else Len < Min_Key_Len then
1295 procedure New_Line (File : File_Descriptor) is
1297 if Write (File, EOL'Address, 1) /= 1 then
1298 raise Program_Error;
1306 function New_Word (S : String) return Word_Type is
1308 return new String'(S);
1311 ------------------------------
1312 -- Parse_Position_Selection --
1313 ------------------------------
1315 procedure Parse_Position_Selection (Argument : String) is
1316 N : Natural := Argument'First;
1317 L : constant Natural := Argument'Last;
1318 M : constant Natural := Max_Key_Len;
1320 T : array (1 .. M) of Boolean := (others => False);
1322 function Parse_Index return Natural;
1323 -- Parse argument starting at index N to find an index
1329 function Parse_Index return Natural is
1330 C : Character := Argument (N);
1339 if C not in '0' .. '9' then
1340 raise Program_Error with "cannot read position argument";
1343 while C in '0' .. '9' loop
1344 V := V * 10 + (Character'Pos (C) - Character'Pos ('0'));
1353 -- Start of processing for Parse_Position_Selection
1356 -- Empty specification means all the positions
1359 Char_Pos_Set_Len := M;
1360 Char_Pos_Set := Allocate (Char_Pos_Set_Len);
1362 for C in 0 .. Char_Pos_Set_Len - 1 loop
1363 Set_Char_Pos (C, C + 1);
1369 First, Last : Natural;
1372 First := Parse_Index;
1377 if N <= L and then Argument (N) = '-' then
1379 Last := Parse_Index;
1382 -- Include the positions in the selection
1384 for J in First .. Last loop
1391 if Argument (N) /= ',' then
1392 raise Program_Error with "cannot read position argument";
1398 -- Compute position selection length
1401 for J in T'Range loop
1407 -- Fill position selection
1409 Char_Pos_Set_Len := N;
1410 Char_Pos_Set := Allocate (Char_Pos_Set_Len);
1413 for J in T'Range loop
1415 Set_Char_Pos (N, J);
1420 end Parse_Position_Selection;
1426 procedure Produce (Pkg_Name : String := Default_Pkg_Name) is
1427 File : File_Descriptor;
1430 -- For call to Close
1432 function Array_Img (N, T, R1 : String; R2 : String := "") return String;
1433 -- Return string "N : constant array (R1[, R2]) of T;"
1435 function Range_Img (F, L : Natural; T : String := "") return String;
1436 -- Return string "[T range ]F .. L"
1438 function Type_Img (L : Natural) return String;
1439 -- Return the larger unsigned type T such that T'Last < L
1447 R2 : String := "") return String
1453 Add (" : constant array (");
1464 return Line (1 .. Last);
1471 function Range_Img (F, L : Natural; T : String := "") return String is
1472 FI : constant String := Image (F);
1473 FL : constant Natural := FI'Length;
1474 LI : constant String := Image (L);
1475 LL : constant Natural := LI'Length;
1476 TL : constant Natural := T'Length;
1477 RI : String (1 .. TL + 7 + FL + 4 + LL);
1482 RI (Len + 1 .. Len + TL) := T;
1484 RI (Len + 1 .. Len + 7) := " range ";
1488 RI (Len + 1 .. Len + FL) := FI;
1490 RI (Len + 1 .. Len + 4) := " .. ";
1492 RI (Len + 1 .. Len + LL) := LI;
1494 return RI (1 .. Len);
1501 function Type_Img (L : Natural) return String is
1502 S : constant String := Image (Type_Size (L));
1503 U : String := "Unsigned_ ";
1507 for J in S'Range loop
1519 FName : String := Ada_File_Base_Name (Pkg_Name) & ".ads";
1520 -- Initially, the name of the spec file; then modified to be the name of
1523 -- Start of processing for Produce
1529 "Producing " & Ada.Directories.Current_Directory & "/" & FName);
1533 File := Create_File (FName, Binary);
1535 if File = Invalid_FD then
1536 raise Program_Error with "cannot create: " & FName;
1539 Put (File, "package ");
1540 Put (File, Pkg_Name);
1543 Put (File, " function Hash (S : String) return Natural;");
1546 Put (File, Pkg_Name);
1549 Close (File, Status);
1555 FName (FName'Last) := 'b'; -- Set to body file name
1557 File := Create_File (FName, Binary);
1559 if File = Invalid_FD then
1560 raise Program_Error with "cannot create: " & FName;
1563 Put (File, "with Interfaces; use Interfaces;");
1566 Put (File, "package body ");
1567 Put (File, Pkg_Name);
1572 if Opt = CPU_Time then
1573 Put (File, Array_Img ("C", Type_Img (256), "Character"));
1576 F := Character'Pos (Character'First);
1577 L := Character'Pos (Character'Last);
1579 for J in Character'Range loop
1580 P := Get_Used_Char (J);
1581 Put (File, Image (P), 1, 0, 1, F, L, Character'Pos (J));
1588 L := Char_Pos_Set_Len - 1;
1590 Put (File, Array_Img ("P", "Natural", Range_Img (F, L)));
1593 for J in F .. L loop
1594 Put (File, Image (Get_Char_Pos (J)), 1, 0, 1, F, L, J);
1603 Array_Img ("T1", Type_Img (NV),
1604 Range_Img (0, T1_Len - 1),
1605 Range_Img (0, T2_Len - 1, Type_Img (256))),
1606 T1, T1_Len, T2_Len);
1608 when Memory_Space =>
1611 Array_Img ("T1", Type_Img (NV),
1612 Range_Img (0, T1_Len - 1)),
1622 Array_Img ("T2", Type_Img (NV),
1623 Range_Img (0, T1_Len - 1),
1624 Range_Img (0, T2_Len - 1, Type_Img (256))),
1625 T2, T1_Len, T2_Len);
1627 when Memory_Space =>
1630 Array_Img ("T2", Type_Img (NV),
1631 Range_Img (0, T1_Len - 1)),
1639 Array_Img ("G", Type_Img (NK),
1640 Range_Img (0, G_Len - 1)),
1644 Put (File, " function Hash (S : String) return Natural is");
1646 Put (File, " F : constant Natural := S'First - 1;");
1648 Put (File, " L : constant Natural := S'Length;");
1650 Put (File, " F1, F2 : Natural := 0;");
1653 Put (File, " J : ");
1657 Put (File, Type_Img (256));
1658 when Memory_Space =>
1659 Put (File, "Natural");
1665 Put (File, " begin");
1667 Put (File, " for K in P'Range loop");
1669 Put (File, " exit when L < P (K);");
1671 Put (File, " J := ");
1676 when Memory_Space =>
1677 Put (File, "Character'Pos");
1680 Put (File, " (S (P (K) + F));");
1683 Put (File, " F1 := (F1 + Natural (T1 (K");
1685 if Opt = CPU_Time then
1691 if Opt = Memory_Space then
1695 Put (File, ") mod ");
1696 Put (File, Image (NV));
1700 Put (File, " F2 := (F2 + Natural (T2 (K");
1702 if Opt = CPU_Time then
1708 if Opt = Memory_Space then
1712 Put (File, ") mod ");
1713 Put (File, Image (NV));
1717 Put (File, " end loop;");
1721 " return (Natural (G (F1)) + Natural (G (F2))) mod ");
1723 Put (File, Image (NK));
1726 Put (File, " end Hash;");
1730 Put (File, Pkg_Name);
1733 Close (File, Status);
1744 procedure Put (File : File_Descriptor; Str : String) is
1745 Len : constant Natural := Str'Length;
1747 for J in Str'Range loop
1748 pragma Assert (Str (J) /= ASCII.NUL);
1752 if Write (File, Str'Address, Len) /= Len then
1753 raise Program_Error;
1762 (F : File_Descriptor;
1771 Len : constant Natural := S'Length;
1774 -- Write current line, followed by LF
1782 Put (F, Line (1 .. Last));
1787 -- Start of processing for Put
1790 if C1 = F1 and then C2 = F2 then
1794 if Last + Len + 3 >= Max then
1802 if C1 = F1 and then C2 = F2 then
1854 procedure Put_Edges (File : File_Descriptor; Title : String) is
1856 F1 : constant Natural := 1;
1857 L1 : constant Natural := Edges_Len - 1;
1858 M : constant Natural := Max / 5;
1864 -- Edges valid range is 1 .. Edge_Len - 1
1866 for J in F1 .. L1 loop
1868 Put (File, Image (J, M), F1, L1, J, 1, 4, 1);
1869 Put (File, Image (E.X, M), F1, L1, J, 1, 4, 2);
1870 Put (File, Image (E.Y, M), F1, L1, J, 1, 4, 3);
1871 Put (File, Image (E.Key, M), F1, L1, J, 1, 4, 4);
1875 ----------------------
1876 -- Put_Initial_Keys --
1877 ----------------------
1879 procedure Put_Initial_Keys (File : File_Descriptor; Title : String) is
1880 F1 : constant Natural := 0;
1881 L1 : constant Natural := NK - 1;
1882 M : constant Natural := Max / 5;
1889 for J in F1 .. L1 loop
1891 Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
1892 Put (File, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
1893 Put (File, Trim_Trailing_Nuls (WT.Table (Initial (J)).all),
1894 F1, L1, J, 1, 3, 3);
1896 end Put_Initial_Keys;
1898 --------------------
1899 -- Put_Int_Matrix --
1900 --------------------
1902 procedure Put_Int_Matrix
1903 (File : File_Descriptor;
1909 F1 : constant Integer := 0;
1910 L1 : constant Integer := Len_1 - 1;
1911 F2 : constant Integer := 0;
1912 L2 : constant Integer := Len_2 - 1;
1920 for J in F1 .. L1 loop
1921 Ix := IT.Table (Table + J);
1922 Put (File, Image (Ix), 1, 0, 1, F1, L1, J);
1926 for J in F1 .. L1 loop
1927 for K in F2 .. L2 loop
1928 Ix := IT.Table (Table + J + K * Len_1);
1929 Put (File, Image (Ix), F1, L1, J, F2, L2, K);
1935 --------------------
1936 -- Put_Int_Vector --
1937 --------------------
1939 procedure Put_Int_Vector
1940 (File : File_Descriptor;
1945 F2 : constant Natural := 0;
1946 L2 : constant Natural := Length - 1;
1952 for J in F2 .. L2 loop
1953 Put (File, Image (IT.Table (Vector + J)), 1, 0, 1, F2, L2, J);
1957 ----------------------
1958 -- Put_Reduced_Keys --
1959 ----------------------
1961 procedure Put_Reduced_Keys (File : File_Descriptor; Title : String) is
1962 F1 : constant Natural := 0;
1963 L1 : constant Natural := NK - 1;
1964 M : constant Natural := Max / 5;
1971 for J in F1 .. L1 loop
1973 Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
1974 Put (File, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
1975 Put (File, Trim_Trailing_Nuls (WT.Table (Reduced (J)).all),
1976 F1, L1, J, 1, 3, 3);
1978 end Put_Reduced_Keys;
1980 -----------------------
1981 -- Put_Used_Char_Set --
1982 -----------------------
1984 procedure Put_Used_Char_Set (File : File_Descriptor; Title : String) is
1985 F : constant Natural := Character'Pos (Character'First);
1986 L : constant Natural := Character'Pos (Character'Last);
1992 for J in Character'Range loop
1994 (File, Image (Get_Used_Char (J)), 1, 0, 1, F, L, Character'Pos (J));
1996 end Put_Used_Char_Set;
1998 ----------------------
1999 -- Put_Vertex_Table --
2000 ----------------------
2002 procedure Put_Vertex_Table (File : File_Descriptor; Title : String) is
2003 F1 : constant Natural := 0;
2004 L1 : constant Natural := NV - 1;
2005 M : constant Natural := Max / 4;
2012 for J in F1 .. L1 loop
2013 V := Get_Vertices (J);
2014 Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
2015 Put (File, Image (V.First, M), F1, L1, J, 1, 3, 2);
2016 Put (File, Image (V.Last, M), F1, L1, J, 1, 3, 3);
2018 end Put_Vertex_Table;
2024 procedure Random (Seed : in out Natural) is
2026 -- Park & Miller Standard Minimal using Schrage's algorithm to avoid
2027 -- overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1)
2034 R := Seed mod 127773;
2036 X := 16807 * R - 2836 * Q;
2038 Seed := (if X < 0 then X + 2147483647 else X);
2045 function Reduced (K : Key_Id) return Word_Id is
2054 procedure Resize_Word (W : in out Word_Type; Len : Natural) is
2055 S1 : constant String := W.all;
2056 S2 : String (1 .. Len) := (others => ASCII.NUL);
2057 L : constant Natural := S1'Length;
2066 --------------------------
2067 -- Select_Char_Position --
2068 --------------------------
2070 procedure Select_Char_Position is
2072 type Vertex_Table_Type is array (Natural range <>) of Vertex_Type;
2074 procedure Build_Identical_Keys_Sets
2075 (Table : in out Vertex_Table_Type;
2076 Last : in out Natural;
2078 -- Build a list of keys subsets that are identical with the current
2079 -- position selection plus Pos. Once this routine is called, reduced
2080 -- words are sorted by subsets and each item (First, Last) in Sets
2081 -- defines the range of identical keys.
2082 -- Need comment saying exactly what Last is ???
2084 function Count_Different_Keys
2085 (Table : Vertex_Table_Type;
2087 Pos : Natural) return Natural;
2088 -- For each subset in Sets, count the number of different keys if we add
2089 -- Pos to the current position selection.
2091 Sel_Position : IT.Table_Type (1 .. Max_Key_Len);
2092 Last_Sel_Pos : Natural := 0;
2093 Max_Sel_Pos : Natural := 0;
2095 -------------------------------
2096 -- Build_Identical_Keys_Sets --
2097 -------------------------------
2099 procedure Build_Identical_Keys_Sets
2100 (Table : in out Vertex_Table_Type;
2101 Last : in out Natural;
2104 S : constant Vertex_Table_Type := Table (Table'First .. Last);
2105 C : constant Natural := Pos;
2106 -- Shortcuts (why are these not renames ???)
2110 -- First and last words of a subset
2113 -- GNAT.Heap_Sort assumes that the first array index is 1. Offset
2114 -- defines the translation to operate.
2116 function Lt (L, R : Natural) return Boolean;
2117 procedure Move (From : Natural; To : Natural);
2118 -- Subprograms needed by GNAT.Heap_Sort_G
2124 function Lt (L, R : Natural) return Boolean is
2125 C : constant Natural := Pos;
2132 Right := Offset + R;
2138 Right := Offset + R;
2141 return WT.Table (Left)(C) < WT.Table (Right)(C);
2148 procedure Move (From : Natural; To : Natural) is
2149 Target, Source : Natural;
2154 Target := Offset + To;
2156 Source := Offset + From;
2159 Source := Offset + From;
2160 Target := Offset + To;
2163 WT.Table (Target) := WT.Table (Source);
2164 WT.Table (Source) := null;
2167 package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
2169 -- Start of processing for Build_Identical_Key_Sets
2174 -- For each subset in S, extract the new subsets we have by adding C
2175 -- in the position selection.
2177 for J in S'Range loop
2178 if S (J).First = S (J).Last then
2182 Table (Last) := (F, L);
2185 Offset := Reduced (S (J).First) - 1;
2186 Sorting.Sort (S (J).Last - S (J).First + 1);
2190 for N in S (J).First .. S (J).Last loop
2192 -- For the last item, close the last subset
2194 if N = S (J).Last then
2196 Table (Last) := (F, N);
2198 -- Two contiguous words are identical when they have the
2199 -- same Cth character.
2201 elsif WT.Table (Reduced (N))(C) =
2202 WT.Table (Reduced (N + 1))(C)
2206 -- Find a new subset of identical keys. Store the current
2207 -- one and create a new subset.
2211 Table (Last) := (F, L);
2218 end Build_Identical_Keys_Sets;
2220 --------------------------
2221 -- Count_Different_Keys --
2222 --------------------------
2224 function Count_Different_Keys
2225 (Table : Vertex_Table_Type;
2227 Pos : Natural) return Natural
2229 N : array (Character) of Natural;
2234 -- For each subset, count the number of words that are still
2235 -- different when we include Pos in the position selection. Only
2236 -- focus on this position as the other positions already produce
2239 for S in 1 .. Last loop
2241 -- Count the occurrences of the different characters
2244 for K in Table (S).First .. Table (S).Last loop
2245 C := WT.Table (Reduced (K))(Pos);
2249 -- Update the number of different keys. Each character used
2250 -- denotes a different key.
2252 for J in N'Range loop
2260 end Count_Different_Keys;
2262 -- Start of processing for Select_Char_Position
2265 -- Initialize the reduced words set
2267 for K in 0 .. NK - 1 loop
2268 WT.Table (Reduced (K)) := New_Word (WT.Table (Initial (K)).all);
2272 Differences : Natural;
2273 Max_Differences : Natural := 0;
2274 Old_Differences : Natural;
2275 Max_Diff_Sel_Pos : Natural := 0; -- init to kill warning
2276 Max_Diff_Sel_Pos_Idx : Natural := 0; -- init to kill warning
2277 Same_Keys_Sets_Table : Vertex_Table_Type (1 .. NK);
2278 Same_Keys_Sets_Last : Natural := 1;
2281 for C in Sel_Position'Range loop
2282 Sel_Position (C) := C;
2285 Same_Keys_Sets_Table (1) := (0, NK - 1);
2288 -- Preserve maximum number of different keys and check later on
2289 -- that this value is strictly incrementing. Otherwise, it means
2290 -- that two keys are strictly identical.
2292 Old_Differences := Max_Differences;
2294 -- The first position should not exceed the minimum key length.
2295 -- Otherwise, we may end up with an empty word once reduced.
2298 (if Last_Sel_Pos = 0 then Min_Key_Len else Max_Key_Len);
2300 -- Find which position increases more the number of differences
2302 for J in Last_Sel_Pos + 1 .. Max_Sel_Pos loop
2303 Differences := Count_Different_Keys
2304 (Same_Keys_Sets_Table,
2305 Same_Keys_Sets_Last,
2310 "Selecting position" & Sel_Position (J)'Img &
2311 " results in" & Differences'Img &
2316 if Differences > Max_Differences then
2317 Max_Differences := Differences;
2318 Max_Diff_Sel_Pos := Sel_Position (J);
2319 Max_Diff_Sel_Pos_Idx := J;
2323 if Old_Differences = Max_Differences then
2324 raise Program_Error with "some keys are identical";
2327 -- Insert selected position and sort Sel_Position table
2329 Last_Sel_Pos := Last_Sel_Pos + 1;
2330 Sel_Position (Last_Sel_Pos + 1 .. Max_Diff_Sel_Pos_Idx) :=
2331 Sel_Position (Last_Sel_Pos .. Max_Diff_Sel_Pos_Idx - 1);
2332 Sel_Position (Last_Sel_Pos) := Max_Diff_Sel_Pos;
2334 for P in 1 .. Last_Sel_Pos - 1 loop
2335 if Max_Diff_Sel_Pos < Sel_Position (P) then
2336 Sel_Position (P + 1 .. Last_Sel_Pos) :=
2337 Sel_Position (P .. Last_Sel_Pos - 1);
2338 Sel_Position (P) := Max_Diff_Sel_Pos;
2343 exit when Max_Differences = NK;
2345 Build_Identical_Keys_Sets
2346 (Same_Keys_Sets_Table,
2347 Same_Keys_Sets_Last,
2352 "Selecting position" & Max_Diff_Sel_Pos'Img &
2353 " results in" & Max_Differences'Img &
2358 for J in 1 .. Same_Keys_Sets_Last loop
2360 Same_Keys_Sets_Table (J).First ..
2361 Same_Keys_Sets_Table (J).Last
2364 Trim_Trailing_Nuls (WT.Table (Reduced (K)).all));
2374 Char_Pos_Set_Len := Last_Sel_Pos;
2375 Char_Pos_Set := Allocate (Char_Pos_Set_Len);
2377 for C in 1 .. Last_Sel_Pos loop
2378 Set_Char_Pos (C - 1, Sel_Position (C));
2380 end Select_Char_Position;
2382 --------------------------
2383 -- Select_Character_Set --
2384 --------------------------
2386 procedure Select_Character_Set is
2387 Last : Natural := 0;
2388 Used : array (Character) of Boolean := (others => False);
2392 for J in 0 .. NK - 1 loop
2393 for K in 0 .. Char_Pos_Set_Len - 1 loop
2394 Char := WT.Table (Initial (J))(Get_Char_Pos (K));
2395 exit when Char = ASCII.NUL;
2396 Used (Char) := True;
2400 Used_Char_Set_Len := 256;
2401 Used_Char_Set := Allocate (Used_Char_Set_Len);
2403 for J in Used'Range loop
2405 Set_Used_Char (J, Last);
2408 Set_Used_Char (J, 0);
2411 end Select_Character_Set;
2417 procedure Set_Char_Pos (P : Natural; Item : Natural) is
2418 N : constant Natural := Char_Pos_Set + P;
2420 IT.Table (N) := Item;
2427 procedure Set_Edges (F : Natural; Item : Edge_Type) is
2428 N : constant Natural := Edges + (F * Edge_Size);
2430 IT.Table (N) := Item.X;
2431 IT.Table (N + 1) := Item.Y;
2432 IT.Table (N + 2) := Item.Key;
2439 procedure Set_Graph (N : Natural; Item : Integer) is
2441 IT.Table (G + N) := Item;
2448 procedure Set_Key (N : Key_Id; Item : Key_Type) is
2450 IT.Table (Keys + N) := Item.Edge;
2457 procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural) is
2458 N : constant Natural := T + ((Y * T1_Len) + X);
2460 IT.Table (N) := Item;
2467 procedure Set_Used_Char (C : Character; Item : Natural) is
2468 N : constant Natural := Used_Char_Set + Character'Pos (C);
2470 IT.Table (N) := Item;
2477 procedure Set_Vertices (F : Natural; Item : Vertex_Type) is
2478 N : constant Natural := Vertices + (F * Vertex_Size);
2480 IT.Table (N) := Item.First;
2481 IT.Table (N + 1) := Item.Last;
2491 Opt : Optimization) return Natural
2499 for J in 0 .. T1_Len - 1 loop
2500 exit when Word (J + 1) = ASCII.NUL;
2501 R := Get_Table (Table, J, Get_Used_Char (Word (J + 1)));
2502 S := (S + R) mod NV;
2505 when Memory_Space =>
2506 for J in 0 .. T1_Len - 1 loop
2507 exit when Word (J + 1) = ASCII.NUL;
2508 R := Get_Table (Table, J, 0);
2509 S := (S + R * Character'Pos (Word (J + 1))) mod NV;
2516 ------------------------
2517 -- Trim_Trailing_Nuls --
2518 ------------------------
2520 function Trim_Trailing_Nuls (Str : String) return String is
2522 for J in reverse Str'Range loop
2523 if Str (J) /= ASCII.NUL then
2524 return Str (Str'First .. J);
2529 end Trim_Trailing_Nuls;
2535 function Type_Size (L : Natural) return Natural is
2539 elsif L <= 2 ** 16 then
2553 K : Natural := 0) return Natural
2557 when Character_Position =>
2558 return Get_Char_Pos (J);
2560 when Used_Character_Set =>
2561 return Get_Used_Char (Character'Val (J));
2563 when Function_Table_1 =>
2564 return Get_Table (T1, J, K);
2566 when Function_Table_2 =>
2567 return Get_Table (T2, J, K);
2570 return Get_Graph (J);
2575 end GNAT.Perfect_Hash_Generators;