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-2019, 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 32with Ada.Unchecked_Deallocation; 33 34package 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 352end GNAT.Array_Split; 353