1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . S T R I N G S . M A P S --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
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.
38 package body Ada
.Strings
.Maps
is
44 function "-" (Left
, Right
: Character_Set
) return Character_Set
is
46 return Left
and not Right
;
53 function "=" (Left
, Right
: Character_Set
) return Boolean is
55 return Character_Set_Internal
(Left
) = Character_Set_Internal
(Right
);
62 function "and" (Left
, Right
: Character_Set
) return Character_Set
is
65 (Character_Set_Internal
(Left
) and Character_Set_Internal
(Right
));
72 function "not" (Right
: Character_Set
) return Character_Set
is
74 return Character_Set
(not Character_Set_Internal
(Right
));
81 function "or" (Left
, Right
: Character_Set
) return Character_Set
is
84 (Character_Set_Internal
(Left
) or Character_Set_Internal
(Right
));
91 function "xor" (Left
, Right
: Character_Set
) return Character_Set
is
94 (Character_Set_Internal
(Left
) xor Character_Set_Internal
(Right
));
102 (Element
: Character;
103 Set
: Character_Set
) return Boolean
106 return Set
(Element
);
114 (Elements
: Character_Set
;
115 Set
: Character_Set
) return Boolean
118 return (Elements
and Set
) = Elements
;
125 function To_Domain
(Map
: Character_Mapping
) return Character_Sequence
127 Result
: String (1 .. Map
'Length);
132 for C
in Map
'Range loop
139 return Result
(1 .. J
);
147 (From
, To
: Character_Sequence
) return Character_Mapping
149 Result
: Character_Mapping
;
150 Inserted
: Character_Set
:= Null_Set
;
151 From_Len
: constant Natural := From
'Length;
152 To_Len
: constant Natural := To
'Length;
155 if From_Len
/= To_Len
then
156 raise Strings
.Translation_Error
;
159 for Char
in Character loop
160 Result
(Char
) := Char
;
163 for J
in From
'Range loop
164 if Inserted
(From
(J
)) then
165 raise Strings
.Translation_Error
;
168 Result
(From
(J
)) := To
(J
- From
'First + To
'First);
169 Inserted
(From
(J
)) := True;
179 function To_Range
(Map
: Character_Mapping
) return Character_Sequence
181 Result
: String (1 .. Map
'Length);
185 for C
in Map
'Range loop
188 Result
(J
) := Map
(C
);
192 return Result
(1 .. J
);
199 function To_Ranges
(Set
: Character_Set
) return Character_Ranges
is
200 Max_Ranges
: Character_Ranges
(1 .. Set
'Length / 2 + 1);
205 C
:= Character'First;
209 -- Skip gap between subsets
211 while not Set
(C
) loop
212 exit when C
= Character'Last;
213 C
:= Character'Succ (C
);
216 exit when not Set
(C
);
218 Range_Num
:= Range_Num
+ 1;
219 Max_Ranges
(Range_Num
).Low
:= C
;
224 exit when not Set
(C
) or else C
= Character'Last;
225 C
:= Character'Succ (C
);
229 Max_Ranges
(Range_Num
). High
:= C
;
232 Max_Ranges
(Range_Num
). High
:= Character'Pred (C
);
236 return Max_Ranges
(1 .. Range_Num
);
243 function To_Sequence
(Set
: Character_Set
) return Character_Sequence
is
244 Result
: String (1 .. Character'Pos (Character'Last) + 1);
245 Count
: Natural := 0;
247 for Char
in Set
'Range loop
250 Result
(Count
) := Char
;
254 return Result
(1 .. Count
);
261 function To_Set
(Ranges
: Character_Ranges
) return Character_Set
is
262 Result
: Character_Set
;
264 for C
in Result
'Range loop
268 for R
in Ranges
'Range loop
269 for C
in Ranges
(R
).Low
.. Ranges
(R
).High
loop
277 function To_Set
(Span
: Character_Range
) return Character_Set
is
278 Result
: Character_Set
;
280 for C
in Result
'Range loop
284 for C
in Span
.Low
.. Span
.High
loop
291 function To_Set
(Sequence
: Character_Sequence
) return Character_Set
is
292 Result
: Character_Set
:= Null_Set
;
294 for J
in Sequence
'Range loop
295 Result
(Sequence
(J
)) := True;
301 function To_Set
(Singleton
: Character) return Character_Set
is
302 Result
: Character_Set
:= Null_Set
;
304 Result
(Singleton
) := True;
313 (Map
: Character_Mapping
;
314 Element
: Character) return Character
317 return Map
(Element
);
320 end Ada
.Strings
.Maps
;