gcc/ada/g-pehage.adb

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