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; |