Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/g-arrspl.adb @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 1 ------------------------------------------------------------------------------ | |
| 2 -- -- | |
| 3 -- GNAT COMPILER COMPONENTS -- | |
| 4 -- -- | |
| 5 -- G N A T . A R R A Y _ S P L I T -- | |
| 6 -- -- | |
| 7 -- B o d y -- | |
| 8 -- -- | |
| 9 -- Copyright (C) 2002-2017, 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 with Ada.Unchecked_Deallocation; | |
| 33 | |
| 34 package body GNAT.Array_Split is | |
| 35 | |
| 36 procedure Free is | |
| 37 new Ada.Unchecked_Deallocation (Slices_Indexes, Slices_Access); | |
| 38 | |
| 39 procedure Free is | |
| 40 new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access); | |
| 41 | |
| 42 function Count | |
| 43 (Source : Element_Sequence; | |
| 44 Pattern : Element_Set) return Natural; | |
| 45 -- Returns the number of occurrences of Pattern elements in Source, 0 is | |
| 46 -- returned if no occurrence is found in Source. | |
| 47 | |
| 48 ------------ | |
| 49 -- Adjust -- | |
| 50 ------------ | |
| 51 | |
| 52 procedure Adjust (S : in out Slice_Set) is | |
| 53 begin | |
| 54 S.D.Ref_Counter := S.D.Ref_Counter + 1; | |
| 55 end Adjust; | |
| 56 | |
| 57 ------------ | |
| 58 -- Create -- | |
| 59 ------------ | |
| 60 | |
| 61 procedure Create | |
| 62 (S : out Slice_Set; | |
| 63 From : Element_Sequence; | |
| 64 Separators : Element_Sequence; | |
| 65 Mode : Separator_Mode := Single) | |
| 66 is | |
| 67 begin | |
| 68 Create (S, From, To_Set (Separators), Mode); | |
| 69 end Create; | |
| 70 | |
| 71 ------------ | |
| 72 -- Create -- | |
| 73 ------------ | |
| 74 | |
| 75 procedure Create | |
| 76 (S : out Slice_Set; | |
| 77 From : Element_Sequence; | |
| 78 Separators : Element_Set; | |
| 79 Mode : Separator_Mode := Single) | |
| 80 is | |
| 81 Result : Slice_Set; | |
| 82 begin | |
| 83 Result.D.Source := new Element_Sequence'(From); | |
| 84 Set (Result, Separators, Mode); | |
| 85 S := Result; | |
| 86 end Create; | |
| 87 | |
| 88 ----------- | |
| 89 -- Count -- | |
| 90 ----------- | |
| 91 | |
| 92 function Count | |
| 93 (Source : Element_Sequence; | |
| 94 Pattern : Element_Set) return Natural | |
| 95 is | |
| 96 C : Natural := 0; | |
| 97 begin | |
| 98 for K in Source'Range loop | |
| 99 if Is_In (Source (K), Pattern) then | |
| 100 C := C + 1; | |
| 101 end if; | |
| 102 end loop; | |
| 103 | |
| 104 return C; | |
| 105 end Count; | |
| 106 | |
| 107 -------------- | |
| 108 -- Finalize -- | |
| 109 -------------- | |
| 110 | |
| 111 procedure Finalize (S : in out Slice_Set) is | |
| 112 | |
| 113 procedure Free is | |
| 114 new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access); | |
| 115 | |
| 116 procedure Free is | |
| 117 new Ada.Unchecked_Deallocation (Data, Data_Access); | |
| 118 | |
| 119 D : Data_Access := S.D; | |
| 120 | |
| 121 begin | |
| 122 -- Ensure call is idempotent | |
| 123 | |
| 124 S.D := null; | |
| 125 | |
| 126 if D /= null then | |
| 127 D.Ref_Counter := D.Ref_Counter - 1; | |
| 128 | |
| 129 if D.Ref_Counter = 0 then | |
| 130 Free (D.Source); | |
| 131 Free (D.Indexes); | |
| 132 Free (D.Slices); | |
| 133 Free (D); | |
| 134 end if; | |
| 135 end if; | |
| 136 end Finalize; | |
| 137 | |
| 138 ---------------- | |
| 139 -- Initialize -- | |
| 140 ---------------- | |
| 141 | |
| 142 procedure Initialize (S : in out Slice_Set) is | |
| 143 begin | |
| 144 S.D := new Data'(1, null, 0, null, null); | |
| 145 end Initialize; | |
| 146 | |
| 147 ---------------- | |
| 148 -- Separators -- | |
| 149 ---------------- | |
| 150 | |
| 151 function Separators | |
| 152 (S : Slice_Set; | |
| 153 Index : Slice_Number) return Slice_Separators | |
| 154 is | |
| 155 begin | |
| 156 if Index > S.D.N_Slice then | |
| 157 raise Index_Error; | |
| 158 | |
| 159 elsif Index = 0 | |
| 160 or else (Index = 1 and then S.D.N_Slice = 1) | |
| 161 then | |
| 162 -- Whole string, or no separator used | |
| 163 | |
| 164 return (Before => Array_End, | |
| 165 After => Array_End); | |
| 166 | |
| 167 elsif Index = 1 then | |
| 168 return (Before => Array_End, | |
| 169 After => S.D.Source (S.D.Slices (Index).Stop + 1)); | |
| 170 | |
| 171 elsif Index = S.D.N_Slice then | |
| 172 return (Before => S.D.Source (S.D.Slices (Index).Start - 1), | |
| 173 After => Array_End); | |
| 174 | |
| 175 else | |
| 176 return (Before => S.D.Source (S.D.Slices (Index).Start - 1), | |
| 177 After => S.D.Source (S.D.Slices (Index).Stop + 1)); | |
| 178 end if; | |
| 179 end Separators; | |
| 180 | |
| 181 ---------------- | |
| 182 -- Separators -- | |
| 183 ---------------- | |
| 184 | |
| 185 function Separators (S : Slice_Set) return Separators_Indexes is | |
| 186 begin | |
| 187 return S.D.Indexes.all; | |
| 188 end Separators; | |
| 189 | |
| 190 --------- | |
| 191 -- Set -- | |
| 192 --------- | |
| 193 | |
| 194 procedure Set | |
| 195 (S : in out Slice_Set; | |
| 196 Separators : Element_Sequence; | |
| 197 Mode : Separator_Mode := Single) | |
| 198 is | |
| 199 begin | |
| 200 Set (S, To_Set (Separators), Mode); | |
| 201 end Set; | |
| 202 | |
| 203 --------- | |
| 204 -- Set -- | |
| 205 --------- | |
| 206 | |
| 207 procedure Set | |
| 208 (S : in out Slice_Set; | |
| 209 Separators : Element_Set; | |
| 210 Mode : Separator_Mode := Single) | |
| 211 is | |
| 212 | |
| 213 procedure Copy_On_Write (S : in out Slice_Set); | |
| 214 -- Make a copy of S if shared with another variable | |
| 215 | |
| 216 ------------------- | |
| 217 -- Copy_On_Write -- | |
| 218 ------------------- | |
| 219 | |
| 220 procedure Copy_On_Write (S : in out Slice_Set) is | |
| 221 begin | |
| 222 if S.D.Ref_Counter > 1 then | |
| 223 -- First let's remove our count from the current data | |
| 224 | |
| 225 S.D.Ref_Counter := S.D.Ref_Counter - 1; | |
| 226 | |
| 227 -- Then duplicate the data | |
| 228 | |
| 229 S.D := new Data'(S.D.all); | |
| 230 S.D.Ref_Counter := 1; | |
| 231 | |
| 232 if S.D.Source /= null then | |
| 233 S.D.Source := new Element_Sequence'(S.D.Source.all); | |
| 234 S.D.Indexes := null; | |
| 235 S.D.Slices := null; | |
| 236 end if; | |
| 237 | |
| 238 else | |
| 239 -- If there is a single reference to this variable, free it now | |
| 240 -- as it will be redefined below. | |
| 241 | |
| 242 Free (S.D.Indexes); | |
| 243 Free (S.D.Slices); | |
| 244 end if; | |
| 245 end Copy_On_Write; | |
| 246 | |
| 247 Count_Sep : constant Natural := Count (S.D.Source.all, Separators); | |
| 248 J : Positive; | |
| 249 | |
| 250 begin | |
| 251 Copy_On_Write (S); | |
| 252 | |
| 253 -- Compute all separator's indexes | |
| 254 | |
| 255 S.D.Indexes := new Separators_Indexes (1 .. Count_Sep); | |
| 256 J := S.D.Indexes'First; | |
| 257 | |
| 258 for K in S.D.Source'Range loop | |
| 259 if Is_In (S.D.Source (K), Separators) then | |
| 260 S.D.Indexes (J) := K; | |
| 261 J := J + 1; | |
| 262 end if; | |
| 263 end loop; | |
| 264 | |
| 265 -- Compute slice info for fast slice access | |
| 266 | |
| 267 declare | |
| 268 S_Info : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1); | |
| 269 K : Natural := 1; | |
| 270 Start, Stop : Natural; | |
| 271 | |
| 272 begin | |
| 273 S.D.N_Slice := 0; | |
| 274 | |
| 275 Start := S.D.Source'First; | |
| 276 Stop := 0; | |
| 277 | |
| 278 loop | |
| 279 if K > Count_Sep then | |
| 280 | |
| 281 -- No more separators, last slice ends at end of source string | |
| 282 | |
| 283 Stop := S.D.Source'Last; | |
| 284 | |
| 285 else | |
| 286 Stop := S.D.Indexes (K) - 1; | |
| 287 end if; | |
| 288 | |
| 289 -- Add slice to the table | |
| 290 | |
| 291 S.D.N_Slice := S.D.N_Slice + 1; | |
| 292 S_Info (S.D.N_Slice) := (Start, Stop); | |
| 293 | |
| 294 exit when K > Count_Sep; | |
| 295 | |
| 296 case Mode is | |
| 297 when Single => | |
| 298 | |
| 299 -- In this mode just set start to character next to the | |
| 300 -- current separator, advance the separator index. | |
| 301 | |
| 302 Start := S.D.Indexes (K) + 1; | |
| 303 K := K + 1; | |
| 304 | |
| 305 when Multiple => | |
| 306 | |
| 307 -- In this mode skip separators following each other | |
| 308 | |
| 309 loop | |
| 310 Start := S.D.Indexes (K) + 1; | |
| 311 K := K + 1; | |
| 312 exit when K > Count_Sep | |
| 313 or else S.D.Indexes (K) > S.D.Indexes (K - 1) + 1; | |
| 314 end loop; | |
| 315 end case; | |
| 316 end loop; | |
| 317 | |
| 318 S.D.Slices := new Slices_Indexes'(S_Info (1 .. S.D.N_Slice)); | |
| 319 end; | |
| 320 end Set; | |
| 321 | |
| 322 ----------- | |
| 323 -- Slice -- | |
| 324 ----------- | |
| 325 | |
| 326 function Slice | |
| 327 (S : Slice_Set; | |
| 328 Index : Slice_Number) return Element_Sequence | |
| 329 is | |
| 330 begin | |
| 331 if Index = 0 then | |
| 332 return S.D.Source.all; | |
| 333 | |
| 334 elsif Index > S.D.N_Slice then | |
| 335 raise Index_Error; | |
| 336 | |
| 337 else | |
| 338 return | |
| 339 S.D.Source (S.D.Slices (Index).Start .. S.D.Slices (Index).Stop); | |
| 340 end if; | |
| 341 end Slice; | |
| 342 | |
| 343 ----------------- | |
| 344 -- Slice_Count -- | |
| 345 ----------------- | |
| 346 | |
| 347 function Slice_Count (S : Slice_Set) return Slice_Number is | |
| 348 begin | |
| 349 return S.D.N_Slice; | |
| 350 end Slice_Count; | |
| 351 | |
| 352 end GNAT.Array_Split; |