?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Update concepts branch to revision 131834
[official-gcc.git] / gcc / ada / g-pehage.adb
blob8d4733334d6e8d8355c5a3c3d6fedb7e72383593
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
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 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2007, AdaCore --
10 -- --
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. --
21 -- --
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. --
28 -- --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 -- --
32 ------------------------------------------------------------------------------
33
34 with Ada.IO_Exceptions; use Ada.IO_Exceptions;
35
36 with GNAT.Heap_Sort_G;
37 with GNAT.OS_Lib; use GNAT.OS_Lib;
38 with GNAT.Table;
39
40 package body GNAT.Perfect_Hash_Generators is
41
42 -- We are using the algorithm of J. Czech as described in Zbigniew J.
43 -- Czech, George Havas, and Bohdan S. Majewski ``An Optimal Algorithm for
44 -- Generating Minimal Perfect Hash Functions'', Information Processing
45 -- Letters, 43(1992) pp.257-264, Oct.1992
46
47 -- This minimal perfect hash function generator is based on random graphs
48 -- and produces a hash function of the form:
49
50 -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
51
52 -- where f1 and f2 are functions that map strings into integers, and g is a
53 -- function that maps integers into [0, m-1]. h can be order preserving.
54 -- For instance, let W = {w_0, ..., w_i, ...,
55 -- w_m-1}, h can be defined such that h (w_i) = i.
56
57 -- This algorithm defines two possible constructions of f1 and f2. Method
58 -- b) stores the hash function in less memory space at the expense of
59 -- greater CPU time.
60
61 -- a) fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
62
63 -- size (Tk) = max (for w in W) (length (w)) * size (used char set)
64
65 -- b) fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
66
67 -- size (Tk) = max (for w in W) (length (w)) but the table lookups are
68 -- replaced by multiplications.
69
70 -- where Tk values are randomly generated. n is defined later on but the
71 -- algorithm recommends to use a value a little bit greater than 2m. Note
72 -- that for large values of m, the main memory space requirements comes
73 -- from the memory space for storing function g (>= 2m entries).
74
75 -- Random graphs are frequently used to solve difficult problems that do
76 -- not have polynomial solutions. This algorithm is based on a weighted
77 -- undirected graph. It comprises two steps: mapping and assignment.
78
79 -- In the mapping step, a graph G = (V, E) is constructed, where = {0, 1,
80 -- ..., n-1} and E = {(for w in W) (f1 (w), f2 (w))}. In order for the
81 -- assignment step to be successful, G has to be acyclic. To have a high
82 -- probability of generating an acyclic graph, n >= 2m. If it is not
83 -- acyclic, Tk have to be regenerated.
84
85 -- In the assignment step, the algorithm builds function g. As is acyclic,
86 -- there is a vertex v1 with only one neighbor v2. Let w_i be the word such
87 -- that v1 = f1 (w_i) and v2 = f2 (w_i). Let g (v1) = 0 by construction and
88 -- g (v2) = (i - g (v1)) mod n (or to be general, (h (i) - g (v1) mod n).
89 -- If word w_j is such that v2 = f1 (w_j) and v3 = f2 (w_j), g (v3) = (j -
90 -- g (v2)) mod (or to be general, (h (j) - g (v2)) mod n). If w_i has no
91 -- neighbor, then another vertex is selected. The algorithm traverses G to
92 -- assign values to all the vertices. It cannot assign a value to an
93 -- already assigned vertex as G is acyclic.
94
95 subtype Word_Id is Integer;
96 subtype Key_Id is Integer;
97 subtype Vertex_Id is Integer;
98 subtype Edge_Id is Integer;
99 subtype Table_Id is Integer;
100
101 No_Vertex : constant Vertex_Id := -1;
102 No_Edge : constant Edge_Id := -1;
103 No_Table : constant Table_Id := -1;
104
105 Max_Word_Length : constant := 32;
106 subtype Word_Type is String (1 .. Max_Word_Length);
107 Null_Word : constant Word_Type := (others => ASCII.NUL);
108 -- Store keyword in a word. Note that the length of word is limited to 32
109 -- characters.
110
111 type Key_Type is record
112 Edge : Edge_Id;
113 end record;
114 -- A key corresponds to an edge in the algorithm graph
115
116 type Vertex_Type is record
117 First : Edge_Id;
118 Last : Edge_Id;
119 end record;
120 -- A vertex can be involved in several edges. First and Last are the bounds
121 -- of an array of edges stored in a global edge table.
122
123 type Edge_Type is record
124 X : Vertex_Id;
125 Y : Vertex_Id;
126 Key : Key_Id;
127 end record;
128 -- An edge is a peer of vertices. In the algorithm, a key is associated to
129 -- an edge.
130
131 package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32);
132 package IT is new GNAT.Table (Integer, Integer, 0, 32, 32);
133 -- The two main tables. IT is used to store several tables of components
134 -- containing only integers.
135
136 function Image (Int : Integer; W : Natural := 0) return String;
137 function Image (Str : String; W : Natural := 0) return String;
138 -- Return a string which includes string Str or integer Int preceded by
139 -- leading spaces if required by width W.
140
141 Output : File_Descriptor renames GNAT.OS_Lib.Standout;
142 -- Shortcuts
143
144 EOL : constant Character := ASCII.LF;
145
146 Max : constant := 78;
147 Last : Natural := 0;
148 Line : String (1 .. Max);
149 -- Use this line to provide buffered IO
150
151 procedure Add (C : Character);
152 procedure Add (S : String);
153 -- Add a character or a string in Line and update Last
154
155 procedure Put
156 (F : File_Descriptor;
157 S : String;
158 F1 : Natural;
159 L1 : Natural;
160 C1 : Natural;
161 F2 : Natural;
162 L2 : Natural;
163 C2 : Natural);
164 -- Write string S into file F as a element of an array of one or two
165 -- dimensions. Fk (resp. Lk and Ck) indicates the first (resp last and
166 -- current) index in the k-th dimension. If F1 = L1 the array is considered
167 -- as a one dimension array. This dimension is described by F2 and L2. This
168 -- routine takes care of all the parenthesis, spaces and commas needed to
169 -- format correctly the array. Moreover, the array is well indented and is
170 -- wrapped to fit in a 80 col line. When the line is full, the routine
171 -- writes it into file F. When the array is completed, the routine adds
172 -- semi-colon and writes the line into file F.
173
174 procedure New_Line (File : File_Descriptor);
175 -- Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib
176
177 procedure Put (File : File_Descriptor; Str : String);
178 -- Simulate Ada.Text_IO.Put with GNAT.OS_Lib
179
180 procedure Put_Used_Char_Set (File : File_Descriptor; Title : String);
181 -- Output a title and a used character set
182
183 procedure Put_Int_Vector
184 (File : File_Descriptor;
185 Title : String;
186 Vector : Integer;
187 Length : Natural);
188 -- Output a title and a vector
189
190 procedure Put_Int_Matrix
191 (File : File_Descriptor;
192 Title : String;
193 Table : Table_Id;
194 Len_1 : Natural;
195 Len_2 : Natural);
196 -- Output a title and a matrix. When the matrix has only one non-empty
197 -- dimension (Len_2 = 0), output a vector.
198
199 procedure Put_Edges (File : File_Descriptor; Title : String);
200 -- Output a title and an edge table
201
202 procedure Put_Initial_Keys (File : File_Descriptor; Title : String);
203 -- Output a title and a key table
204
205 procedure Put_Reduced_Keys (File : File_Descriptor; Title : String);
206 -- Output a title and a key table
207
208 procedure Put_Vertex_Table (File : File_Descriptor; Title : String);
209 -- Output a title and a vertex table
210
211 ----------------------------------
212 -- Character Position Selection --
213 ----------------------------------
214
215 -- We reduce the maximum key size by selecting representative positions
216 -- in these keys. We build a matrix with one word per line. We fill the
217 -- remaining space of a line with ASCII.NUL. The heuristic selects the
218 -- position that induces the minimum number of collisions. If there are
219 -- collisions, select another position on the reduced key set responsible
220 -- of the collisions. Apply the heuristic until there is no more collision.
221
222 procedure Apply_Position_Selection;
223 -- Apply Position selection and build the reduced key table
224
225 procedure Parse_Position_Selection (Argument : String);
226 -- Parse Argument and compute the position set. Argument is list of
227 -- substrings separated by commas. Each substring represents a position
228 -- or a range of positions (like x-y).
229
230 procedure Select_Character_Set;
231 -- Define an optimized used character set like Character'Pos in order not
232 -- to allocate tables of 256 entries.
233
234 procedure Select_Char_Position;
235 -- Find a min char position set in order to reduce the max key length. The
236 -- heuristic selects the position that induces the minimum number of
237 -- collisions. If there are collisions, select another position on the
238 -- reduced key set responsible of the collisions. Apply the heuristic until
239 -- there is no collision.
240
241 -----------------------------
242 -- Random Graph Generation --
243 -----------------------------
244
245 procedure Random (Seed : in out Natural);
246 -- Simulate Ada.Discrete_Numerics.Random
247
248 procedure Generate_Mapping_Table
249 (Tab : Table_Id;
250 L1 : Natural;
251 L2 : Natural;
252 Seed : in out Natural);
253 -- Random generation of the tables below. T is already allocated
254
255 procedure Generate_Mapping_Tables
256 (Opt : Optimization;
257 Seed : in out Natural);
258 -- Generate the mapping tables T1 and T2. They are used to define fk (w) =
259 -- sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n. Keys, NK and Chars
260 -- are used to compute the matrix size.
261
262 ---------------------------
263 -- Algorithm Computation --
264 ---------------------------
265
266 procedure Compute_Edges_And_Vertices (Opt : Optimization);
267 -- Compute the edge and vertex tables. These are empty when a self loop is
268 -- detected (f1 (w) = f2 (w)). The edge table is sorted by X value and then
269 -- Y value. Keys is the key table and NK the number of keys. Chars is the
270 -- set of characters really used in Keys. NV is the number of vertices
271 -- recommended by the algorithm. T1 and T2 are the mapping tables needed to
272 -- compute f1 (w) and f2 (w).
273
274 function Acyclic return Boolean;
275 -- Return True when the graph is acyclic. Vertices is the current vertex
276 -- table and Edges the current edge table.
277
278 procedure Assign_Values_To_Vertices;
279 -- Execute the assignment step of the algorithm. Keys is the current key
280 -- table. Vertices and Edges represent the random graph. G is the result of
281 -- the assignment step such that:
282 -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
283
284 function Sum
285 (Word : Word_Type;
286 Table : Table_Id;
287 Opt : Optimization) return Natural;
288 -- For an optimization of CPU_Time return
289 -- fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
290 -- For an optimization of Memory_Space return
291 -- fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
292 -- Here NV = n
293
294 -------------------------------
295 -- Internal Table Management --
296 -------------------------------
297
298 function Allocate (N : Natural; S : Natural := 1) return Table_Id;
299 -- Allocate N * S ints from IT table
300
301 procedure Free_Tmp_Tables;
302 -- Deallocate the tables used by the algorithm (but not the keys table)
303
304 ----------
305 -- Keys --
306 ----------
307
308 Keys : Table_Id := No_Table;
309 NK : Natural := 0;
310 -- NK : Number of Keys
311
312 function Initial (K : Key_Id) return Word_Id;
313 pragma Inline (Initial);
314
315 function Reduced (K : Key_Id) return Word_Id;
316 pragma Inline (Reduced);
317
318 function Get_Key (N : Key_Id) return Key_Type;
319 procedure Set_Key (N : Key_Id; Item : Key_Type);
320 -- Get or Set Nth element of Keys table
321
322 ------------------
323 -- Char_Pos_Set --
324 ------------------
325
326 Char_Pos_Set : Table_Id := No_Table;
327 Char_Pos_Set_Len : Natural;
328 -- Character Selected Position Set
329
330 function Get_Char_Pos (P : Natural) return Natural;
331 procedure Set_Char_Pos (P : Natural; Item : Natural);
332 -- Get or Set the string position of the Pth selected character
333
334 -------------------
335 -- Used_Char_Set --
336 -------------------
337
338 Used_Char_Set : Table_Id := No_Table;
339 Used_Char_Set_Len : Natural;
340 -- Used Character Set : Define a new character mapping. When all the
341 -- characters are not present in the keys, in order to reduce the size
342 -- of some tables, we redefine the character mapping.
343
344 function Get_Used_Char (C : Character) return Natural;
345 procedure Set_Used_Char (C : Character; Item : Natural);
346
347 ------------
348 -- Tables --
349 ------------
350
351 T1 : Table_Id := No_Table;
352 T2 : Table_Id := No_Table;
353 T1_Len : Natural;
354 T2_Len : Natural;
355 -- T1 : Values table to compute F1
356 -- T2 : Values table to compute F2
357
358 function Get_Table (T : Integer; X, Y : Natural) return Natural;
359 procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural);
360
361 -----------
362 -- Graph --
363 -----------
364
365 G : Table_Id := No_Table;
366 G_Len : Natural;
367 -- Values table to compute G
368
369 NT : Natural := Default_Tries;
370 -- Number of tries running the algorithm before raising an error
371
372 function Get_Graph (N : Natural) return Integer;
373 procedure Set_Graph (N : Natural; Item : Integer);
374 -- Get or Set Nth element of graph
375
376 -----------
377 -- Edges --
378 -----------
379
380 Edge_Size : constant := 3;
381 Edges : Table_Id := No_Table;
382 Edges_Len : Natural;
383 -- Edges : Edge table of the random graph G
384
385 function Get_Edges (F : Natural) return Edge_Type;
386 procedure Set_Edges (F : Natural; Item : Edge_Type);
387
388 --------------
389 -- Vertices --
390 --------------
391
392 Vertex_Size : constant := 2;
393
394 Vertices : Table_Id := No_Table;
395 -- Vertex table of the random graph G
396
397 NV : Natural;
398 -- Number of Vertices
399
400 function Get_Vertices (F : Natural) return Vertex_Type;
401 procedure Set_Vertices (F : Natural; Item : Vertex_Type);
402 -- Comments needed ???
403
404 K2V : Float;
405 -- Ratio between Keys and Vertices (parameter of Czech's algorithm)
406
407 Opt : Optimization;
408 -- Optimization mode (memory vs CPU)
409
410 Max_Key_Len : Natural := 0;
411 Min_Key_Len : Natural := Max_Word_Length;
412 -- Maximum and minimum of all the word length
413
414 S : Natural;
415 -- Seed
416
417 function Type_Size (L : Natural) return Natural;
418 -- Given the last L of an unsigned integer type T, return its size
419
420 -------------
421 -- Acyclic --
422 -------------
423
424 function Acyclic return Boolean is
425 Marks : array (0 .. NV - 1) of Vertex_Id := (others => No_Vertex);
426
427 function Traverse (Edge : Edge_Id; Mark : Vertex_Id) return Boolean;
428 -- Propagate Mark from X to Y. X is already marked. Mark Y and propagate
429 -- it to the edges of Y except the one representing the same key. Return
430 -- False when Y is marked with Mark.
431
432 --------------
433 -- Traverse --
434 --------------
435
436 function Traverse (Edge : Edge_Id; Mark : Vertex_Id) return Boolean is
437 E : constant Edge_Type := Get_Edges (Edge);
438 K : constant Key_Id := E.Key;
439 Y : constant Vertex_Id := E.Y;
440 M : constant Vertex_Id := Marks (E.Y);
441 V : Vertex_Type;
442
443 begin
444 if M = Mark then
445 return False;
446
447 elsif M = No_Vertex then
448 Marks (Y) := Mark;
449 V := Get_Vertices (Y);
450
451 for J in V.First .. V.Last loop
452
453 -- Do not propagate to the edge representing the same key
454
455 if Get_Edges (J).Key /= K
456 and then not Traverse (J, Mark)
457 then
458 return False;
459 end if;
460 end loop;
461 end if;
462
463 return True;
464 end Traverse;
465
466 Edge : Edge_Type;
467
468 -- Start of processing for Acyclic
469
470 begin
471 -- Edges valid range is
472
473 for J in 1 .. Edges_Len - 1 loop
474
475 Edge := Get_Edges (J);
476
477 -- Mark X of E when it has not been already done
478
479 if Marks (Edge.X) = No_Vertex then
480 Marks (Edge.X) := Edge.X;
481 end if;
482
483 -- Traverse E when this has not already been done
484
485 if Marks (Edge.Y) = No_Vertex
486 and then not Traverse (J, Edge.X)
487 then
488 return False;
489 end if;
490 end loop;
491
492 return True;
493 end Acyclic;
494
495 ---------
496 -- Add --
497 ---------
498
499 procedure Add (C : Character) is
500 begin
501 Line (Last + 1) := C;
502 Last := Last + 1;
503 end Add;
504
505 ---------
506 -- Add --
507 ---------
508
509 procedure Add (S : String) is
510 Len : constant Natural := S'Length;
511 begin
512 Line (Last + 1 .. Last + Len) := S;
513 Last := Last + Len;
514 end Add;
515
516 --------------
517 -- Allocate --
518 --------------
519
520 function Allocate (N : Natural; S : Natural := 1) return Table_Id is
521 L : constant Integer := IT.Last;
522 begin
523 IT.Set_Last (L + N * S);
524 return L + 1;
525 end Allocate;
526
527 ------------------------------
528 -- Apply_Position_Selection --
529 ------------------------------
530
531 procedure Apply_Position_Selection is
532 begin
533 WT.Set_Last (2 * NK);
534 for J in 0 .. NK - 1 loop
535 declare
536 I_Word : constant Word_Type := WT.Table (Initial (J));
537 R_Word : Word_Type := Null_Word;
538 Index : Natural := I_Word'First - 1;
539
540 begin
541 -- Select the characters of Word included in the position
542 -- selection.
543
544 for C in 0 .. Char_Pos_Set_Len - 1 loop
545 exit when I_Word (Get_Char_Pos (C)) = ASCII.NUL;
546 Index := Index + 1;
547 R_Word (Index) := I_Word (Get_Char_Pos (C));
548 end loop;
549
550 -- Build the new table with the reduced word
551
552 WT.Table (Reduced (J)) := R_Word;
553 Set_Key (J, (Edge => No_Edge));
554 end;
555 end loop;
556 end Apply_Position_Selection;
557
558 -------------------------------
559 -- Assign_Values_To_Vertices --
560 -------------------------------
561
562 procedure Assign_Values_To_Vertices is
563 X : Vertex_Id;
564
565 procedure Assign (X : Vertex_Id);
566 -- Execute assignment on X's neighbors except the vertex that we are
567 -- coming from which is already assigned.
568
569 ------------
570 -- Assign --
571 ------------
572
573 procedure Assign (X : Vertex_Id) is
574 E : Edge_Type;
575 V : constant Vertex_Type := Get_Vertices (X);
576
577 begin
578 for J in V.First .. V.Last loop
579 E := Get_Edges (J);
580
581 if Get_Graph (E.Y) = -1 then
582 Set_Graph (E.Y, (E.Key - Get_Graph (X)) mod NK);
583 Assign (E.Y);
584 end if;
585 end loop;
586 end Assign;
587
588 -- Start of processing for Assign_Values_To_Vertices
589
590 begin
591 -- Value -1 denotes an uninitialized value as it is supposed to
592 -- be in the range 0 .. NK.
593
594 if G = No_Table then
595 G_Len := NV;
596 G := Allocate (G_Len, 1);
597 end if;
598
599 for J in 0 .. G_Len - 1 loop
600 Set_Graph (J, -1);
601 end loop;
602
603 for K in 0 .. NK - 1 loop
604 X := Get_Edges (Get_Key (K).Edge).X;
605
606 if Get_Graph (X) = -1 then
607 Set_Graph (X, 0);
608 Assign (X);
609 end if;
610 end loop;
611
612 for J in 0 .. G_Len - 1 loop
613 if Get_Graph (J) = -1 then
614 Set_Graph (J, 0);
615 end if;
616 end loop;
617
618 if Verbose then
619 Put_Int_Vector (Output, "Assign Values To Vertices", G, G_Len);
620 end if;
621 end Assign_Values_To_Vertices;
622
623 -------------
624 -- Compute --
625 -------------
626
627 procedure Compute (Position : String := Default_Position) is
628 Success : Boolean := False;
629
630 begin
631 NV := Natural (K2V * Float (NK));
632
633 Keys := Allocate (NK);
634
635 if Verbose then
636 Put_Initial_Keys (Output, "Initial Key Table");
637 end if;
638
639 if Position'Length /= 0 then
640 Parse_Position_Selection (Position);
641 else
642 Select_Char_Position;
643 end if;
644
645 if Verbose then
646 Put_Int_Vector
647 (Output, "Char Position Set", Char_Pos_Set, Char_Pos_Set_Len);
648 end if;
649
650 Apply_Position_Selection;
651
652 if Verbose then
653 Put_Reduced_Keys (Output, "Reduced Keys Table");
654 end if;
655
656 Select_Character_Set;
657
658 if Verbose then
659 Put_Used_Char_Set (Output, "Character Position Table");
660 end if;
661
662 -- Perform Czech's algorithm
663
664 for J in 1 .. NT loop
665 Generate_Mapping_Tables (Opt, S);
666 Compute_Edges_And_Vertices (Opt);
667
668 -- When graph is not empty (no self-loop from previous operation) and
669 -- not acyclic.
670
671 if 0 < Edges_Len and then Acyclic then
672 Success := True;
673 exit;
674 end if;
675 end loop;
676
677 if not Success then
678 raise Too_Many_Tries;
679 end if;
680
681 Assign_Values_To_Vertices;
682 end Compute;
683
684 --------------------------------
685 -- Compute_Edges_And_Vertices --
686 --------------------------------
687
688 procedure Compute_Edges_And_Vertices (Opt : Optimization) is
689 X : Natural;
690 Y : Natural;
691 Key : Key_Type;
692 Edge : Edge_Type;
693 Vertex : Vertex_Type;
694 Not_Acyclic : Boolean := False;
695
696 procedure Move (From : Natural; To : Natural);
697 function Lt (L, R : Natural) return Boolean;
698 -- Subprograms needed for GNAT.Heap_Sort_G
699
700 --------
701 -- Lt --
702 --------
703
704 function Lt (L, R : Natural) return Boolean is
705 EL : constant Edge_Type := Get_Edges (L);
706 ER : constant Edge_Type := Get_Edges (R);
707 begin
708 return EL.X < ER.X or else (EL.X = ER.X and then EL.Y < ER.Y);
709 end Lt;
710
711 ----------
712 -- Move --
713 ----------
714
715 procedure Move (From : Natural; To : Natural) is
716 begin
717 Set_Edges (To, Get_Edges (From));
718 end Move;
719
720 package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
721
722 -- Start of processing for Compute_Edges_And_Vertices
723
724 begin
725 -- We store edges from 1 to 2 * NK and leave zero alone in order to use
726 -- GNAT.Heap_Sort_G.
727
728 Edges_Len := 2 * NK + 1;
729
730 if Edges = No_Table then
731 Edges := Allocate (Edges_Len, Edge_Size);
732 end if;
733
734 if Vertices = No_Table then
735 Vertices := Allocate (NV, Vertex_Size);
736 end if;
737
738 for J in 0 .. NV - 1 loop
739 Set_Vertices (J, (No_Vertex, No_Vertex - 1));
740 end loop;
741
742 -- For each w, X = f1 (w) and Y = f2 (w)
743
744 for J in 0 .. NK - 1 loop
745 Key := Get_Key (J);
746 Key.Edge := No_Edge;
747 Set_Key (J, Key);
748
749 X := Sum (WT.Table (Reduced (J)), T1, Opt);
750 Y := Sum (WT.Table (Reduced (J)), T2, Opt);
751
752 -- Discard T1 and T2 as soon as we discover a self loop
753
754 if X = Y then
755 Not_Acyclic := True;
756 exit;
757 end if;
758
759 -- We store (X, Y) and (Y, X) to ease assignment step
760
761 Set_Edges (2 * J + 1, (X, Y, J));
762 Set_Edges (2 * J + 2, (Y, X, J));
763 end loop;
764
765 -- Return an empty graph when self loop detected
766
767 if Not_Acyclic then
768 Edges_Len := 0;
769
770 else
771 if Verbose then
772 Put_Edges (Output, "Unsorted Edge Table");
773 Put_Int_Matrix (Output, "Function Table 1", T1,
774 T1_Len, T2_Len);
775 Put_Int_Matrix (Output, "Function Table 2", T2,
776 T1_Len, T2_Len);
777 end if;
778
779 -- Enforce consistency between edges and keys. Construct Vertices and
780 -- compute the list of neighbors of a vertex First .. Last as Edges
781 -- is sorted by X and then Y. To compute the neighbor list, sort the
782 -- edges.
783
784 Sorting.Sort (Edges_Len - 1);
785
786 if Verbose then
787 Put_Edges (Output, "Sorted Edge Table");
788 Put_Int_Matrix (Output, "Function Table 1", T1,
789 T1_Len, T2_Len);
790 Put_Int_Matrix (Output, "Function Table 2", T2,
791 T1_Len, T2_Len);
792 end if;
793
794 -- Edges valid range is 1 .. 2 * NK
795
796 for E in 1 .. Edges_Len - 1 loop
797 Edge := Get_Edges (E);
798 Key := Get_Key (Edge.Key);
799
800 if Key.Edge = No_Edge then
801 Key.Edge := E;
802 Set_Key (Edge.Key, Key);
803 end if;
804
805 Vertex := Get_Vertices (Edge.X);
806
807 if Vertex.First = No_Edge then
808 Vertex.First := E;
809 end if;
810
811 Vertex.Last := E;
812 Set_Vertices (Edge.X, Vertex);
813 end loop;
814
815 if Verbose then
816 Put_Reduced_Keys (Output, "Key Table");
817 Put_Edges (Output, "Edge Table");
818 Put_Vertex_Table (Output, "Vertex Table");
819 end if;
820 end if;
821 end Compute_Edges_And_Vertices;
822
823 ------------
824 -- Define --
825 ------------
826
827 procedure Define
828 (Name : Table_Name;
829 Item_Size : out Natural;
830 Length_1 : out Natural;
831 Length_2 : out Natural)
832 is
833 begin
834 case Name is
835 when Character_Position =>
836 Item_Size := 8;
837 Length_1 := Char_Pos_Set_Len;
838 Length_2 := 0;
839
840 when Used_Character_Set =>
841 Item_Size := 8;
842 Length_1 := 256;
843 Length_2 := 0;
844
845 when Function_Table_1
846 | Function_Table_2 =>
847 Item_Size := Type_Size (NV);
848 Length_1 := T1_Len;
849 Length_2 := T2_Len;
850
851 when Graph_Table =>
852 Item_Size := Type_Size (NK);
853 Length_1 := NV;
854 Length_2 := 0;
855 end case;
856 end Define;
857
858 --------------
859 -- Finalize --
860 --------------
861
862 procedure Finalize is
863 begin
864 Free_Tmp_Tables;
865
866 WT.Release;
867 IT.Release;
868
869 NK := 0;
870 Max_Key_Len := 0;
871 Min_Key_Len := Max_Word_Length;
872 end Finalize;
873
874 ---------------------
875 -- Free_Tmp_Tables --
876 ---------------------
877
878 procedure Free_Tmp_Tables is
879 begin
880 IT.Init;
881
882 Keys := No_Table;
883
884 Char_Pos_Set := No_Table;
885 Char_Pos_Set_Len := 0;
886
887 Used_Char_Set := No_Table;
888 Used_Char_Set_Len := 0;
889
890 T1 := No_Table;
891 T2 := No_Table;
892
893 T1_Len := 0;
894 T2_Len := 0;
895
896 G := No_Table;
897 G_Len := 0;
898
899 Edges := No_Table;
900 Edges_Len := 0;
901
902 Vertices := No_Table;
903 NV := 0;
904 end Free_Tmp_Tables;
905
906 ----------------------------
907 -- Generate_Mapping_Table --
908 ----------------------------
909
910 procedure Generate_Mapping_Table
911 (Tab : Integer;
912 L1 : Natural;
913 L2 : Natural;
914 Seed : in out Natural)
915 is
916 begin
917 for J in 0 .. L1 - 1 loop
918 for K in 0 .. L2 - 1 loop
919 Random (Seed);
920 Set_Table (Tab, J, K, Seed mod NV);
921 end loop;
922 end loop;
923 end Generate_Mapping_Table;
924
925 -----------------------------
926 -- Generate_Mapping_Tables --
927 -----------------------------
928
929 procedure Generate_Mapping_Tables
930 (Opt : Optimization;
931 Seed : in out Natural)
932 is
933 begin
934 -- If T1 and T2 are already allocated no need to do it twice. Reuse them
935 -- as their size has not changed.
936
937 if T1 = No_Table and then T2 = No_Table then
938 declare
939 Used_Char_Last : Natural := 0;
940 Used_Char : Natural;
941
942 begin
943 if Opt = CPU_Time then
944 for P in reverse Character'Range loop
945 Used_Char := Get_Used_Char (P);
946 if Used_Char /= 0 then
947 Used_Char_Last := Used_Char;
948 exit;
949 end if;
950 end loop;
951 end if;
952
953 T1_Len := Char_Pos_Set_Len;
954 T2_Len := Used_Char_Last + 1;
955 T1 := Allocate (T1_Len * T2_Len);
956 T2 := Allocate (T1_Len * T2_Len);
957 end;
958 end if;
959
960 Generate_Mapping_Table (T1, T1_Len, T2_Len, Seed);
961 Generate_Mapping_Table (T2, T1_Len, T2_Len, Seed);
962
963 if Verbose then
964 Put_Used_Char_Set (Output, "Used Character Set");
965 Put_Int_Matrix (Output, "Function Table 1", T1,
966 T1_Len, T2_Len);
967 Put_Int_Matrix (Output, "Function Table 2", T2,
968 T1_Len, T2_Len);
969 end if;
970 end Generate_Mapping_Tables;
971
972 ------------------
973 -- Get_Char_Pos --
974 ------------------
975
976 function Get_Char_Pos (P : Natural) return Natural is
977 N : constant Natural := Char_Pos_Set + P;
978 begin
979 return IT.Table (N);
980 end Get_Char_Pos;
981
982 ---------------
983 -- Get_Edges --
984 ---------------
985
986 function Get_Edges (F : Natural) return Edge_Type is
987 N : constant Natural := Edges + (F * Edge_Size);
988 E : Edge_Type;
989 begin
990 E.X := IT.Table (N);
991 E.Y := IT.Table (N + 1);
992 E.Key := IT.Table (N + 2);
993 return E;
994 end Get_Edges;
995
996 ---------------
997 -- Get_Graph --
998 ---------------
999
1000 function Get_Graph (N : Natural) return Integer is
1001 begin
1002 return IT.Table (G + N);
1003 end Get_Graph;
1004
1005 -------------
1006 -- Get_Key --
1007 -------------
1008
1009 function Get_Key (N : Key_Id) return Key_Type is
1010 K : Key_Type;
1011 begin
1012 K.Edge := IT.Table (Keys + N);
1013 return K;
1014 end Get_Key;
1015
1016 ---------------
1017 -- Get_Table --
1018 ---------------
1019
1020 function Get_Table (T : Integer; X, Y : Natural) return Natural is
1021 N : constant Natural := T + (Y * T1_Len) + X;
1022 begin
1023 return IT.Table (N);
1024 end Get_Table;
1025
1026 -------------------
1027 -- Get_Used_Char --
1028 -------------------
1029
1030 function Get_Used_Char (C : Character) return Natural is
1031 N : constant Natural := Used_Char_Set + Character'Pos (C);
1032 begin
1033 return IT.Table (N);
1034 end Get_Used_Char;
1035
1036 ------------------
1037 -- Get_Vertices --
1038 ------------------
1039
1040 function Get_Vertices (F : Natural) return Vertex_Type is
1041 N : constant Natural := Vertices + (F * Vertex_Size);
1042 V : Vertex_Type;
1043 begin
1044 V.First := IT.Table (N);
1045 V.Last := IT.Table (N + 1);
1046 return V;
1047 end Get_Vertices;
1048
1049 -----------
1050 -- Image --
1051 -----------
1052
1053 function Image (Int : Integer; W : Natural := 0) return String is
1054 B : String (1 .. 32);
1055 L : Natural := 0;
1056
1057 procedure Img (V : Natural);
1058 -- Compute image of V into B, starting at B (L), incrementing L
1059
1060 ---------
1061 -- Img --
1062 ---------
1063
1064 procedure Img (V : Natural) is
1065 begin
1066 if V > 9 then
1067 Img (V / 10);
1068 end if;
1069
1070 L := L + 1;
1071 B (L) := Character'Val ((V mod 10) + Character'Pos ('0'));
1072 end Img;
1073
1074 -- Start of processing for Image
1075
1076 begin
1077 if Int < 0 then
1078 L := L + 1;
1079 B (L) := '-';
1080 Img (-Int);
1081 else
1082 Img (Int);
1083 end if;
1084
1085 return Image (B (1 .. L), W);
1086 end Image;
1087
1088 -----------
1089 -- Image --
1090 -----------
1091
1092 function Image (Str : String; W : Natural := 0) return String is
1093 Len : constant Natural := Str'Length;
1094 Max : Natural := Len;
1095
1096 begin
1097 if Max < W then
1098 Max := W;
1099 end if;
1100
1101 declare
1102 Buf : String (1 .. Max) := (1 .. Max => ' ');
1103
1104 begin
1105 for J in 0 .. Len - 1 loop
1106 Buf (Max - Len + 1 + J) := Str (Str'First + J);
1107 end loop;
1108
1109 return Buf;
1110 end;
1111 end Image;
1112
1113 -------------
1114 -- Initial --
1115 -------------
1116
1117 function Initial (K : Key_Id) return Word_Id is
1118 begin
1119 return K;
1120 end Initial;
1121
1122 ----------------
1123 -- Initialize --
1124 ----------------
1125
1126 procedure Initialize
1127 (Seed : Natural;
1128 K_To_V : Float := Default_K_To_V;
1129 Optim : Optimization := CPU_Time;
1130 Tries : Positive := Default_Tries)
1131 is
1132 begin
1133 -- Free previous tables (the settings may have changed between two runs)
1134
1135 Free_Tmp_Tables;
1136
1137 if K_To_V <= 2.0 then
1138 Put (Output, "K to V ratio cannot be lower than 2.0");
1139 New_Line (Output);
1140 raise Program_Error;
1141 end if;
1142
1143 S := Seed;
1144 K2V := K_To_V;
1145 Opt := Optim;
1146 NT := Tries;
1147 end Initialize;
1148
1149 ------------
1150 -- Insert --
1151 ------------
1152
1153 procedure Insert (Value : String) is
1154 Word : Word_Type := Null_Word;
1155 Len : constant Natural := Value'Length;
1156
1157 begin
1158 Word (1 .. Len) := Value (Value'First .. Value'First + Len - 1);
1159 WT.Set_Last (NK);
1160 WT.Table (NK) := Word;
1161 NK := NK + 1;
1162 NV := Natural (Float (NK) * K2V);
1163
1164 -- Do not accept a value of K2V too close to 2.0 such that once rounded
1165 -- up, NV = 2 * NK because the algorithm would not converge.
1166
1167 if NV <= 2 * NK then
1168 NV := 2 * NK + 1;
1169 end if;
1170
1171 if Max_Key_Len < Len then
1172 Max_Key_Len := Len;
1173 end if;
1174
1175 if Len < Min_Key_Len then
1176 Min_Key_Len := Len;
1177 end if;
1178 end Insert;
1179
1180 --------------
1181 -- New_Line --
1182 --------------
1183
1184 procedure New_Line (File : File_Descriptor) is
1185 begin
1186 if Write (File, EOL'Address, 1) /= 1 then
1187 raise Program_Error;
1188 end if;
1189 end New_Line;
1190
1191 ------------------------------
1192 -- Parse_Position_Selection --
1193 ------------------------------
1194
1195 procedure Parse_Position_Selection (Argument : String) is
1196 N : Natural := Argument'First;
1197 L : constant Natural := Argument'Last;
1198 M : constant Natural := Max_Key_Len;
1199
1200 T : array (1 .. M) of Boolean := (others => False);
1201
1202 function Parse_Index return Natural;
1203 -- Parse argument starting at index N to find an index
1204
1205 -----------------
1206 -- Parse_Index --
1207 -----------------
1208
1209 function Parse_Index return Natural is
1210 C : Character := Argument (N);
1211 V : Natural := 0;
1212
1213 begin
1214 if C = '$' then
1215 N := N + 1;
1216 return M;
1217 end if;
1218
1219 if C not in '0' .. '9' then
1220 raise Program_Error with "cannot read position argument";
1221 end if;
1222
1223 while C in '0' .. '9' loop
1224 V := V * 10 + (Character'Pos (C) - Character'Pos ('0'));
1225 N := N + 1;
1226 exit when L < N;
1227 C := Argument (N);
1228 end loop;
1229
1230 return V;
1231 end Parse_Index;
1232
1233 -- Start of processing for Parse_Position_Selection
1234
1235 begin
1236 -- Empty specification means all the positions
1237
1238 if L < N then
1239 Char_Pos_Set_Len := M;
1240 Char_Pos_Set := Allocate (Char_Pos_Set_Len);
1241
1242 for C in 0 .. Char_Pos_Set_Len - 1 loop
1243 Set_Char_Pos (C, C + 1);
1244 end loop;
1245
1246 else
1247 loop
1248 declare
1249 First, Last : Natural;
1250
1251 begin
1252 First := Parse_Index;
1253 Last := First;
1254
1255 -- Detect a range
1256
1257 if N <= L and then Argument (N) = '-' then
1258 N := N + 1;
1259 Last := Parse_Index;
1260 end if;
1261
1262 -- Include the positions in the selection
1263
1264 for J in First .. Last loop
1265 T (J) := True;
1266 end loop;
1267 end;
1268
1269 exit when L < N;
1270
1271 if Argument (N) /= ',' then
1272 raise Program_Error with "cannot read position argument";
1273 end if;
1274
1275 N := N + 1;
1276 end loop;
1277
1278 -- Compute position selection length
1279
1280 N := 0;
1281 for J in T'Range loop
1282 if T (J) then
1283 N := N + 1;
1284 end if;
1285 end loop;
1286
1287 -- Fill position selection
1288
1289 Char_Pos_Set_Len := N;
1290 Char_Pos_Set := Allocate (Char_Pos_Set_Len);
1291
1292 N := 0;
1293 for J in T'Range loop
1294 if T (J) then
1295 Set_Char_Pos (N, J);
1296 N := N + 1;
1297 end if;
1298 end loop;
1299 end if;
1300 end Parse_Position_Selection;
1301
1302 -------------
1303 -- Produce --
1304 -------------
1305
1306 procedure Produce (Pkg_Name : String := Default_Pkg_Name) is
1307 File : File_Descriptor;
1308
1309 Status : Boolean;
1310 -- For call to Close
1311
1312 function Array_Img (N, T, R1 : String; R2 : String := "") return String;
1313 -- Return string "N : constant array (R1[, R2]) of T;"
1314
1315 function Range_Img (F, L : Natural; T : String := "") return String;
1316 -- Return string "[T range ]F .. L"
1317
1318 function Type_Img (L : Natural) return String;
1319 -- Return the larger unsigned type T such that T'Last < L
1320
1321 ---------------
1322 -- Array_Img --
1323 ---------------
1324
1325 function Array_Img
1326 (N, T, R1 : String;
1327 R2 : String := "") return String
1328 is
1329 begin
1330 Last := 0;
1331 Add (" ");
1332 Add (N);
1333 Add (" : constant array (");
1334 Add (R1);
1335
1336 if R2 /= "" then
1337 Add (", ");
1338 Add (R2);
1339 end if;
1340
1341 Add (") of ");
1342 Add (T);
1343 Add (" :=");
1344 return Line (1 .. Last);
1345 end Array_Img;
1346
1347 ---------------
1348 -- Range_Img --
1349 ---------------
1350
1351 function Range_Img (F, L : Natural; T : String := "") return String is
1352 FI : constant String := Image (F);
1353 FL : constant Natural := FI'Length;
1354 LI : constant String := Image (L);
1355 LL : constant Natural := LI'Length;
1356 TL : constant Natural := T'Length;
1357 RI : String (1 .. TL + 7 + FL + 4 + LL);
1358 Len : Natural := 0;
1359
1360 begin
1361 if TL /= 0 then
1362 RI (Len + 1 .. Len + TL) := T;
1363 Len := Len + TL;
1364 RI (Len + 1 .. Len + 7) := " range ";
1365 Len := Len + 7;
1366 end if;
1367
1368 RI (Len + 1 .. Len + FL) := FI;
1369 Len := Len + FL;
1370 RI (Len + 1 .. Len + 4) := " .. ";
1371 Len := Len + 4;
1372 RI (Len + 1 .. Len + LL) := LI;
1373 Len := Len + LL;
1374 return RI (1 .. Len);
1375 end Range_Img;
1376
1377 --------------
1378 -- Type_Img --
1379 --------------
1380
1381 function Type_Img (L : Natural) return String is
1382 S : constant String := Image (Type_Size (L));
1383 U : String := "Unsigned_ ";
1384 N : Natural := 9;
1385
1386 begin
1387 for J in S'Range loop
1388 N := N + 1;
1389 U (N) := S (J);
1390 end loop;
1391
1392 return U (1 .. N);
1393 end Type_Img;
1394
1395 F : Natural;
1396 L : Natural;
1397 P : Natural;
1398
1399 PLen : constant Natural := Pkg_Name'Length;
1400 FName : String (1 .. PLen + 4);
1401
1402 -- Start of processing for Produce
1403
1404 begin
1405 FName (1 .. PLen) := Pkg_Name;
1406 for J in 1 .. PLen loop
1407 if FName (J) in 'A' .. 'Z' then
1408 FName (J) := Character'Val (Character'Pos (FName (J))
1409 - Character'Pos ('A')
1410 + Character'Pos ('a'));
1411
1412 elsif FName (J) = '.' then
1413 FName (J) := '-';
1414 end if;
1415 end loop;
1416
1417 FName (PLen + 1 .. PLen + 4) := ".ads";
1418
1419 File := Create_File (FName, Binary);
1420
1421 Put (File, "package ");
1422 Put (File, Pkg_Name);
1423 Put (File, " is");
1424 New_Line (File);
1425 Put (File, " function Hash (S : String) return Natural;");
1426 New_Line (File);
1427 Put (File, "end ");
1428 Put (File, Pkg_Name);
1429 Put (File, ";");
1430 New_Line (File);
1431 Close (File, Status);
1432
1433 if not Status then
1434 raise Device_Error;
1435 end if;
1436
1437 FName (PLen + 4) := 'b';
1438
1439 File := Create_File (FName, Binary);
1440
1441 Put (File, "with Interfaces; use Interfaces;");
1442 New_Line (File);
1443 New_Line (File);
1444 Put (File, "package body ");
1445 Put (File, Pkg_Name);
1446 Put (File, " is");
1447 New_Line (File);
1448 New_Line (File);
1449
1450 if Opt = CPU_Time then
1451 Put (File, Array_Img ("C", Type_Img (256), "Character"));
1452 New_Line (File);
1453
1454 F := Character'Pos (Character'First);
1455 L := Character'Pos (Character'Last);
1456
1457 for J in Character'Range loop
1458 P := Get_Used_Char (J);
1459 Put (File, Image (P), 1, 0, 1, F, L, Character'Pos (J));
1460 end loop;
1461
1462 New_Line (File);
1463 end if;
1464
1465 F := 0;
1466 L := Char_Pos_Set_Len - 1;
1467
1468 Put (File, Array_Img ("P", "Natural", Range_Img (F, L)));
1469 New_Line (File);
1470
1471 for J in F .. L loop
1472 Put (File, Image (Get_Char_Pos (J)), 1, 0, 1, F, L, J);
1473 end loop;
1474
1475 New_Line (File);
1476
1477 if Opt = CPU_Time then
1478 Put_Int_Matrix
1479 (File,
1480 Array_Img ("T1", Type_Img (NV),
1481 Range_Img (0, T1_Len - 1),
1482 Range_Img (0, T2_Len - 1, Type_Img (256))),
1483 T1, T1_Len, T2_Len);
1484
1485 else
1486 Put_Int_Matrix
1487 (File,
1488 Array_Img ("T1", Type_Img (NV),
1489 Range_Img (0, T1_Len - 1)),
1490 T1, T1_Len, 0);
1491 end if;
1492
1493 New_Line (File);
1494
1495 if Opt = CPU_Time then
1496 Put_Int_Matrix
1497 (File,
1498 Array_Img ("T2", Type_Img (NV),
1499 Range_Img (0, T1_Len - 1),
1500 Range_Img (0, T2_Len - 1, Type_Img (256))),
1501 T2, T1_Len, T2_Len);
1502
1503 else
1504 Put_Int_Matrix
1505 (File,
1506 Array_Img ("T2", Type_Img (NV),
1507 Range_Img (0, T1_Len - 1)),
1508 T2, T1_Len, 0);
1509 end if;
1510
1511 New_Line (File);
1512
1513 Put_Int_Vector
1514 (File,
1515 Array_Img ("G", Type_Img (NK),
1516 Range_Img (0, G_Len - 1)),
1517 G, G_Len);
1518 New_Line (File);
1519
1520 Put (File, " function Hash (S : String) return Natural is");
1521 New_Line (File);
1522 Put (File, " F : constant Natural := S'First - 1;");
1523 New_Line (File);
1524 Put (File, " L : constant Natural := S'Length;");
1525 New_Line (File);
1526 Put (File, " F1, F2 : Natural := 0;");
1527 New_Line (File);
1528
1529 Put (File, " J : ");
1530
1531 if Opt = CPU_Time then
1532 Put (File, Type_Img (256));
1533 else
1534 Put (File, "Natural");
1535 end if;
1536
1537 Put (File, ";");
1538 New_Line (File);
1539
1540 Put (File, " begin");
1541 New_Line (File);
1542 Put (File, " for K in P'Range loop");
1543 New_Line (File);
1544 Put (File, " exit when L < P (K);");
1545 New_Line (File);
1546 Put (File, " J := ");
1547
1548 if Opt = CPU_Time then
1549 Put (File, "C");
1550 else
1551 Put (File, "Character'Pos");
1552 end if;
1553
1554 Put (File, " (S (P (K) + F));");
1555 New_Line (File);
1556
1557 Put (File, " F1 := (F1 + Natural (T1 (K");
1558
1559 if Opt = CPU_Time then
1560 Put (File, ", J");
1561 end if;
1562
1563 Put (File, "))");
1564
1565 if Opt = Memory_Space then
1566 Put (File, " * J");
1567 end if;
1568
1569 Put (File, ") mod ");
1570 Put (File, Image (NV));
1571 Put (File, ";");
1572 New_Line (File);
1573
1574 Put (File, " F2 := (F2 + Natural (T2 (K");
1575
1576 if Opt = CPU_Time then
1577 Put (File, ", J");
1578 end if;
1579
1580 Put (File, "))");
1581
1582 if Opt = Memory_Space then
1583 Put (File, " * J");
1584 end if;
1585
1586 Put (File, ") mod ");
1587 Put (File, Image (NV));
1588 Put (File, ";");
1589 New_Line (File);
1590
1591 Put (File, " end loop;");
1592 New_Line (File);
1593
1594 Put (File,
1595 " return (Natural (G (F1)) + Natural (G (F2))) mod ");
1596
1597 Put (File, Image (NK));
1598 Put (File, ";");
1599 New_Line (File);
1600 Put (File, " end Hash;");
1601 New_Line (File);
1602 New_Line (File);
1603 Put (File, "end ");
1604 Put (File, Pkg_Name);
1605 Put (File, ";");
1606 New_Line (File);
1607 Close (File, Status);
1608
1609 if not Status then
1610 raise Device_Error;
1611 end if;
1612 end Produce;
1613
1614 ---------
1615 -- Put --
1616 ---------
1617
1618 procedure Put (File : File_Descriptor; Str : String) is
1619 Len : constant Natural := Str'Length;
1620 begin
1621 if Write (File, Str'Address, Len) /= Len then
1622 raise Program_Error;
1623 end if;
1624 end Put;
1625
1626 ---------
1627 -- Put --
1628 ---------
1629
1630 procedure Put
1631 (F : File_Descriptor;
1632 S : String;
1633 F1 : Natural;
1634 L1 : Natural;
1635 C1 : Natural;
1636 F2 : Natural;
1637 L2 : Natural;
1638 C2 : Natural)
1639 is
1640 Len : constant Natural := S'Length;
1641
1642 procedure Flush;
1643 -- Write current line, followed by LF
1644
1645 -----------
1646 -- Flush --
1647 -----------
1648
1649 procedure Flush is
1650 begin
1651 Put (F, Line (1 .. Last));
1652 New_Line (F);
1653 Last := 0;
1654 end Flush;
1655
1656 -- Start of processing for Put
1657
1658 begin
1659 if C1 = F1 and then C2 = F2 then
1660 Last := 0;
1661 end if;
1662
1663 if Last + Len + 3 > Max then
1664 Flush;
1665 end if;
1666
1667 if Last = 0 then
1668 Line (Last + 1 .. Last + 5) := " ";
1669 Last := Last + 5;
1670
1671 if F1 <= L1 then
1672 if C1 = F1 and then C2 = F2 then
1673 Add ('(');
1674
1675 if F1 = L1 then
1676 Add ("0 .. 0 => ");
1677 end if;
1678
1679 else
1680 Add (' ');
1681 end if;
1682 end if;
1683 end if;
1684
1685 if C2 = F2 then
1686 Add ('(');
1687
1688 if F2 = L2 then
1689 Add ("0 .. 0 => ");
1690 end if;
1691
1692 else
1693 Add (' ');
1694 end if;
1695
1696 Line (Last + 1 .. Last + Len) := S;
1697 Last := Last + Len;
1698
1699 if C2 = L2 then
1700 Add (')');
1701
1702 if F1 > L1 then
1703 Add (';');
1704 Flush;
1705
1706 elsif C1 /= L1 then
1707 Add (',');
1708 Flush;
1709
1710 else
1711 Add (')');
1712 Add (';');
1713 Flush;
1714 end if;
1715
1716 else
1717 Add (',');
1718 end if;
1719 end Put;
1720
1721 ---------------
1722 -- Put_Edges --
1723 ---------------
1724
1725 procedure Put_Edges (File : File_Descriptor; Title : String) is
1726 E : Edge_Type;
1727 F1 : constant Natural := 1;
1728 L1 : constant Natural := Edges_Len - 1;
1729 M : constant Natural := Max / 5;
1730
1731 begin
1732 Put (File, Title);
1733 New_Line (File);
1734
1735 -- Edges valid range is 1 .. Edge_Len - 1
1736
1737 for J in F1 .. L1 loop
1738 E := Get_Edges (J);
1739 Put (File, Image (J, M), F1, L1, J, 1, 4, 1);
1740 Put (File, Image (E.X, M), F1, L1, J, 1, 4, 2);
1741 Put (File, Image (E.Y, M), F1, L1, J, 1, 4, 3);
1742 Put (File, Image (E.Key, M), F1, L1, J, 1, 4, 4);
1743 end loop;
1744 end Put_Edges;
1745
1746 ----------------------
1747 -- Put_Initial_Keys --
1748 ----------------------
1749
1750 procedure Put_Initial_Keys (File : File_Descriptor; Title : String) is
1751 F1 : constant Natural := 0;
1752 L1 : constant Natural := NK - 1;
1753 M : constant Natural := Max / 5;
1754 K : Key_Type;
1755
1756 begin
1757 Put (File, Title);
1758 New_Line (File);
1759
1760 for J in F1 .. L1 loop
1761 K := Get_Key (J);
1762 Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
1763 Put (File, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
1764 Put (File, WT.Table (Initial (J)), F1, L1, J, 1, 3, 3);
1765 end loop;
1766 end Put_Initial_Keys;
1767
1768 --------------------
1769 -- Put_Int_Matrix --
1770 --------------------
1771
1772 procedure Put_Int_Matrix
1773 (File : File_Descriptor;
1774 Title : String;
1775 Table : Integer;
1776 Len_1 : Natural;
1777 Len_2 : Natural)
1778 is
1779 F1 : constant Integer := 0;
1780 L1 : constant Integer := Len_1 - 1;
1781 F2 : constant Integer := 0;
1782 L2 : constant Integer := Len_2 - 1;
1783 Ix : Natural;
1784
1785 begin
1786 Put (File, Title);
1787 New_Line (File);
1788
1789 if Len_2 = 0 then
1790 for J in F1 .. L1 loop
1791 Ix := IT.Table (Table + J);
1792 Put (File, Image (Ix), 1, 0, 1, F1, L1, J);
1793 end loop;
1794
1795 else
1796 for J in F1 .. L1 loop
1797 for K in F2 .. L2 loop
1798 Ix := IT.Table (Table + J + K * Len_1);
1799 Put (File, Image (Ix), F1, L1, J, F2, L2, K);
1800 end loop;
1801 end loop;
1802 end if;
1803 end Put_Int_Matrix;
1804
1805 --------------------
1806 -- Put_Int_Vector --
1807 --------------------
1808
1809 procedure Put_Int_Vector
1810 (File : File_Descriptor;
1811 Title : String;
1812 Vector : Integer;
1813 Length : Natural)
1814 is
1815 F2 : constant Natural := 0;
1816 L2 : constant Natural := Length - 1;
1817
1818 begin
1819 Put (File, Title);
1820 New_Line (File);
1821
1822 for J in F2 .. L2 loop
1823 Put (File, Image (IT.Table (Vector + J)), 1, 0, 1, F2, L2, J);
1824 end loop;
1825 end Put_Int_Vector;
1826
1827 ----------------------
1828 -- Put_Reduced_Keys --
1829 ----------------------
1830
1831 procedure Put_Reduced_Keys (File : File_Descriptor; Title : String) is
1832 F1 : constant Natural := 0;
1833 L1 : constant Natural := NK - 1;
1834 M : constant Natural := Max / 5;
1835 K : Key_Type;
1836
1837 begin
1838 Put (File, Title);
1839 New_Line (File);
1840
1841 for J in F1 .. L1 loop
1842 K := Get_Key (J);
1843 Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
1844 Put (File, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
1845 Put (File, WT.Table (Reduced (J)), F1, L1, J, 1, 3, 3);
1846 end loop;
1847 end Put_Reduced_Keys;
1848
1849 -----------------------
1850 -- Put_Used_Char_Set --
1851 -----------------------
1852
1853 procedure Put_Used_Char_Set (File : File_Descriptor; Title : String) is
1854 F : constant Natural := Character'Pos (Character'First);
1855 L : constant Natural := Character'Pos (Character'Last);
1856
1857 begin
1858 Put (File, Title);
1859 New_Line (File);
1860
1861 for J in Character'Range loop
1862 Put
1863 (File, Image (Get_Used_Char (J)), 1, 0, 1, F, L, Character'Pos (J));
1864 end loop;
1865 end Put_Used_Char_Set;
1866
1867 ----------------------
1868 -- Put_Vertex_Table --
1869 ----------------------
1870
1871 procedure Put_Vertex_Table (File : File_Descriptor; Title : String) is
1872 F1 : constant Natural := 0;
1873 L1 : constant Natural := NV - 1;
1874 M : constant Natural := Max / 4;
1875 V : Vertex_Type;
1876
1877 begin
1878 Put (File, Title);
1879 New_Line (File);
1880
1881 for J in F1 .. L1 loop
1882 V := Get_Vertices (J);
1883 Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
1884 Put (File, Image (V.First, M), F1, L1, J, 1, 3, 2);
1885 Put (File, Image (V.Last, M), F1, L1, J, 1, 3, 3);
1886 end loop;
1887 end Put_Vertex_Table;
1888
1889 ------------
1890 -- Random --
1891 ------------
1892
1893 procedure Random (Seed : in out Natural) is
1894
1895 -- Park & Miller Standard Minimal using Schrage's algorithm to avoid
1896 -- overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1)
1897
1898 R : Natural;
1899 Q : Natural;
1900 X : Integer;
1901
1902 begin
1903 R := Seed mod 127773;
1904 Q := Seed / 127773;
1905 X := 16807 * R - 2836 * Q;
1906
1907 if X < 0 then
1908 Seed := X + 2147483647;
1909 else
1910 Seed := X;
1911 end if;
1912 end Random;
1913
1914 -------------
1915 -- Reduced --
1916 -------------
1917
1918 function Reduced (K : Key_Id) return Word_Id is
1919 begin
1920 return K + NK + 1;
1921 end Reduced;
1922
1923 --------------------------
1924 -- Select_Char_Position --
1925 --------------------------
1926
1927 procedure Select_Char_Position is
1928
1929 type Vertex_Table_Type is array (Natural range <>) of Vertex_Type;
1930
1931 procedure Build_Identical_Keys_Sets
1932 (Table : in out Vertex_Table_Type;
1933 Last : in out Natural;
1934 Pos : Natural);
1935 -- Build a list of keys subsets that are identical with the current
1936 -- position selection plus Pos. Once this routine is called, reduced
1937 -- words are sorted by subsets and each item (First, Last) in Sets
1938 -- defines the range of identical keys.
1939 -- Need comment saying exactly what Last is ???
1940
1941 function Count_Different_Keys
1942 (Table : Vertex_Table_Type;
1943 Last : Natural;
1944 Pos : Natural) return Natural;
1945 -- For each subset in Sets, count the number of different keys if we add
1946 -- Pos to the current position selection.
1947
1948 Sel_Position : IT.Table_Type (1 .. Max_Key_Len);
1949 Last_Sel_Pos : Natural := 0;
1950 Max_Sel_Pos : Natural := 0;
1951
1952 -------------------------------
1953 -- Build_Identical_Keys_Sets --
1954 -------------------------------
1955
1956 procedure Build_Identical_Keys_Sets
1957 (Table : in out Vertex_Table_Type;
1958 Last : in out Natural;
1959 Pos : Natural)
1960 is
1961 S : constant Vertex_Table_Type := Table (Table'First .. Last);
1962 C : constant Natural := Pos;
1963 -- Shortcuts (why are these not renames ???)
1964
1965 F : Integer;
1966 L : Integer;
1967 -- First and last words of a subset
1968
1969 Offset : Natural;
1970 -- GNAT.Heap_Sort assumes that the first array index is 1. Offset
1971 -- defines the translation to operate.
1972
1973 function Lt (L, R : Natural) return Boolean;
1974 procedure Move (From : Natural; To : Natural);
1975 -- Subprograms needed by GNAT.Heap_Sort_G
1976
1977 --------
1978 -- Lt --
1979 --------
1980
1981 function Lt (L, R : Natural) return Boolean is
1982 C : constant Natural := Pos;
1983 Left : Natural;
1984 Right : Natural;
1985
1986 begin
1987 if L = 0 then
1988 Left := Reduced (0) - 1;
1989 Right := Offset + R;
1990 elsif R = 0 then
1991 Left := Offset + L;
1992 Right := Reduced (0) - 1;
1993 else
1994 Left := Offset + L;
1995 Right := Offset + R;
1996 end if;
1997
1998 return WT.Table (Left)(C) < WT.Table (Right)(C);
1999 end Lt;
2000
2001 ----------
2002 -- Move --
2003 ----------
2004
2005 procedure Move (From : Natural; To : Natural) is
2006 Target, Source : Natural;
2007
2008 begin
2009 if From = 0 then
2010 Source := Reduced (0) - 1;
2011 Target := Offset + To;
2012 elsif To = 0 then
2013 Source := Offset + From;
2014 Target := Reduced (0) - 1;
2015 else
2016 Source := Offset + From;
2017 Target := Offset + To;
2018 end if;
2019
2020 WT.Table (Target) := WT.Table (Source);
2021 end Move;
2022
2023 package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
2024
2025 -- Start of processing for Build_Identical_Key_Sets
2026
2027 begin
2028 Last := 0;
2029
2030 -- For each subset in S, extract the new subsets we have by adding C
2031 -- in the position selection.
2032
2033 for J in S'Range loop
2034 if S (J).First = S (J).Last then
2035 F := S (J).First;
2036 L := S (J).Last;
2037 Last := Last + 1;
2038 Table (Last) := (F, L);
2039
2040 else
2041 Offset := Reduced (S (J).First) - 1;
2042 Sorting.Sort (S (J).Last - S (J).First + 1);
2043
2044 F := S (J).First;
2045 L := F;
2046 for N in S (J).First .. S (J).Last loop
2047
2048 -- For the last item, close the last subset
2049
2050 if N = S (J).Last then
2051 Last := Last + 1;
2052 Table (Last) := (F, N);
2053
2054 -- Two contiguous words are identical when they have the
2055 -- same Cth character.
2056
2057 elsif WT.Table (Reduced (N))(C) =
2058 WT.Table (Reduced (N + 1))(C)
2059 then
2060 L := N + 1;
2061
2062 -- Find a new subset of identical keys. Store the current
2063 -- one and create a new subset.
2064
2065 else
2066 Last := Last + 1;
2067 Table (Last) := (F, L);
2068 F := N + 1;
2069 L := F;
2070 end if;
2071 end loop;
2072 end if;
2073 end loop;
2074 end Build_Identical_Keys_Sets;
2075
2076 --------------------------
2077 -- Count_Different_Keys --
2078 --------------------------
2079
2080 function Count_Different_Keys
2081 (Table : Vertex_Table_Type;
2082 Last : Natural;
2083 Pos : Natural) return Natural
2084 is
2085 N : array (Character) of Natural;
2086 C : Character;
2087 T : Natural := 0;
2088
2089 begin
2090 -- For each subset, count the number of words that are still
2091 -- different when we include Pos in the position selection. Only
2092 -- focus on this position as the other positions already produce
2093 -- identical keys.
2094
2095 for S in 1 .. Last loop
2096
2097 -- Count the occurrences of the different characters
2098
2099 N := (others => 0);
2100 for K in Table (S).First .. Table (S).Last loop
2101 C := WT.Table (Reduced (K))(Pos);
2102 N (C) := N (C) + 1;
2103 end loop;
2104
2105 -- Update the number of different keys. Each character used
2106 -- denotes a different key.
2107
2108 for J in N'Range loop
2109 if N (J) > 0 then
2110 T := T + 1;
2111 end if;
2112 end loop;
2113 end loop;
2114
2115 return T;
2116 end Count_Different_Keys;
2117
2118 -- Start of processing for Select_Char_Position
2119
2120 begin
2121 -- Initialize the reduced words set
2122
2123 WT.Set_Last (2 * NK);
2124 for K in 0 .. NK - 1 loop
2125 WT.Table (Reduced (K)) := WT.Table (Initial (K));
2126 end loop;
2127
2128 declare
2129 Differences : Natural;
2130 Max_Differences : Natural := 0;
2131 Old_Differences : Natural;
2132 Max_Diff_Sel_Pos : Natural := 0; -- init to kill warning
2133 Max_Diff_Sel_Pos_Idx : Natural := 0; -- init to kill warning
2134 Same_Keys_Sets_Table : Vertex_Table_Type (1 .. NK);
2135 Same_Keys_Sets_Last : Natural := 1;
2136
2137 begin
2138 for C in Sel_Position'Range loop
2139 Sel_Position (C) := C;
2140 end loop;
2141
2142 Same_Keys_Sets_Table (1) := (0, NK - 1);
2143
2144 loop
2145 -- Preserve maximum number of different keys and check later on
2146 -- that this value is strictly incrementing. Otherwise, it means
2147 -- that two keys are strictly identical.
2148
2149 Old_Differences := Max_Differences;
2150
2151 -- The first position should not exceed the minimum key length.
2152 -- Otherwise, we may end up with an empty word once reduced.
2153
2154 if Last_Sel_Pos = 0 then
2155 Max_Sel_Pos := Min_Key_Len;
2156 else
2157 Max_Sel_Pos := Max_Key_Len;
2158 end if;
2159
2160 -- Find which position increases more the number of differences
2161
2162 for J in Last_Sel_Pos + 1 .. Max_Sel_Pos loop
2163 Differences := Count_Different_Keys
2164 (Same_Keys_Sets_Table,
2165 Same_Keys_Sets_Last,
2166 Sel_Position (J));
2167
2168 if Verbose then
2169 Put (Output,
2170 "Selecting position" & Sel_Position (J)'Img &
2171 " results in" & Differences'Img &
2172 " differences");
2173 New_Line (Output);
2174 end if;
2175
2176 if Differences > Max_Differences then
2177 Max_Differences := Differences;
2178 Max_Diff_Sel_Pos := Sel_Position (J);
2179 Max_Diff_Sel_Pos_Idx := J;
2180 end if;
2181 end loop;
2182
2183 if Old_Differences = Max_Differences then
2184 raise Program_Error with "some keys are identical";
2185 end if;
2186
2187 -- Insert selected position and sort Sel_Position table
2188
2189 Last_Sel_Pos := Last_Sel_Pos + 1;
2190 Sel_Position (Last_Sel_Pos + 1 .. Max_Diff_Sel_Pos_Idx) :=
2191 Sel_Position (Last_Sel_Pos .. Max_Diff_Sel_Pos_Idx - 1);
2192 Sel_Position (Last_Sel_Pos) := Max_Diff_Sel_Pos;
2193
2194 for P in 1 .. Last_Sel_Pos - 1 loop
2195 if Max_Diff_Sel_Pos < Sel_Position (P) then
2196 Sel_Position (P + 1 .. Last_Sel_Pos) :=
2197 Sel_Position (P .. Last_Sel_Pos - 1);
2198 Sel_Position (P) := Max_Diff_Sel_Pos;
2199 exit;
2200 end if;
2201 end loop;
2202
2203 exit when Max_Differences = NK;
2204
2205 Build_Identical_Keys_Sets
2206 (Same_Keys_Sets_Table,
2207 Same_Keys_Sets_Last,
2208 Max_Diff_Sel_Pos);
2209
2210 if Verbose then
2211 Put (Output,
2212 "Selecting position" & Max_Diff_Sel_Pos'Img &
2213 " results in" & Max_Differences'Img &
2214 " differences");
2215 New_Line (Output);
2216 Put (Output, "--");
2217 New_Line (Output);
2218 for J in 1 .. Same_Keys_Sets_Last loop
2219 for K in
2220 Same_Keys_Sets_Table (J).First ..
2221 Same_Keys_Sets_Table (J).Last
2222 loop
2223 Put (Output, WT.Table (Reduced (K)));
2224 New_Line (Output);
2225 end loop;
2226 Put (Output, "--");
2227 New_Line (Output);
2228 end loop;
2229 end if;
2230 end loop;
2231 end;
2232
2233 Char_Pos_Set_Len := Last_Sel_Pos;
2234 Char_Pos_Set := Allocate (Char_Pos_Set_Len);
2235
2236 for C in 1 .. Last_Sel_Pos loop
2237 Set_Char_Pos (C - 1, Sel_Position (C));
2238 end loop;
2239 end Select_Char_Position;
2240
2241 --------------------------
2242 -- Select_Character_Set --
2243 --------------------------
2244
2245 procedure Select_Character_Set is
2246 Last : Natural := 0;
2247 Used : array (Character) of Boolean := (others => False);
2248 Char : Character;
2249
2250 begin
2251 for J in 0 .. NK - 1 loop
2252 for K in 0 .. Char_Pos_Set_Len - 1 loop
2253 Char := WT.Table (Initial (J))(Get_Char_Pos (K));
2254 exit when Char = ASCII.NUL;
2255 Used (Char) := True;
2256 end loop;
2257 end loop;
2258
2259 Used_Char_Set_Len := 256;
2260 Used_Char_Set := Allocate (Used_Char_Set_Len);
2261
2262 for J in Used'Range loop
2263 if Used (J) then
2264 Set_Used_Char (J, Last);
2265 Last := Last + 1;
2266 else
2267 Set_Used_Char (J, 0);
2268 end if;
2269 end loop;
2270 end Select_Character_Set;
2271
2272 ------------------
2273 -- Set_Char_Pos --
2274 ------------------
2275
2276 procedure Set_Char_Pos (P : Natural; Item : Natural) is
2277 N : constant Natural := Char_Pos_Set + P;
2278 begin
2279 IT.Table (N) := Item;
2280 end Set_Char_Pos;
2281
2282 ---------------
2283 -- Set_Edges --
2284 ---------------
2285
2286 procedure Set_Edges (F : Natural; Item : Edge_Type) is
2287 N : constant Natural := Edges + (F * Edge_Size);
2288 begin
2289 IT.Table (N) := Item.X;
2290 IT.Table (N + 1) := Item.Y;
2291 IT.Table (N + 2) := Item.Key;
2292 end Set_Edges;
2293
2294 ---------------
2295 -- Set_Graph --
2296 ---------------
2297
2298 procedure Set_Graph (N : Natural; Item : Integer) is
2299 begin
2300 IT.Table (G + N) := Item;
2301 end Set_Graph;
2302
2303 -------------
2304 -- Set_Key --
2305 -------------
2306
2307 procedure Set_Key (N : Key_Id; Item : Key_Type) is
2308 begin
2309 IT.Table (Keys + N) := Item.Edge;
2310 end Set_Key;
2311
2312 ---------------
2313 -- Set_Table --
2314 ---------------
2315
2316 procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural) is
2317 N : constant Natural := T + ((Y * T1_Len) + X);
2318 begin
2319 IT.Table (N) := Item;
2320 end Set_Table;
2321
2322 -------------------
2323 -- Set_Used_Char --
2324 -------------------
2325
2326 procedure Set_Used_Char (C : Character; Item : Natural) is
2327 N : constant Natural := Used_Char_Set + Character'Pos (C);
2328 begin
2329 IT.Table (N) := Item;
2330 end Set_Used_Char;
2331
2332 ------------------
2333 -- Set_Vertices --
2334 ------------------
2335
2336 procedure Set_Vertices (F : Natural; Item : Vertex_Type) is
2337 N : constant Natural := Vertices + (F * Vertex_Size);
2338 begin
2339 IT.Table (N) := Item.First;
2340 IT.Table (N + 1) := Item.Last;
2341 end Set_Vertices;
2342
2343 ---------
2344 -- Sum --
2345 ---------
2346
2347 function Sum
2348 (Word : Word_Type;
2349 Table : Table_Id;
2350 Opt : Optimization) return Natural
2351 is
2352 S : Natural := 0;
2353 R : Natural;
2354
2355 begin
2356 if Opt = CPU_Time then
2357 for J in 0 .. T1_Len - 1 loop
2358 exit when Word (J + 1) = ASCII.NUL;
2359 R := Get_Table (Table, J, Get_Used_Char (Word (J + 1)));
2360 S := (S + R) mod NV;
2361 end loop;
2362
2363 else
2364 for J in 0 .. T1_Len - 1 loop
2365 exit when Word (J + 1) = ASCII.NUL;
2366 R := Get_Table (Table, J, 0);
2367 S := (S + R * Character'Pos (Word (J + 1))) mod NV;
2368 end loop;
2369 end if;
2370
2371 return S;
2372 end Sum;
2373
2374 ---------------
2375 -- Type_Size --
2376 ---------------
2377
2378 function Type_Size (L : Natural) return Natural is
2379 begin
2380 if L <= 2 ** 8 then
2381 return 8;
2382 elsif L <= 2 ** 16 then
2383 return 16;
2384 else
2385 return 32;
2386 end if;
2387 end Type_Size;
2388
2389 -----------
2390 -- Value --
2391 -----------
2392
2393 function Value
2394 (Name : Table_Name;
2395 J : Natural;
2396 K : Natural := 0) return Natural
2397 is
2398 begin
2399 case Name is
2400 when Character_Position =>
2401 return Get_Char_Pos (J);
2402
2403 when Used_Character_Set =>
2404 return Get_Used_Char (Character'Val (J));
2405
2406 when Function_Table_1 =>
2407 return Get_Table (T1, J, K);
2408
2409 when Function_Table_2 =>
2410 return Get_Table (T2, J, K);
2411
2412 when Graph_Table =>
2413 return Get_Graph (J);
2414
2415 end case;
2416 end Value;
2417
2418 end GNAT.Perfect_Hash_Generators;
Mirror of the offical gcc git repository hosted at gcc.gnu.org