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-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 38package 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 322end Ada.Strings.Maps; 323