URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-strmap.adb] - Blame information for rev 729

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--                     A D A . S T R I N G S . M A P S                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2009, 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 3,  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.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
--  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
 
   use Ada.Characters.Latin_1;
 
   ---------
   -- "-" --
   ---------
 
   function "-" (Left, Right : Character_Set) return Character_Set is
   begin
      return Left and not Right;
   end "-";
 
   ---------
   -- "=" --
   ---------
 
   function "=" (Left, Right : Character_Set) return Boolean is
   begin
      return Character_Set_Internal (Left) = Character_Set_Internal (Right);
   end "=";
 
   -----------
   -- "and" --
   -----------
 
   function "and" (Left, Right : Character_Set) return Character_Set is
   begin
      return Character_Set
        (Character_Set_Internal (Left) and Character_Set_Internal (Right));
   end "and";
 
   -----------
   -- "not" --
   -----------
 
   function "not" (Right : Character_Set) return Character_Set is
   begin
      return Character_Set (not Character_Set_Internal (Right));
   end "not";
 
   ----------
   -- "or" --
   ----------
 
   function "or" (Left, Right : Character_Set) return Character_Set is
   begin
      return Character_Set
        (Character_Set_Internal (Left) or Character_Set_Internal (Right));
   end "or";
 
   -----------
   -- "xor" --
   -----------
 
   function "xor" (Left, Right : Character_Set) return Character_Set is
   begin
      return Character_Set
        (Character_Set_Internal (Left) xor Character_Set_Internal (Right));
   end "xor";
 
   -----------
   -- Is_In --
   -----------
 
   function Is_In
     (Element : Character;
      Set     : Character_Set) return Boolean
   is
   begin
      return Set (Element);
   end Is_In;
 
   ---------------
   -- Is_Subset --
   ---------------
 
   function Is_Subset
     (Elements : Character_Set;
      Set      : Character_Set) return Boolean
   is
   begin
      return (Elements and Set) = Elements;
   end Is_Subset;
 
   ---------------
   -- To_Domain --
   ---------------
 
   function To_Domain (Map : Character_Mapping) return Character_Sequence
   is
      Result : String (1 .. Map'Length);
      J      : Natural;
 
   begin
      J := 0;
      for C in Map'Range loop
         if Map (C) /= C then
            J := J + 1;
            Result (J) := C;
         end if;
      end loop;
 
      return Result (1 .. J);
   end To_Domain;
 
   ----------------
   -- To_Mapping --
   ----------------
 
   function To_Mapping
     (From, To : Character_Sequence) return Character_Mapping
   is
      Result   : Character_Mapping;
      Inserted : Character_Set := Null_Set;
      From_Len : constant Natural := From'Length;
      To_Len   : constant Natural := To'Length;
 
   begin
      if From_Len /= To_Len then
         raise Strings.Translation_Error;
      end if;
 
      for Char in Character loop
         Result (Char) := Char;
      end loop;
 
      for J in From'Range loop
         if Inserted (From (J)) then
            raise Strings.Translation_Error;
         end if;
 
         Result   (From (J)) := To (J - From'First + To'First);
         Inserted (From (J)) := True;
      end loop;
 
      return Result;
   end To_Mapping;
 
   --------------
   -- To_Range --
   --------------
 
   function To_Range (Map : Character_Mapping) return Character_Sequence
   is
      Result : String (1 .. Map'Length);
      J      : Natural;
   begin
      J := 0;
      for C in Map'Range loop
         if Map (C) /= C then
            J := J + 1;
            Result (J) := Map (C);
         end if;
      end loop;
 
      return Result (1 .. J);
   end To_Range;
 
   ---------------
   -- To_Ranges --
   ---------------
 
   function To_Ranges (Set : Character_Set) return Character_Ranges is
      Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1);
      Range_Num  : Natural;
      C          : Character;
 
   begin
      C := Character'First;
      Range_Num := 0;
 
      loop
         --  Skip gap between subsets
 
         while not Set (C) loop
            exit when C = Character'Last;
            C := Character'Succ (C);
         end loop;
 
         exit when not Set (C);
 
         Range_Num := Range_Num + 1;
         Max_Ranges (Range_Num).Low := C;
 
         --  Span a subset
 
         loop
            exit when not Set (C) or else C = Character'Last;
            C := Character'Succ (C);
         end loop;
 
         if Set (C) then
            Max_Ranges (Range_Num). High := C;
            exit;
         else
            Max_Ranges (Range_Num). High := Character'Pred (C);
         end if;
      end loop;
 
      return Max_Ranges (1 .. Range_Num);
   end To_Ranges;
 
   -----------------
   -- To_Sequence --
   -----------------
 
   function To_Sequence (Set : Character_Set) return Character_Sequence is
      Result : String (1 .. Character'Pos (Character'Last) + 1);
      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 (Ranges : Character_Ranges) return Character_Set is
      Result : Character_Set;
   begin
      for C in Result'Range loop
         Result (C) := False;
      end loop;
 
      for R in Ranges'Range loop
         for C in Ranges (R).Low .. Ranges (R).High loop
            Result (C) := True;
         end loop;
      end loop;
 
      return Result;
   end To_Set;
 
   function To_Set (Span : Character_Range) return Character_Set is
      Result : Character_Set;
   begin
      for C in Result'Range loop
         Result (C) := False;
      end loop;
 
      for C in Span.Low .. Span.High loop
         Result (C) := True;
      end loop;
 
      return Result;
   end To_Set;
 
   function To_Set (Sequence : Character_Sequence) return Character_Set is
      Result : Character_Set := Null_Set;
   begin
      for J in Sequence'Range loop
         Result (Sequence (J)) := True;
      end loop;
 
      return Result;
   end To_Set;
 
   function To_Set (Singleton : Character) return Character_Set is
      Result : Character_Set := Null_Set;
   begin
      Result (Singleton) := True;
      return Result;
   end To_Set;
 
   -----------
   -- Value --
   -----------
 
   function Value
     (Map     : Character_Mapping;
      Element : Character) return Character
   is
   begin
      return Map (Element);
   end Value;
 
end Ada.Strings.Maps;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-strmap.adb] - Blame information for rev 729

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT RUN-TIME COMPONENTS --`
4			`-- --`
5			`-- A D A . S T R I N G S . M A P S --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 1992-2009, Free Software Foundation, 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 3, 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. --`
17			`-- --`
18			`-- As a special exception under Section 7 of GPL version 3, you are granted --`
19			`-- additional permissions described in the GCC Runtime Library Exception, --`
20			`-- version 3.1, as published by the Free Software Foundation. --`
21			`-- --`
22			`-- You should have received a copy of the GNU General Public License and --`
23			`-- a copy of the GCC Runtime Library Exception along with this program; --`
24			`-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --`
25			`-- <http://www.gnu.org/licenses/>. --`
26			`-- --`
27			`-- GNAT was originally developed by the GNAT team at New York University. --`
28			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
29			`-- --`
30			`------------------------------------------------------------------------------`
31
32			`-- Note: parts of this code are derived from the ADAR.CSH public domain`
33			`-- Ada 83 versions of the Appendix C string handling packages. The main`
34			`-- differences are that we avoid the use of the minimize function which`
35			`-- is bit-by-bit or character-by-character and therefore rather slow.`
36			`-- Generally for character sets we favor the full 32-byte representation.`
37
38			`package body Ada.Strings.Maps is`
39
40			`use Ada.Characters.Latin_1;`
41
42			`---------`
43			`-- "-" --`
44			`---------`
45
46			`function "-" (Left, Right : Character_Set) return Character_Set is`
47			`begin`
48			`return Left and not Right;`
49			`end "-";`
50
51			`---------`
52			`-- "=" --`
53			`---------`
54
55			`function "=" (Left, Right : Character_Set) return Boolean is`
56			`begin`
57			`return Character_Set_Internal (Left) = Character_Set_Internal (Right);`
58			`end "=";`
59
60			`-----------`
61			`-- "and" --`
62			`-----------`
63
64			`function "and" (Left, Right : Character_Set) return Character_Set is`
65			`begin`
66			`return Character_Set`
67			`(Character_Set_Internal (Left) and Character_Set_Internal (Right));`
68			`end "and";`
69
70			`-----------`
71			`-- "not" --`
72			`-----------`
73
74			`function "not" (Right : Character_Set) return Character_Set is`
75			`begin`
76			`return Character_Set (not Character_Set_Internal (Right));`
77			`end "not";`
78
79			`----------`
80			`-- "or" --`
81			`----------`
82
83			`function "or" (Left, Right : Character_Set) return Character_Set is`
84			`begin`
85			`return Character_Set`
86			`(Character_Set_Internal (Left) or Character_Set_Internal (Right));`
87			`end "or";`
88
89			`-----------`
90			`-- "xor" --`
91			`-----------`
92
93			`function "xor" (Left, Right : Character_Set) return Character_Set is`
94			`begin`
95			`return Character_Set`
96			`(Character_Set_Internal (Left) xor Character_Set_Internal (Right));`
97			`end "xor";`
98
99			`-----------`
100			`-- Is_In --`
101			`-----------`
102
103			`function Is_In`
104			`(Element : Character;`
105			`Set : Character_Set) return Boolean`
106			`is`
107			`begin`
108			`return Set (Element);`
109			`end Is_In;`
110
111			`---------------`
112			`-- Is_Subset --`
113			`---------------`
114
115			`function Is_Subset`
116			`(Elements : Character_Set;`
117			`Set : Character_Set) return Boolean`
118			`is`
119			`begin`
120			`return (Elements and Set) = Elements;`
121			`end Is_Subset;`
122
123			`---------------`
124			`-- To_Domain --`
125			`---------------`
126
127			`function To_Domain (Map : Character_Mapping) return Character_Sequence`
128			`is`
129			`Result : String (1 .. Map'Length);`
130			`J : Natural;`
131
132			`begin`
133			`J := 0;`
134			`for C in Map'Range loop`
135			`if Map (C) /= C then`
136			`J := J + 1;`
137			`Result (J) := C;`
138			`end if;`
139			`end loop;`
140
141			`return Result (1 .. J);`
142			`end To_Domain;`
143
144			`----------------`
145			`-- To_Mapping --`
146			`----------------`
147
148			`function To_Mapping`
149			`(From, To : Character_Sequence) return Character_Mapping`
150			`is`
151			`Result : Character_Mapping;`
152			`Inserted : Character_Set := Null_Set;`
153			`From_Len : constant Natural := From'Length;`
154			`To_Len : constant Natural := To'Length;`
155
156			`begin`
157			`if From_Len /= To_Len then`
158			`raise Strings.Translation_Error;`
159			`end if;`
160
161			`for Char in Character loop`
162			`Result (Char) := Char;`
163			`end loop;`
164
165			`for J in From'Range loop`
166			`if Inserted (From (J)) then`
167			`raise Strings.Translation_Error;`
168			`end if;`
169
170			`Result (From (J)) := To (J - From'First + To'First);`
171			`Inserted (From (J)) := True;`
172			`end loop;`
173
174			`return Result;`
175			`end To_Mapping;`
176
177			`--------------`
178			`-- To_Range --`
179			`--------------`
180
181			`function To_Range (Map : Character_Mapping) return Character_Sequence`
182			`is`
183			`Result : String (1 .. Map'Length);`
184			`J : Natural;`
185			`begin`
186			`J := 0;`
187			`for C in Map'Range loop`
188			`if Map (C) /= C then`
189			`J := J + 1;`
190			`Result (J) := Map (C);`
191			`end if;`
192			`end loop;`
193
194			`return Result (1 .. J);`
195			`end To_Range;`
196
197			`---------------`
198			`-- To_Ranges --`
199			`---------------`
200
201			`function To_Ranges (Set : Character_Set) return Character_Ranges is`
202			`Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1);`
203			`Range_Num : Natural;`
204			`C : Character;`
205
206			`begin`
207			`C := Character'First;`
208			`Range_Num := 0;`
209
210			`loop`
211			`-- Skip gap between subsets`
212
213			`while not Set (C) loop`
214			`exit when C = Character'Last;`
215			`C := Character'Succ (C);`
216			`end loop;`
217
218			`exit when not Set (C);`
219
220			`Range_Num := Range_Num + 1;`
221			`Max_Ranges (Range_Num).Low := C;`
222
223			`-- Span a subset`
224
225			`loop`
226			`exit when not Set (C) or else C = Character'Last;`
227			`C := Character'Succ (C);`
228			`end loop;`
229
230			`if Set (C) then`
231			`Max_Ranges (Range_Num). High := C;`
232			`exit;`
233			`else`
234			`Max_Ranges (Range_Num). High := Character'Pred (C);`
235			`end if;`
236			`end loop;`
237
238			`return Max_Ranges (1 .. Range_Num);`
239			`end To_Ranges;`
240
241			`-----------------`
242			`-- To_Sequence --`
243			`-----------------`
244
245			`function To_Sequence (Set : Character_Set) return Character_Sequence is`
246			`Result : String (1 .. Character'Pos (Character'Last) + 1);`
247			`Count : Natural := 0;`
248			`begin`
249			`for Char in Set'Range loop`
250			`if Set (Char) then`
251			`Count := Count + 1;`
252			`Result (Count) := Char;`
253			`end if;`
254			`end loop;`
255
256			`return Result (1 .. Count);`
257			`end To_Sequence;`
258
259			`------------`
260			`-- To_Set --`
261			`------------`
262
263			`function To_Set (Ranges : Character_Ranges) return Character_Set is`
264			`Result : Character_Set;`
265			`begin`
266			`for C in Result'Range loop`
267			`Result (C) := False;`
268			`end loop;`
269
270			`for R in Ranges'Range loop`
271			`for C in Ranges (R).Low .. Ranges (R).High loop`
272			`Result (C) := True;`
273			`end loop;`
274			`end loop;`
275
276			`return Result;`
277			`end To_Set;`
278
279			`function To_Set (Span : Character_Range) return Character_Set is`
280			`Result : Character_Set;`
281			`begin`
282			`for C in Result'Range loop`
283			`Result (C) := False;`
284			`end loop;`
285
286			`for C in Span.Low .. Span.High loop`
287			`Result (C) := True;`
288			`end loop;`
289
290			`return Result;`
291			`end To_Set;`
292
293			`function To_Set (Sequence : Character_Sequence) return Character_Set is`
294			`Result : Character_Set := Null_Set;`
295			`begin`
296			`for J in Sequence'Range loop`
297			`Result (Sequence (J)) := True;`
298			`end loop;`
299
300			`return Result;`
301			`end To_Set;`
302
303			`function To_Set (Singleton : Character) return Character_Set is`
304			`Result : Character_Set := Null_Set;`
305			`begin`
306			`Result (Singleton) := True;`
307			`return Result;`
308			`end To_Set;`
309
310			`-----------`
311			`-- Value --`
312			`-----------`
313
314			`function Value`
315			`(Map : Character_Mapping;`
316			`Element : Character) return Character`
317			`is`
318			`begin`
319			`return Map (Element);`
320			`end Value;`
321
322			`end Ada.Strings.Maps;`