[thirdparty/gcc.git] / gcc / ada / a-chahan.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--              A D A . C H A R A C T E R S . H A N D L I N G               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
--                                                                          --
-- 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,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Latin_1;      use Ada.Characters.Latin_1;
with Ada.Strings.Maps;            use Ada.Strings.Maps;
with Ada.Strings.Maps.Constants;  use Ada.Strings.Maps.Constants;

package body Ada.Characters.Handling is

   ------------------------------------
   -- Character Classification Table --
   ------------------------------------

   type Character_Flags is mod 256;
   for Character_Flags'Size use 8;

   Control    : constant Character_Flags := 1;
   Lower      : constant Character_Flags := 2;
   Upper      : constant Character_Flags := 4;
   Basic      : constant Character_Flags := 8;
   Hex_Digit  : constant Character_Flags := 16;
   Digit      : constant Character_Flags := 32;
   Special    : constant Character_Flags := 64;

   Letter     : constant Character_Flags := Lower or Upper;
   Alphanum   : constant Character_Flags := Letter or Digit;
   Graphic    : constant Character_Flags := Alphanum or Special;

   Char_Map : constant array (Character) of Character_Flags :=
   (
     NUL                         => Control,
     SOH                         => Control,
     STX                         => Control,
     ETX                         => Control,
     EOT                         => Control,
     ENQ                         => Control,
     ACK                         => Control,
     BEL                         => Control,
     BS                          => Control,
     HT                          => Control,
     LF                          => Control,
     VT                          => Control,
     FF                          => Control,
     CR                          => Control,
     SO                          => Control,
     SI                          => Control,

     DLE                         => Control,
     DC1                         => Control,
     DC2                         => Control,
     DC3                         => Control,
     DC4                         => Control,
     NAK                         => Control,
     SYN                         => Control,
     ETB                         => Control,
     CAN                         => Control,
     EM                          => Control,
     SUB                         => Control,
     ESC                         => Control,
     FS                          => Control,
     GS                          => Control,
     RS                          => Control,
     US                          => Control,

     Space                       => Special,
     Exclamation                 => Special,
     Quotation                   => Special,
     Number_Sign                 => Special,
     Dollar_Sign                 => Special,
     Percent_Sign                => Special,
     Ampersand                   => Special,
     Apostrophe                  => Special,
     Left_Parenthesis            => Special,
     Right_Parenthesis           => Special,
     Asterisk                    => Special,
     Plus_Sign                   => Special,
     Comma                       => Special,
     Hyphen                      => Special,
     Full_Stop                   => Special,
     Solidus                     => Special,

     '0' .. '9'                  => Digit + Hex_Digit,

     Colon                       => Special,
     Semicolon                   => Special,
     Less_Than_Sign              => Special,
     Equals_Sign                 => Special,
     Greater_Than_Sign           => Special,
     Question                    => Special,
     Commercial_At               => Special,

     'A' .. 'F'                  => Upper + Basic + Hex_Digit,
     'G' .. 'Z'                  => Upper + Basic,

     Left_Square_Bracket         => Special,
     Reverse_Solidus             => Special,
     Right_Square_Bracket        => Special,
     Circumflex                  => Special,
     Low_Line                    => Special,
     Grave                       => Special,

     'a' .. 'f'                  => Lower + Basic + Hex_Digit,
     'g' .. 'z'                  => Lower + Basic,

     Left_Curly_Bracket          => Special,
     Vertical_Line               => Special,
     Right_Curly_Bracket         => Special,
     Tilde                       => Special,

     DEL                         => Control,
     Reserved_128                => Control,
     Reserved_129                => Control,
     BPH                         => Control,
     NBH                         => Control,
     Reserved_132                => Control,
     NEL                         => Control,
     SSA                         => Control,
     ESA                         => Control,
     HTS                         => Control,
     HTJ                         => Control,
     VTS                         => Control,
     PLD                         => Control,
     PLU                         => Control,
     RI                          => Control,
     SS2                         => Control,
     SS3                         => Control,

     DCS                         => Control,
     PU1                         => Control,
     PU2                         => Control,
     STS                         => Control,
     CCH                         => Control,
     MW                          => Control,
     SPA                         => Control,
     EPA                         => Control,

     SOS                         => Control,
     Reserved_153                => Control,
     SCI                         => Control,
     CSI                         => Control,
     ST                          => Control,
     OSC                         => Control,
     PM                          => Control,
     APC                         => Control,

     No_Break_Space              => Special,
     Inverted_Exclamation        => Special,
     Cent_Sign                   => Special,
     Pound_Sign                  => Special,
     Currency_Sign               => Special,
     Yen_Sign                    => Special,
     Broken_Bar                  => Special,
     Section_Sign                => Special,
     Diaeresis                   => Special,
     Copyright_Sign              => Special,
     Feminine_Ordinal_Indicator  => Special,
     Left_Angle_Quotation        => Special,
     Not_Sign                    => Special,
     Soft_Hyphen                 => Special,
     Registered_Trade_Mark_Sign  => Special,
     Macron                      => Special,
     Degree_Sign                 => Special,
     Plus_Minus_Sign             => Special,
     Superscript_Two             => Special,
     Superscript_Three           => Special,
     Acute                       => Special,
     Micro_Sign                  => Special,
     Pilcrow_Sign                => Special,
     Middle_Dot                  => Special,
     Cedilla                     => Special,
     Superscript_One             => Special,
     Masculine_Ordinal_Indicator => Special,
     Right_Angle_Quotation       => Special,
     Fraction_One_Quarter        => Special,
     Fraction_One_Half           => Special,
     Fraction_Three_Quarters     => Special,
     Inverted_Question           => Special,

     UC_A_Grave                  => Upper,
     UC_A_Acute                  => Upper,
     UC_A_Circumflex             => Upper,
     UC_A_Tilde                  => Upper,
     UC_A_Diaeresis              => Upper,
     UC_A_Ring                   => Upper,
     UC_AE_Diphthong             => Upper + Basic,
     UC_C_Cedilla                => Upper,
     UC_E_Grave                  => Upper,
     UC_E_Acute                  => Upper,
     UC_E_Circumflex             => Upper,
     UC_E_Diaeresis              => Upper,
     UC_I_Grave                  => Upper,
     UC_I_Acute                  => Upper,
     UC_I_Circumflex             => Upper,
     UC_I_Diaeresis              => Upper,
     UC_Icelandic_Eth            => Upper + Basic,
     UC_N_Tilde                  => Upper,
     UC_O_Grave                  => Upper,
     UC_O_Acute                  => Upper,
     UC_O_Circumflex             => Upper,
     UC_O_Tilde                  => Upper,
     UC_O_Diaeresis              => Upper,

     Multiplication_Sign         => Special,

     UC_O_Oblique_Stroke         => Upper,
     UC_U_Grave                  => Upper,
     UC_U_Acute                  => Upper,
     UC_U_Circumflex             => Upper,
     UC_U_Diaeresis              => Upper,
     UC_Y_Acute                  => Upper,
     UC_Icelandic_Thorn          => Upper + Basic,

     LC_German_Sharp_S           => Lower + Basic,
     LC_A_Grave                  => Lower,
     LC_A_Acute                  => Lower,
     LC_A_Circumflex             => Lower,
     LC_A_Tilde                  => Lower,
     LC_A_Diaeresis              => Lower,
     LC_A_Ring                   => Lower,
     LC_AE_Diphthong             => Lower + Basic,
     LC_C_Cedilla                => Lower,
     LC_E_Grave                  => Lower,
     LC_E_Acute                  => Lower,
     LC_E_Circumflex             => Lower,
     LC_E_Diaeresis              => Lower,
     LC_I_Grave                  => Lower,
     LC_I_Acute                  => Lower,
     LC_I_Circumflex             => Lower,
     LC_I_Diaeresis              => Lower,
     LC_Icelandic_Eth            => Lower + Basic,
     LC_N_Tilde                  => Lower,
     LC_O_Grave                  => Lower,
     LC_O_Acute                  => Lower,
     LC_O_Circumflex             => Lower,
     LC_O_Tilde                  => Lower,
     LC_O_Diaeresis              => Lower,

     Division_Sign               => Special,

     LC_O_Oblique_Stroke         => Lower,
     LC_U_Grave                  => Lower,
     LC_U_Acute                  => Lower,
     LC_U_Circumflex             => Lower,
     LC_U_Diaeresis              => Lower,
     LC_Y_Acute                  => Lower,
     LC_Icelandic_Thorn          => Lower + Basic,
     LC_Y_Diaeresis              => Lower
   );

   ---------------------
   -- Is_Alphanumeric --
   ---------------------

   function Is_Alphanumeric (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Alphanum) /= 0;
   end Is_Alphanumeric;

   --------------
   -- Is_Basic --
   --------------

   function Is_Basic (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Basic) /= 0;
   end Is_Basic;

   ------------------
   -- Is_Character --
   ------------------

   function Is_Character (Item : Wide_Character) return Boolean is
   begin
      return Wide_Character'Pos (Item) < 256;
   end Is_Character;

   function Is_Character (Item : Wide_Wide_Character) return Boolean is
   begin
      return Wide_Wide_Character'Pos (Item) < 256;
   end Is_Character;

   ----------------
   -- Is_Control --
   ----------------

   function Is_Control (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Control) /= 0;
   end Is_Control;

   --------------
   -- Is_Digit --
   --------------

   function Is_Digit (Item : Character) return Boolean is
   begin
      return Item in '0' .. '9';
   end Is_Digit;

   ----------------
   -- Is_Graphic --
   ----------------

   function Is_Graphic (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Graphic) /= 0;
   end Is_Graphic;

   --------------------------
   -- Is_Hexadecimal_Digit --
   --------------------------

   function Is_Hexadecimal_Digit (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Hex_Digit) /= 0;
   end Is_Hexadecimal_Digit;

   ----------------
   -- Is_ISO_646 --
   ----------------

   function Is_ISO_646 (Item : Character) return Boolean is
   begin
      return Item in ISO_646;
   end Is_ISO_646;

   --  Note: much more efficient coding of the following function is possible
   --  by testing several 16#80# bits in a complete word in a single operation

   function Is_ISO_646 (Item : String) return Boolean is
   begin
      for J in Item'Range loop
         if Item (J) not in ISO_646 then
            return False;
         end if;
      end loop;

      return True;
   end Is_ISO_646;

   ---------------
   -- Is_Letter --
   ---------------

   function Is_Letter (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Letter) /= 0;
   end Is_Letter;

   --------------
   -- Is_Lower --
   --------------

   function Is_Lower (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Lower) /= 0;
   end Is_Lower;

   ----------------
   -- Is_Special --
   ----------------

   function Is_Special (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Special) /= 0;
   end Is_Special;

   ---------------
   -- Is_String --
   ---------------

   function Is_String (Item : Wide_String) return Boolean is
   begin
      for J in Item'Range loop
         if Wide_Character'Pos (Item (J)) >= 256 then
            return False;
         end if;
      end loop;

      return True;
   end Is_String;

   function Is_String (Item : Wide_Wide_String) return Boolean is
   begin
      for J in Item'Range loop
         if Wide_Wide_Character'Pos (Item (J)) >= 256 then
            return False;
         end if;
      end loop;

      return True;
   end Is_String;

   --------------
   -- Is_Upper --
   --------------

   function Is_Upper (Item : Character) return Boolean is
   begin
      return (Char_Map (Item) and Upper) /= 0;
   end Is_Upper;

   -----------------------
   -- Is_Wide_Character --
   -----------------------

   function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is
   begin
      return Wide_Wide_Character'Pos (Item) < 2**16;
   end Is_Wide_Character;

   --------------------
   -- Is_Wide_String --
   --------------------

   function Is_Wide_String (Item : Wide_Wide_String) return Boolean is
   begin
      for J in Item'Range loop
         if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then
            return False;
         end if;
      end loop;

      return True;
   end Is_Wide_String;

   --------------
   -- To_Basic --
   --------------

   function To_Basic (Item : Character) return Character is
   begin
      return Value (Basic_Map, Item);
   end To_Basic;

   function To_Basic (Item : String) return String is
      Result : String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := Value (Basic_Map, Item (J));
      end loop;

      return Result;
   end To_Basic;

   ------------------
   -- To_Character --
   ------------------

   function To_Character
     (Item       : Wide_Character;
      Substitute : Character := ' ') return Character
   is
   begin
      if Is_Character (Item) then
         return Character'Val (Wide_Character'Pos (Item));
      else
         return Substitute;
      end if;
   end To_Character;

   function To_Character
     (Item       : Wide_Wide_Character;
      Substitute : Character := ' ') return Character
   is
   begin
      if Is_Character (Item) then
         return Character'Val (Wide_Wide_Character'Pos (Item));
      else
         return Substitute;
      end if;
   end To_Character;

   ----------------
   -- To_ISO_646 --
   ----------------

   function To_ISO_646
     (Item       : Character;
      Substitute : ISO_646 := ' ') return ISO_646
   is
   begin
      if Item in ISO_646 then
         return Item;
      else
         return Substitute;
      end if;
   end To_ISO_646;

   function To_ISO_646
     (Item       : String;
      Substitute : ISO_646 := ' ') return String
   is
      Result : String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         if Item (J) in ISO_646 then
            Result (J - (Item'First - 1)) := Item (J);
         else
            Result (J - (Item'First - 1)) := Substitute;
         end if;
      end loop;

      return Result;
   end To_ISO_646;

   --------------
   -- To_Lower --
   --------------

   function To_Lower (Item : Character) return Character is
   begin
      return Value (Lower_Case_Map, Item);
   end To_Lower;

   function To_Lower (Item : String) return String is
      Result : String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := Value (Lower_Case_Map, Item (J));
      end loop;

      return Result;
   end To_Lower;

   ---------------
   -- To_String --
   ---------------

   function To_String
     (Item       : Wide_String;
      Substitute : Character := ' ') return String
   is
      Result : String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
      end loop;

      return Result;
   end To_String;

   function To_String
     (Item       : Wide_Wide_String;
      Substitute : Character := ' ') return String
   is
      Result : String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
      end loop;

      return Result;
   end To_String;

   --------------
   -- To_Upper --
   --------------

   function To_Upper
     (Item : Character) return Character
   is
   begin
      return Value (Upper_Case_Map, Item);
   end To_Upper;

   function To_Upper
     (Item : String) return String
   is
      Result : String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := Value (Upper_Case_Map, Item (J));
      end loop;

      return Result;
   end To_Upper;

   -----------------------
   -- To_Wide_Character --
   -----------------------

   function To_Wide_Character
     (Item : Character) return Wide_Character
   is
   begin
      return Wide_Character'Val (Character'Pos (Item));
   end To_Wide_Character;

   function To_Wide_Character
     (Item       : Wide_Wide_Character;
      Substitute : Wide_Character := ' ') return Wide_Character
   is
   begin
      if Wide_Wide_Character'Pos (Item) < 2**16 then
         return Wide_Character'Val (Wide_Wide_Character'Pos (Item));
      else
         return Substitute;
      end if;
   end To_Wide_Character;

   --------------------
   -- To_Wide_String --
   --------------------

   function To_Wide_String
     (Item : String) return Wide_String
   is
      Result : Wide_String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := To_Wide_Character (Item (J));
      end loop;

      return Result;
   end To_Wide_String;

   function To_Wide_String
     (Item       : Wide_Wide_String;
      Substitute : Wide_Character := ' ') return Wide_String
   is
      Result : Wide_String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) :=
           To_Wide_Character (Item (J), Substitute);
      end loop;

      return Result;
   end To_Wide_String;

   ----------------------------
   -- To_Wide_Wide_Character --
   ----------------------------

   function To_Wide_Wide_Character
     (Item : Character) return Wide_Wide_Character
   is
   begin
      return Wide_Wide_Character'Val (Character'Pos (Item));
   end To_Wide_Wide_Character;

   function To_Wide_Wide_Character
     (Item : Wide_Character) return Wide_Wide_Character
   is
   begin
      return Wide_Wide_Character'Val (Wide_Character'Pos (Item));
   end To_Wide_Wide_Character;

   -------------------------
   -- To_Wide_Wide_String --
   -------------------------

   function To_Wide_Wide_String
     (Item : String) return Wide_Wide_String
   is
      Result : Wide_Wide_String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
      end loop;

      return Result;
   end To_Wide_Wide_String;

   function To_Wide_Wide_String
     (Item : Wide_String) return Wide_Wide_String
   is
      Result : Wide_Wide_String (1 .. Item'Length);

   begin
      for J in Item'Range loop
         Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
      end loop;

      return Result;
   end To_Wide_Wide_String;

end Ada.Characters.Handling;
Commit	Line	Data
d23b8f57 RK	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT RUN-TIME COMPONENTS --
	4	-- --
	5	-- A D A . C H A R A C T E R S . H A N D L I N G --
	6	-- --
	7	-- B o d y --
	8	-- --
82c80734	9	-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
d23b8f57 RK	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, 59 Temple Place - Suite 330, Boston, --
	20	-- MA 02111-1307, 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. --
71ff80dc	30	-- Extensive contributions were provided by Ada Core Technologies Inc. --
d23b8f57 RK	31	-- --
	32	------------------------------------------------------------------------------
	33
	34	with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
	35	with Ada.Strings.Maps; use Ada.Strings.Maps;
	36	with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
	37
	38	package body Ada.Characters.Handling is
	39
	40	------------------------------------
	41	-- Character Classification Table --
	42	------------------------------------
	43
	44	type Character_Flags is mod 256;
	45	for Character_Flags'Size use 8;
	46
	47	Control : constant Character_Flags := 1;
	48	Lower : constant Character_Flags := 2;
	49	Upper : constant Character_Flags := 4;
	50	Basic : constant Character_Flags := 8;
	51	Hex_Digit : constant Character_Flags := 16;
	52	Digit : constant Character_Flags := 32;
	53	Special : constant Character_Flags := 64;
	54
	55	Letter : constant Character_Flags := Lower or Upper;
	56	Alphanum : constant Character_Flags := Letter or Digit;
	57	Graphic : constant Character_Flags := Alphanum or Special;
	58
	59	Char_Map : constant array (Character) of Character_Flags :=
	60	(
	61	NUL => Control,
	62	SOH => Control,
	63	STX => Control,
	64	ETX => Control,
	65	EOT => Control,
	66	ENQ => Control,
	67	ACK => Control,
	68	BEL => Control,
	69	BS => Control,
	70	HT => Control,
	71	LF => Control,
	72	VT => Control,
	73	FF => Control,
	74	CR => Control,
	75	SO => Control,
	76	SI => Control,
	77
	78	DLE => Control,
	79	DC1 => Control,
	80	DC2 => Control,
	81	DC3 => Control,
	82	DC4 => Control,
	83	NAK => Control,
	84	SYN => Control,
	85	ETB => Control,
	86	CAN => Control,
	87	EM => Control,
	88	SUB => Control,
	89	ESC => Control,
	90	FS => Control,
	91	GS => Control,
	92	RS => Control,
	93	US => Control,
	94
95	Space => Special,
96	Exclamation => Special,
97	Quotation => Special,
98	Number_Sign => Special,
99	Dollar_Sign => Special,
100	Percent_Sign => Special,
101	Ampersand => Special,
102	Apostrophe => Special,
103	Left_Parenthesis => Special,
104	Right_Parenthesis => Special,
105	Asterisk => Special,
106	Plus_Sign => Special,
107	Comma => Special,
108	Hyphen => Special,
109	Full_Stop => Special,
110	Solidus => Special,
111
112	'0' .. '9' => Digit + Hex_Digit,
113
114	Colon => Special,
115	Semicolon => Special,
116	Less_Than_Sign => Special,
117	Equals_Sign => Special,
118	Greater_Than_Sign => Special,
119	Question => Special,
120	Commercial_At => Special,
121
122	'A' .. 'F' => Upper + Basic + Hex_Digit,
123	'G' .. 'Z' => Upper + Basic,
124
125	Left_Square_Bracket => Special,
126	Reverse_Solidus => Special,
127	Right_Square_Bracket => Special,
128	Circumflex => Special,
129	Low_Line => Special,
130	Grave => Special,
131
132	'a' .. 'f' => Lower + Basic + Hex_Digit,
133	'g' .. 'z' => Lower + Basic,
134
135	Left_Curly_Bracket => Special,
136	Vertical_Line => Special,
137	Right_Curly_Bracket => Special,
138	Tilde => Special,
139
140	DEL => Control,
141	Reserved_128 => Control,
142	Reserved_129 => Control,
143	BPH => Control,
144	NBH => Control,
145	Reserved_132 => Control,
146	NEL => Control,
147	SSA => Control,
148	ESA => Control,
149	HTS => Control,
150	HTJ => Control,
151	VTS => Control,
152	PLD => Control,
153	PLU => Control,
154	RI => Control,
155	SS2 => Control,
156	SS3 => Control,
157
158	DCS => Control,
159	PU1 => Control,
160	PU2 => Control,
161	STS => Control,
162	CCH => Control,
163	MW => Control,
164	SPA => Control,
165	EPA => Control,
166
167	SOS => Control,
168	Reserved_153 => Control,
169	SCI => Control,
170	CSI => Control,
171	ST => Control,
172	OSC => Control,
173	PM => Control,
174	APC => Control,
175
176	No_Break_Space => Special,
177	Inverted_Exclamation => Special,
178	Cent_Sign => Special,
179	Pound_Sign => Special,
180	Currency_Sign => Special,
181	Yen_Sign => Special,
182	Broken_Bar => Special,
183	Section_Sign => Special,
184	Diaeresis => Special,
185	Copyright_Sign => Special,
186	Feminine_Ordinal_Indicator => Special,
187	Left_Angle_Quotation => Special,
188	Not_Sign => Special,
189	Soft_Hyphen => Special,
190	Registered_Trade_Mark_Sign => Special,
191	Macron => Special,
192	Degree_Sign => Special,
193	Plus_Minus_Sign => Special,
194	Superscript_Two => Special,
195	Superscript_Three => Special,
196	Acute => Special,
197	Micro_Sign => Special,
198	Pilcrow_Sign => Special,
199	Middle_Dot => Special,
200	Cedilla => Special,
201	Superscript_One => Special,
202	Masculine_Ordinal_Indicator => Special,
203	Right_Angle_Quotation => Special,
204	Fraction_One_Quarter => Special,
205	Fraction_One_Half => Special,
206	Fraction_Three_Quarters => Special,
207	Inverted_Question => Special,
208
209	UC_A_Grave => Upper,
210	UC_A_Acute => Upper,
211	UC_A_Circumflex => Upper,
212	UC_A_Tilde => Upper,
213	UC_A_Diaeresis => Upper,
214	UC_A_Ring => Upper,
215	UC_AE_Diphthong => Upper + Basic,
216	UC_C_Cedilla => Upper,
217	UC_E_Grave => Upper,
218	UC_E_Acute => Upper,
219	UC_E_Circumflex => Upper,
220	UC_E_Diaeresis => Upper,
221	UC_I_Grave => Upper,
222	UC_I_Acute => Upper,
223	UC_I_Circumflex => Upper,
224	UC_I_Diaeresis => Upper,
225	UC_Icelandic_Eth => Upper + Basic,
226	UC_N_Tilde => Upper,
227	UC_O_Grave => Upper,
228	UC_O_Acute => Upper,
229	UC_O_Circumflex => Upper,
230	UC_O_Tilde => Upper,
231	UC_O_Diaeresis => Upper,
232
233	Multiplication_Sign => Special,
234
235	UC_O_Oblique_Stroke => Upper,
236	UC_U_Grave => Upper,
237	UC_U_Acute => Upper,
238	UC_U_Circumflex => Upper,
239	UC_U_Diaeresis => Upper,
240	UC_Y_Acute => Upper,
241	UC_Icelandic_Thorn => Upper + Basic,
242
243	LC_German_Sharp_S => Lower + Basic,
244	LC_A_Grave => Lower,
245	LC_A_Acute => Lower,
246	LC_A_Circumflex => Lower,
247	LC_A_Tilde => Lower,
248	LC_A_Diaeresis => Lower,
249	LC_A_Ring => Lower,
250	LC_AE_Diphthong => Lower + Basic,
251	LC_C_Cedilla => Lower,
252	LC_E_Grave => Lower,
253	LC_E_Acute => Lower,
254	LC_E_Circumflex => Lower,
255	LC_E_Diaeresis => Lower,
256	LC_I_Grave => Lower,
257	LC_I_Acute => Lower,
258	LC_I_Circumflex => Lower,
259	LC_I_Diaeresis => Lower,
260	LC_Icelandic_Eth => Lower + Basic,
261	LC_N_Tilde => Lower,
262	LC_O_Grave => Lower,
263	LC_O_Acute => Lower,
264	LC_O_Circumflex => Lower,
265	LC_O_Tilde => Lower,
266	LC_O_Diaeresis => Lower,
267
268	Division_Sign => Special,
269
270	LC_O_Oblique_Stroke => Lower,
271	LC_U_Grave => Lower,
272	LC_U_Acute => Lower,
273	LC_U_Circumflex => Lower,
274	LC_U_Diaeresis => Lower,
275	LC_Y_Acute => Lower,
276	LC_Icelandic_Thorn => Lower + Basic,
277	LC_Y_Diaeresis => Lower
278	);
279
280	---------------------
281	-- Is_Alphanumeric --
282	---------------------
283
82c80734	284	function Is_Alphanumeric (Item : Character) return Boolean is
d23b8f57 RK	285	begin
	286	return (Char_Map (Item) and Alphanum) /= 0;
	287	end Is_Alphanumeric;
	288
	289	--------------
	290	-- Is_Basic --
	291	--------------
	292
82c80734	293	function Is_Basic (Item : Character) return Boolean is
d23b8f57 RK	294	begin
	295	return (Char_Map (Item) and Basic) /= 0;
	296	end Is_Basic;
	297
	298	------------------
	299	-- Is_Character --
	300	------------------
	301
82c80734	302	function Is_Character (Item : Wide_Character) return Boolean is
d23b8f57 RK	303	begin
	304	return Wide_Character'Pos (Item) < 256;
	305	end Is_Character;
	306
82c80734 RD	307	function Is_Character (Item : Wide_Wide_Character) return Boolean is
	308	begin
	309	return Wide_Wide_Character'Pos (Item) < 256;
	310	end Is_Character;
	311
d23b8f57 RK	312	----------------
	313	-- Is_Control --
	314	----------------
	315
82c80734	316	function Is_Control (Item : Character) return Boolean is
d23b8f57 RK	317	begin
	318	return (Char_Map (Item) and Control) /= 0;
	319	end Is_Control;
	320
	321	--------------
	322	-- Is_Digit --
	323	--------------
	324
82c80734	325	function Is_Digit (Item : Character) return Boolean is
d23b8f57 RK	326	begin
	327	return Item in '0' .. '9';
	328	end Is_Digit;
	329
	330	----------------
	331	-- Is_Graphic --
	332	----------------
	333
82c80734	334	function Is_Graphic (Item : Character) return Boolean is
d23b8f57 RK	335	begin
	336	return (Char_Map (Item) and Graphic) /= 0;
	337	end Is_Graphic;
	338
	339	--------------------------
	340	-- Is_Hexadecimal_Digit --
	341	--------------------------
	342
82c80734	343	function Is_Hexadecimal_Digit (Item : Character) return Boolean is
d23b8f57 RK	344	begin
	345	return (Char_Map (Item) and Hex_Digit) /= 0;
	346	end Is_Hexadecimal_Digit;
	347
	348	----------------
	349	-- Is_ISO_646 --
	350	----------------
	351
82c80734	352	function Is_ISO_646 (Item : Character) return Boolean is
d23b8f57 RK	353	begin
	354	return Item in ISO_646;
	355	end Is_ISO_646;
	356
	357	-- Note: much more efficient coding of the following function is possible
	358	-- by testing several 16#80# bits in a complete word in a single operation
	359
82c80734	360	function Is_ISO_646 (Item : String) return Boolean is
d23b8f57 RK	361	begin
	362	for J in Item'Range loop
	363	if Item (J) not in ISO_646 then
	364	return False;
	365	end if;
	366	end loop;
	367
	368	return True;
	369	end Is_ISO_646;
	370
	371	---------------
	372	-- Is_Letter --
	373	---------------
	374
82c80734	375	function Is_Letter (Item : Character) return Boolean is
d23b8f57 RK	376	begin
	377	return (Char_Map (Item) and Letter) /= 0;
	378	end Is_Letter;
	379
	380	--------------
	381	-- Is_Lower --
	382	--------------
	383
82c80734	384	function Is_Lower (Item : Character) return Boolean is
d23b8f57 RK	385	begin
	386	return (Char_Map (Item) and Lower) /= 0;
	387	end Is_Lower;
	388
	389	----------------
	390	-- Is_Special --
	391	----------------
	392
82c80734	393	function Is_Special (Item : Character) return Boolean is
d23b8f57 RK	394	begin
	395	return (Char_Map (Item) and Special) /= 0;
	396	end Is_Special;
	397
	398	---------------
	399	-- Is_String --
	400	---------------
	401
82c80734	402	function Is_String (Item : Wide_String) return Boolean is
d23b8f57 RK	403	begin
	404	for J in Item'Range loop
	405	if Wide_Character'Pos (Item (J)) >= 256 then
	406	return False;
	407	end if;
	408	end loop;
	409
	410	return True;
	411	end Is_String;
	412
82c80734 RD	413	function Is_String (Item : Wide_Wide_String) return Boolean is
	414	begin
	415	for J in Item'Range loop
	416	if Wide_Wide_Character'Pos (Item (J)) >= 256 then
	417	return False;
	418	end if;
	419	end loop;
	420
	421	return True;
	422	end Is_String;
	423
d23b8f57 RK	424	--------------
	425	-- Is_Upper --
	426	--------------
	427
82c80734	428	function Is_Upper (Item : Character) return Boolean is
d23b8f57 RK	429	begin
	430	return (Char_Map (Item) and Upper) /= 0;
	431	end Is_Upper;
	432
82c80734 RD	433	-----------------------
	434	-- Is_Wide_Character --
	435	-----------------------
	436
	437	function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is
	438	begin
	439	return Wide_Wide_Character'Pos (Item) < 2**16;
	440	end Is_Wide_Character;
	441
	442	--------------------
	443	-- Is_Wide_String --
	444	--------------------
	445
	446	function Is_Wide_String (Item : Wide_Wide_String) return Boolean is
	447	begin
	448	for J in Item'Range loop
	449	if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then
	450	return False;
	451	end if;
	452	end loop;
	453
	454	return True;
	455	end Is_Wide_String;
	456
d23b8f57 RK	457	--------------
	458	-- To_Basic --
	459	--------------
	460
82c80734	461	function To_Basic (Item : Character) return Character is
d23b8f57 RK	462	begin
	463	return Value (Basic_Map, Item);
	464	end To_Basic;
	465
82c80734	466	function To_Basic (Item : String) return String is
d23b8f57 RK	467	Result : String (1 .. Item'Length);
	468
	469	begin
	470	for J in Item'Range loop
	471	Result (J - (Item'First - 1)) := Value (Basic_Map, Item (J));
	472	end loop;
	473
	474	return Result;
	475	end To_Basic;
	476
	477	------------------
	478	-- To_Character --
	479	------------------
	480
	481	function To_Character
82c80734 RD	482	(Item : Wide_Character;
82c80734 RD	483	Substitute : Character := ' ') return Character
d23b8f57 RK	484	is
	485	begin
	486	if Is_Character (Item) then
	487	return Character'Val (Wide_Character'Pos (Item));
	488	else
	489	return Substitute;
	490	end if;
	491	end To_Character;
	492
82c80734 RD	493	function To_Character
	494	(Item : Wide_Wide_Character;
	495	Substitute : Character := ' ') return Character
	496	is
	497	begin
	498	if Is_Character (Item) then
	499	return Character'Val (Wide_Wide_Character'Pos (Item));
	500	else
	501	return Substitute;
	502	end if;
	503	end To_Character;
	504
d23b8f57 RK	505	----------------
	506	-- To_ISO_646 --
	507	----------------
	508
	509	function To_ISO_646
82c80734 RD	510	(Item : Character;
82c80734 RD	511	Substitute : ISO_646 := ' ') return ISO_646
d23b8f57 RK	512	is
	513	begin
	514	if Item in ISO_646 then
	515	return Item;
	516	else
	517	return Substitute;
	518	end if;
	519	end To_ISO_646;
	520
	521	function To_ISO_646
82c80734 RD	522	(Item : String;
82c80734 RD	523	Substitute : ISO_646 := ' ') return String
d23b8f57 RK	524	is
	525	Result : String (1 .. Item'Length);
	526
	527	begin
	528	for J in Item'Range loop
	529	if Item (J) in ISO_646 then
	530	Result (J - (Item'First - 1)) := Item (J);
	531	else
	532	Result (J - (Item'First - 1)) := Substitute;
	533	end if;
	534	end loop;
	535
	536	return Result;
	537	end To_ISO_646;
	538
	539	--------------
	540	-- To_Lower --
	541	--------------
	542
82c80734	543	function To_Lower (Item : Character) return Character is
d23b8f57 RK	544	begin
	545	return Value (Lower_Case_Map, Item);
	546	end To_Lower;
	547
82c80734	548	function To_Lower (Item : String) return String is
d23b8f57 RK	549	Result : String (1 .. Item'Length);
	550
	551	begin
	552	for J in Item'Range loop
	553	Result (J - (Item'First - 1)) := Value (Lower_Case_Map, Item (J));
	554	end loop;
	555
	556	return Result;
	557	end To_Lower;
	558
	559	---------------
	560	-- To_String --
	561	---------------
	562
	563	function To_String
82c80734 RD	564	(Item : Wide_String;
	565	Substitute : Character := ' ') return String
	566	is
	567	Result : String (1 .. Item'Length);
	568
	569	begin
	570	for J in Item'Range loop
	571	Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
	572	end loop;
	573
	574	return Result;
	575	end To_String;
	576
	577	function To_String
	578	(Item : Wide_Wide_String;
	579	Substitute : Character := ' ') return String
d23b8f57 RK	580	is
	581	Result : String (1 .. Item'Length);
	582
	583	begin
	584	for J in Item'Range loop
	585	Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
	586	end loop;
82c80734	587
d23b8f57 RK	588	return Result;
	589	end To_String;
	590
	591	--------------
	592	-- To_Upper --
	593	--------------
	594
	595	function To_Upper
82c80734	596	(Item : Character) return Character
d23b8f57 RK	597	is
	598	begin
	599	return Value (Upper_Case_Map, Item);
	600	end To_Upper;
	601
	602	function To_Upper
82c80734	603	(Item : String) return String
d23b8f57 RK	604	is
	605	Result : String (1 .. Item'Length);
	606
	607	begin
	608	for J in Item'Range loop
	609	Result (J - (Item'First - 1)) := Value (Upper_Case_Map, Item (J));
	610	end loop;
	611
	612	return Result;
	613	end To_Upper;
	614
	615	-----------------------
	616	-- To_Wide_Character --
	617	-----------------------
	618
	619	function To_Wide_Character
82c80734	620	(Item : Character) return Wide_Character
d23b8f57 RK	621	is
	622	begin
	623	return Wide_Character'Val (Character'Pos (Item));
	624	end To_Wide_Character;
	625
82c80734 RD	626	function To_Wide_Character
	627	(Item : Wide_Wide_Character;
	628	Substitute : Wide_Character := ' ') return Wide_Character
	629	is
	630	begin
	631	if Wide_Wide_Character'Pos (Item) < 2**16 then
	632	return Wide_Character'Val (Wide_Wide_Character'Pos (Item));
	633	else
	634	return Substitute;
	635	end if;
	636	end To_Wide_Character;
	637
d23b8f57 RK	638	--------------------
	639	-- To_Wide_String --
	640	--------------------
	641
	642	function To_Wide_String
82c80734	643	(Item : String) return Wide_String
d23b8f57 RK	644	is
	645	Result : Wide_String (1 .. Item'Length);
	646
	647	begin
	648	for J in Item'Range loop
	649	Result (J - (Item'First - 1)) := To_Wide_Character (Item (J));
	650	end loop;
	651
	652	return Result;
	653	end To_Wide_String;
82c80734 RD	654
	655	function To_Wide_String
	656	(Item : Wide_Wide_String;
	657	Substitute : Wide_Character := ' ') return Wide_String
	658	is
	659	Result : Wide_String (1 .. Item'Length);
	660
	661	begin
	662	for J in Item'Range loop
	663	Result (J - (Item'First - 1)) :=
	664	To_Wide_Character (Item (J), Substitute);
	665	end loop;
	666
	667	return Result;
	668	end To_Wide_String;
	669
	670	----------------------------
	671	-- To_Wide_Wide_Character --
	672	----------------------------
	673
	674	function To_Wide_Wide_Character
	675	(Item : Character) return Wide_Wide_Character
	676	is
	677	begin
	678	return Wide_Wide_Character'Val (Character'Pos (Item));
	679	end To_Wide_Wide_Character;
	680
	681	function To_Wide_Wide_Character
	682	(Item : Wide_Character) return Wide_Wide_Character
	683	is
	684	begin
	685	return Wide_Wide_Character'Val (Wide_Character'Pos (Item));
	686	end To_Wide_Wide_Character;
	687
	688	-------------------------
	689	-- To_Wide_Wide_String --
	690	-------------------------
	691
	692	function To_Wide_Wide_String
	693	(Item : String) return Wide_Wide_String
	694	is
	695	Result : Wide_Wide_String (1 .. Item'Length);
	696
	697	begin
	698	for J in Item'Range loop
	699	Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
	700	end loop;
	701
	702	return Result;
	703	end To_Wide_Wide_String;
	704
	705	function To_Wide_Wide_String
	706	(Item : Wide_String) return Wide_Wide_String
	707	is
	708	Result : Wide_Wide_String (1 .. Item'Length);
	709
	710	begin
	711	for J in Item'Range loop
	712	Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
	713	end loop;
	714
	715	return Result;
	716	end To_Wide_Wide_String;
	717
d23b8f57	718	end Ada.Characters.Handling;