|
111
|
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 -- --
|
|
131
|
9 -- Copyright (C) 2002-2018, Free Software Foundation, Inc. --
|
|
111
|
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;
|
