OpenCores
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 706

Details | Compare with Previous | View Log

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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.