--------------------------------------------------------------------------------

-- Procedure Pack_Linked_trie_into_Packed_trie packs the families in Linked_trie
-- into  an  interleaved,  indexed  trie,  or  "packed trie."  Note that because
-- Linked_trie has been compressed, the families are not  necessarily  disjoint.
-- For  example,  a  family whose letters are A, E, and I may double as a family
-- whose letters are E and I or just I.  Such overlapping  families  are  packed
-- separately,  so  that  some  of  the compression is lost.  It is assumed that
-- Packed_trie is zero on entry.  The first family in Linked_trie is  guaranteed
-- to be based at entry 0 within Packed_trie.

With Data_structures;
Use  Data_structures;

Procedure Pack_Linked_trie_into_Packed_trie is

   -- To  prevent  confusion  between  indexes into Linked_trie and indexes into
   -- Packed_trie, we introduce the following two subtypes:

   Subtype Linked_trie_index is Trie_index;
   Subtype Packed_trie_index is Trie_index;

   Packed_trie_entry_taken: array (Packed_trie_index) of Boolean :=
      ( others=>False );
   LT_to_PT_mapping: array (Linked_trie_index) of Packed_trie_index;
   Family_packed: array (Linked_trie_index) of Boolean := ( others=>False );
Procedure Pack_single_family ( I: in Linked_trie_index ) is

   J: Packed_trie_index;
   K: Linked_trie_index;
   Packed_trie_has_overflowed: Exception;

begin

   -- The  bulk  of  this  procedure  is taken in finding the first entry within
   -- Packed_trie at which we can base the given family.  An  entry  in  Packed_
   -- trie  can  be  the  base  of the family if it is not the base of any other
   -- family and if, out of the subsequent 255  entries,  those  entries  corre-
   -- sponding  to  letters  in the family are free.  To keep track of which en-
   -- tries in Packed_trie are bases of families, we use the following array:


   J := 0;
   Loop

      -- The following loop is guaranteed to terminate without hitting  the  end
      -- of  Packed_trie_entry_taken  since  a  family can't be based within 255
      -- letters of the end of Packed_trie.

      While Packed_trie_entry_taken(J) loop J := J + 1; end loop;

      If J + 255 > Packed_trie'last then
         Raise Packed_trie_has_overflowed;
      end if;

      K := I;
      While K /= 0 and then Packed_trie(J+Linked_trie(K).Char).Char = 0 loop
         K := Linked_trie(K).Right;
      end loop;
   Exit when K = 0;

      J := J + 1;

   end loop;

   -- We've found a place in Packed_trie to base the family:  entry J.  Now it's
   -- just a matter of copying the family's nodes into Packed_trie entries.

   Packed_trie_entry_taken(J) := True;
   If J + 255 > Packed_trie_last then Packed_trie_last := J + 255; end if;

   K := I;
   While K /= 0 loop

      Packed_trie(J+Linked_trie(K).Char) := ( Next=>Linked_trie(K).Down,
         Weights=>Linked_trie(K).Weights, Char=>Linked_trie(K).Char );

      K := Linked_trie(K).Right;

   end loop;

   -- Of course, the pointers we just copied into Packed_trie refer  to  Linked_
   -- trie  nodes, not Packed_trie entries, and hence they must be fixed up when
   -- we're all done.  To do this we will need the following array.


   LT_to_PT_mapping(I) := J;

   -- Finally,  to avoid packing the family more than once, we use the following
   -- array.  We could use LT_to_PT_mapping for this, but it's  a  little  shaky
   -- because LT_to_PT_mapping(Linked_trie_root) = 0.


   Family_packed(I) := True;

end Pack_single_family;

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

-- Procedure Pack packs the entire linked trie into  Packed_trie  in  a  single,
-- top-down  traversal, calling Pack_single_family to pack each family.  Because
-- Linked_trie has been compressed we must use Family_packed to insure  that  we
-- don't pack a family more than once.

Procedure Pack ( I: in Linked_trie_index ) is

   J: Linked_trie_index;

begin

   If I /= 0 then

      If not Family_packed(I) then Pack_single_family( I ); end if;

      J := I;
      While J /= 0 loop
         Pack( Linked_trie(J).Down );
         J := Linked_trie(J).Right;
      end loop;

   end if;

end Pack;

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

-- Finally, we use LT_to_PT_mapping to fix up the pointers in Packed_trie, which
-- are still pointing to Linked_trie nodes.

Procedure Fix_up_Packed_trie is

   J: Packed_trie_index;
   Packed_trie_has_overflowed: Exception;

begin

   -- We  can't  leave  the zero pointers in Packed_trie zero, because zero is a
   -- perfectly good family base (in fact, it's the base of the  first  family).
   -- Thus  we look for one last Packed_trie entry at which we can base a "null"
   -- family.

   J := 1;
   While Packed_trie_entry_taken(J) loop J := J + 1; end loop;

   If J + 255 > Packed_trie'last then Raise Packed_trie_has_overflowed; end if;
   If J + 255 > Packed_trie_last then Packed_trie_last := J + 255; end if;

   For I in 0 .. Packed_trie_last loop
      If Packed_trie(I).Next /= 0 then
         Packed_trie(I).Next := LT_to_PT_mapping(Packed_trie(I).Next);
      else
         Packed_trie(I).Next := J;
      end if;
   end loop;

end Fix_up_Packed_trie;

--------------------------------------------------------------------------------

begin

   Pack( Linked_trie_root );
   Fix_up_Packed_trie;

end Pack_Linked_trie_into_Packed_trie;

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

-- We use procedure Pack_single_family to pack a single Linked_trie family  into
-- Packed_trie.  This procedure is called, once per family, by procedure Pack.

