------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUNTIME COMPONENTS                          --
--                                                                          --
--                     A D A . S T R I N G S . M A P S                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.3 $                              --
--                                                                          --
--           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
--                                                                          --
------------------------------------------------------------------------------

--  Note: parts of this code are derived from the ADAR.CSH public domain
--  Ada 83 versions of the Appendix C string handling packages. The main
--  differences are that we avoid the use of the minimize function which
--  is bit-by-bit or character-by-character and therefore rather slow.
--  Generally for character sets we favor the full 32-byte representation.


package body Ada.Strings.Maps is

   subtype Constrained_Set is Character_Set (Character);

   All_False : constant Constrained_Set := (others => False);
   --  A full range null set, used to canonicalize arguments

   ---------
   -- "=" --
   ---------

   --  Note: equality is not the predefined equality because the index ranges
   --  may differ, but two sets can still be equal providing that values for
   --  index ranges not present in both sets are all False.

   function "=" (Left, Right : Character_Set) return Boolean is
   begin
      if Left'First = Right'First
        and then Left'Last = Right'Last
      then
         return Standard."=" (Left, Right);

      else
         declare
            Left_1, Right_1 : Constrained_Set := All_False;

         begin
            Left_1  (Left'range) := Left;
            Right_1 (Right'range) := Right;
            return Standard."="(Left_1, Right_1);
         end;
      end if;
   end "=";

   -----------
   -- "and" --
   -----------

   --  If the two arguments have the same range, then the result has this
   --  same range. Otherwise the result is always a full range set.

   function "and" (Left, Right : Character_Set) return Character_Set is
   begin
      if Left'First = Right'First and then Left'Last = Right'Last then
         return Standard."and" (Left, Right);

      else
         declare
            Left_1, Right_1 : Constrained_Set := All_False;

         begin
            Left_1 (Left'range) := Left;
            Right_1 (Right'range) := Right;
            return Standard."and" (Left_1, Right_1);
         end;
      end if;
   end "and";

   -----------
   -- "not" --
   -----------

   --  The result is always a full range set

   function "not" (Right : Character_Set) return Character_Set is
   begin
      if Right'First = Character'First
        and then Right'Last = Character'Last
      then
         return Standard."not" (Right);

      else
         declare
            Right_1 : Constrained_Set := All_False;

         begin
            Right_1 (Right'range) := Right;
            return Standard."not" (Right_1);
         end;
      end if;
   end "not";

   ----------
   -- "or" --
   ----------

   --  If the two arguments have the same range, then the result has this
   --  same range. Otherwise the result is always a full range set.

   function "or" (Left, Right : Character_Set) return Character_Set is
   begin
      if Left'First = Right'First and then Left'Last = Right'Last then
         return Standard."or" (Left, Right);

      else
         declare
            Left_1, Right_1 : Constrained_Set := All_False;

         begin
            Left_1 (Left'range) := Left;
            Right_1 (Right'range) := Right;
            return Standard."or" (Left_1, Right_1);
         end;
      end if;
   end "or";

   -----------
   -- "xor" --
   -----------

   --  If the two arguments have the same range, then the result has this
   --  same range. Otherwise the result is always a full range set.

   function "xor" (Left, Right : Character_Set) return Character_Set is
   begin
      if Left'First = Right'First and then Left'Last = Right'Last then
         return Standard."xor" (Left, Right);

      else
         declare
            Left_1, Right_1 : Constrained_Set := All_False;

         begin
            Left_1 (Left'range) := Left;
            Right_1 (Right'range) := Right;
            return Standard."xor" (Left_1, Right_1);
         end;
      end if;
   end "xor";

   -----------
   -- Is_In --
   -----------

   function Is_In
     (Element : Character; Set : Character_Set) return Boolean is
   begin
      return Element in Set'range and then Set (Element);
   end Is_In;

   ---------------
   -- Is_Subset --
   ---------------

   function Is_Subset
     (Elements : Character_Set; Set : Character_Set) return Boolean
   is
      Elements_1, Set_1 : Constrained_Set := All_False;

   begin
      Elements_1 (Elements'range) := Elements;
      Set_1 (Set'range) := Set;
      return Standard."=" (Standard."or" (Elements_1, Set_1), Set_1);
   end Is_Subset;

   ----------------
   -- To_Mapping --
   ----------------

   function To_Mapping
     (From, To : Character_Sequence) return Character_Mapping
   is
      Result   : Character_Mapping (Character);
      Inserted : Constrained_Set := All_False;

   begin
      if From'Length /= To'Length then
         raise Strings.Translation_Error;
      end if;

      for Char in Character loop
         Result (Char) := Char;
      end loop;

      for I in From'range loop
         if Inserted (From (I)) then
            raise Strings.Translation_Error;
         end if;

         Result   (From (I)) := To (I - From'First + To'First);
         Inserted (From (I)) := True;
      end loop;

      return Result;
   end To_Mapping;

   -----------------
   -- To_Sequence --
   -----------------

   function To_Sequence (Set : Character_Set) return Character_Sequence is
      Result : String (1 .. Character'Pos (Character'Last));
      Count  : Natural := 0;

   begin
      for Char in Set'range loop
         if Set (Char) then
            Count := Count + 1;
            Result (Count) := Char;
         end if;
      end loop;

      return Result (1 .. Count);
   end To_Sequence;

   ------------
   -- To_Set --
   ------------

   function To_Set (Sequence : Character_Sequence) return Character_Set is
      Result : Constrained_Set := All_False;

   begin
      for I in Sequence'range loop
         Result (Sequence (I)) := True;
      end loop;

      return Result;
   end To_Set;

   function To_Set (Singleton : Character) return Character_Set is
      Result : Constrained_Set := All_False;

   begin
      Result (Singleton) := True;
      return Result;
   end To_Set;

end Ada.Strings.Maps;
