1------------------------------------------------------------------------------ 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-2018, 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 38package body Ada.Strings.Maps is 39 40 --------- 41 -- "-" -- 42 --------- 43 44 function "-" (Left, Right : Character_Set) return Character_Set is 45 begin 46 return Left and not Right; 47 end "-"; 48 49 --------- 50 -- "=" -- 51 --------- 52 53 function "=" (Left, Right : Character_Set) return Boolean is 54 begin 55 return Character_Set_Internal (Left) = Character_Set_Internal (Right); 56 end "="; 57 58 ----------- 59 -- "and" -- 60 ----------- 61 62 function "and" (Left, Right : Character_Set) return Character_Set is 63 begin 64 return Character_Set 65 (Character_Set_Internal (Left) and Character_Set_Internal (Right)); 66 end "and"; 67 68 ----------- 69 -- "not" -- 70 ----------- 71 72 function "not" (Right : Character_Set) return Character_Set is 73 begin 74 return Character_Set (not Character_Set_Internal (Right)); 75 end "not"; 76 77 ---------- 78 -- "or" -- 79 ---------- 80 81 function "or" (Left, Right : Character_Set) return Character_Set is 82 begin 83 return Character_Set 84 (Character_Set_Internal (Left) or Character_Set_Internal (Right)); 85 end "or"; 86 87 ----------- 88 -- "xor" -- 89 ----------- 90 91 function "xor" (Left, Right : Character_Set) return Character_Set is 92 begin 93 return Character_Set 94 (Character_Set_Internal (Left) xor Character_Set_Internal (Right)); 95 end "xor"; 96 97 ----------- 98 -- Is_In -- 99 ----------- 100 101 function Is_In 102 (Element : Character; 103 Set : Character_Set) return Boolean 104 is 105 begin 106 return Set (Element); 107 end Is_In; 108 109 --------------- 110 -- Is_Subset -- 111 --------------- 112 113 function Is_Subset 114 (Elements : Character_Set; 115 Set : Character_Set) return Boolean 116 is 117 begin 118 return (Elements and Set) = Elements; 119 end Is_Subset; 120 121 --------------- 122 -- To_Domain -- 123 --------------- 124 125 function To_Domain (Map : Character_Mapping) return Character_Sequence 126 is 127 Result : String (1 .. Map'Length); 128 J : Natural; 129 130 begin 131 J := 0; 132 for C in Map'Range loop 133 if Map (C) /= C then 134 J := J + 1; 135 Result (J) := C; 136 end if; 137 end loop; 138 139 return Result (1 .. J); 140 end To_Domain; 141 142 ---------------- 143 -- To_Mapping -- 144 ---------------- 145 146 function To_Mapping 147 (From, To : Character_Sequence) return Character_Mapping 148 is 149 Result : Character_Mapping; 150 Inserted : Character_Set := Null_Set; 151 From_Len : constant Natural := From'Length; 152 To_Len : constant Natural := To'Length; 153 154 begin 155 if From_Len /= To_Len then 156 raise Strings.Translation_Error; 157 end if; 158 159 for Char in Character loop 160 Result (Char) := Char; 161 end loop; 162 163 for J in From'Range loop 164 if Inserted (From (J)) then 165 raise Strings.Translation_Error; 166 end if; 167 168 Result (From (J)) := To (J - From'First + To'First); 169 Inserted (From (J)) := True; 170 end loop; 171 172 return Result; 173 end To_Mapping; 174 175 -------------- 176 -- To_Range -- 177 -------------- 178 179 function To_Range (Map : Character_Mapping) return Character_Sequence 180 is 181 Result : String (1 .. Map'Length); 182 J : Natural; 183 begin 184 J := 0; 185 for C in Map'Range loop 186 if Map (C) /= C then 187 J := J + 1; 188 Result (J) := Map (C); 189 end if; 190 end loop; 191 192 return Result (1 .. J); 193 end To_Range; 194 195 --------------- 196 -- To_Ranges -- 197 --------------- 198 199 function To_Ranges (Set : Character_Set) return Character_Ranges is 200 Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1); 201 Range_Num : Natural; 202 C : Character; 203 204 begin 205 C := Character'First; 206 Range_Num := 0; 207 208 loop 209 -- Skip gap between subsets 210 211 while not Set (C) loop 212 exit when C = Character'Last; 213 C := Character'Succ (C); 214 end loop; 215 216 exit when not Set (C); 217 218 Range_Num := Range_Num + 1; 219 Max_Ranges (Range_Num).Low := C; 220 221 -- Span a subset 222 223 loop 224 exit when not Set (C) or else C = Character'Last; 225 C := Character'Succ (C); 226 end loop; 227 228 if Set (C) then 229 Max_Ranges (Range_Num). High := C; 230 exit; 231 else 232 Max_Ranges (Range_Num). High := Character'Pred (C); 233 end if; 234 end loop; 235 236 return Max_Ranges (1 .. Range_Num); 237 end To_Ranges; 238 239 ----------------- 240 -- To_Sequence -- 241 ----------------- 242 243 function To_Sequence (Set : Character_Set) return Character_Sequence is 244 Result : String (1 .. Character'Pos (Character'Last) + 1); 245 Count : Natural := 0; 246 begin 247 for Char in Set'Range loop 248 if Set (Char) then 249 Count := Count + 1; 250 Result (Count) := Char; 251 end if; 252 end loop; 253 254 return Result (1 .. Count); 255 end To_Sequence; 256 257 ------------ 258 -- To_Set -- 259 ------------ 260 261 function To_Set (Ranges : Character_Ranges) return Character_Set is 262 Result : Character_Set; 263 begin 264 for C in Result'Range loop 265 Result (C) := False; 266 end loop; 267 268 for R in Ranges'Range loop 269 for C in Ranges (R).Low .. Ranges (R).High loop 270 Result (C) := True; 271 end loop; 272 end loop; 273 274 return Result; 275 end To_Set; 276 277 function To_Set (Span : Character_Range) return Character_Set is 278 Result : Character_Set; 279 begin 280 for C in Result'Range loop 281 Result (C) := False; 282 end loop; 283 284 for C in Span.Low .. Span.High loop 285 Result (C) := True; 286 end loop; 287 288 return Result; 289 end To_Set; 290 291 function To_Set (Sequence : Character_Sequence) return Character_Set is 292 Result : Character_Set := Null_Set; 293 begin 294 for J in Sequence'Range loop 295 Result (Sequence (J)) := True; 296 end loop; 297 298 return Result; 299 end To_Set; 300 301 function To_Set (Singleton : Character) return Character_Set is 302 Result : Character_Set := Null_Set; 303 begin 304 Result (Singleton) := True; 305 return Result; 306 end To_Set; 307 308 ----------- 309 -- Value -- 310 ----------- 311 312 function Value 313 (Map : Character_Mapping; 314 Element : Character) return Character 315 is 316 begin 317 return Map (Element); 318 end Value; 319 320end Ada.Strings.Maps; 321