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-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 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 procedure Free is 43 new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access); 44 45 function Count 46 (Source : Element_Sequence; 47 Pattern : Element_Set) return Natural; 48 -- Returns the number of occurrences of Pattern elements in Source, 0 is 49 -- returned if no occurrence is found in Source. 50 51 ------------ 52 -- Adjust -- 53 ------------ 54 55 procedure Adjust (S : in out Slice_Set) is 56 begin 57 S.Ref_Counter.all := S.Ref_Counter.all + 1; 58 end Adjust; 59 60 ------------ 61 -- Create -- 62 ------------ 63 64 procedure Create 65 (S : out Slice_Set; 66 From : Element_Sequence; 67 Separators : Element_Sequence; 68 Mode : Separator_Mode := Single) 69 is 70 begin 71 Create (S, From, To_Set (Separators), Mode); 72 end Create; 73 74 ------------ 75 -- Create -- 76 ------------ 77 78 procedure Create 79 (S : out Slice_Set; 80 From : Element_Sequence; 81 Separators : Element_Set; 82 Mode : Separator_Mode := Single) 83 is 84 begin 85 Free (S.Source); 86 S.Source := new Element_Sequence'(From); 87 Set (S, Separators, Mode); 88 end Create; 89 90 ----------- 91 -- Count -- 92 ----------- 93 94 function Count 95 (Source : Element_Sequence; 96 Pattern : Element_Set) return Natural 97 is 98 C : Natural := 0; 99 begin 100 for K in Source'Range loop 101 if Is_In (Source (K), Pattern) then 102 C := C + 1; 103 end if; 104 end loop; 105 106 return C; 107 end Count; 108 109 -------------- 110 -- Finalize -- 111 -------------- 112 113 procedure Finalize (S : in out Slice_Set) is 114 115 procedure Free is 116 new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access); 117 118 procedure Free is 119 new Ada.Unchecked_Deallocation (Natural, Counter); 120 121 begin 122 S.Ref_Counter.all := S.Ref_Counter.all - 1; 123 124 if S.Ref_Counter.all = 0 then 125 Free (S.Source); 126 Free (S.Indexes); 127 Free (S.Slices); 128 Free (S.Ref_Counter); 129 end if; 130 end Finalize; 131 132 ---------------- 133 -- Initialize -- 134 ---------------- 135 136 procedure Initialize (S : in out Slice_Set) is 137 begin 138 S.Ref_Counter := new Natural'(1); 139 end Initialize; 140 141 ---------------- 142 -- Separators -- 143 ---------------- 144 145 function Separators 146 (S : Slice_Set; 147 Index : Slice_Number) return Slice_Separators 148 is 149 begin 150 if Index > S.N_Slice then 151 raise Index_Error; 152 153 elsif Index = 0 154 or else (Index = 1 and then S.N_Slice = 1) 155 then 156 -- Whole string, or no separator used 157 158 return (Before => Array_End, 159 After => Array_End); 160 161 elsif Index = 1 then 162 return (Before => Array_End, 163 After => S.Source (S.Slices (Index).Stop + 1)); 164 165 elsif Index = S.N_Slice then 166 return (Before => S.Source (S.Slices (Index).Start - 1), 167 After => Array_End); 168 169 else 170 return (Before => S.Source (S.Slices (Index).Start - 1), 171 After => S.Source (S.Slices (Index).Stop + 1)); 172 end if; 173 end Separators; 174 175 ---------------- 176 -- Separators -- 177 ---------------- 178 179 function Separators (S : Slice_Set) return Separators_Indexes is 180 begin 181 return S.Indexes.all; 182 end Separators; 183 184 --------- 185 -- Set -- 186 --------- 187 188 procedure Set 189 (S : in out Slice_Set; 190 Separators : Element_Sequence; 191 Mode : Separator_Mode := Single) 192 is 193 begin 194 Set (S, To_Set (Separators), Mode); 195 end Set; 196 197 --------- 198 -- Set -- 199 --------- 200 201 procedure Set 202 (S : in out Slice_Set; 203 Separators : Element_Set; 204 Mode : Separator_Mode := Single) 205 is 206 Count_Sep : constant Natural := Count (S.Source.all, Separators); 207 J : Positive; 208 begin 209 -- Free old structure 210 Free (S.Indexes); 211 Free (S.Slices); 212 213 -- Compute all separator's indexes 214 215 S.Indexes := new Separators_Indexes (1 .. Count_Sep); 216 J := S.Indexes'First; 217 218 for K in S.Source'Range loop 219 if Is_In (S.Source (K), Separators) then 220 S.Indexes (J) := K; 221 J := J + 1; 222 end if; 223 end loop; 224 225 -- Compute slice info for fast slice access 226 227 declare 228 S_Info : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1); 229 K : Natural := 1; 230 Start, Stop : Natural; 231 232 begin 233 S.N_Slice := 0; 234 235 Start := S.Source'First; 236 Stop := 0; 237 238 loop 239 if K > Count_Sep then 240 241 -- No more separators, last slice ends at end of source string 242 243 Stop := S.Source'Last; 244 245 else 246 Stop := S.Indexes (K) - 1; 247 end if; 248 249 -- Add slice to the table 250 251 S.N_Slice := S.N_Slice + 1; 252 S_Info (S.N_Slice) := (Start, Stop); 253 254 exit when K > Count_Sep; 255 256 case Mode is 257 258 when Single => 259 260 -- In this mode just set start to character next to the 261 -- current separator, advance the separator index. 262 263 Start := S.Indexes (K) + 1; 264 K := K + 1; 265 266 when Multiple => 267 268 -- In this mode skip separators following each other 269 270 loop 271 Start := S.Indexes (K) + 1; 272 K := K + 1; 273 exit when K > Count_Sep 274 or else S.Indexes (K) > S.Indexes (K - 1) + 1; 275 end loop; 276 277 end case; 278 end loop; 279 280 S.Slices := new Slices_Indexes'(S_Info (1 .. S.N_Slice)); 281 end; 282 end Set; 283 284 ----------- 285 -- Slice -- 286 ----------- 287 288 function Slice 289 (S : Slice_Set; 290 Index : Slice_Number) return Element_Sequence 291 is 292 begin 293 if Index = 0 then 294 return S.Source.all; 295 296 elsif Index > S.N_Slice then 297 raise Index_Error; 298 299 else 300 return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop); 301 end if; 302 end Slice; 303 304 ----------------- 305 -- Slice_Count -- 306 ----------------- 307 308 function Slice_Count (S : Slice_Set) return Slice_Number is 309 begin 310 return S.N_Slice; 311 end Slice_Count; 312 313end GNAT.Array_Split; 314