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-2020, 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   overriding 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   function Create
72     (From       : Element_Sequence;
73      Separators : Element_Sequence;
74      Mode       : Separator_Mode := Single) return Slice_Set is
75   begin
76      return Ret : Slice_Set do
77         Create (Ret, From, Separators, Mode);
78      end return;
79   end Create;
80
81   ------------
82   -- Create --
83   ------------
84
85   procedure Create
86     (S          : out Slice_Set;
87      From       : Element_Sequence;
88      Separators : Element_Set;
89      Mode       : Separator_Mode := Single)
90   is
91      Result : Slice_Set;
92   begin
93      Result.D.Source := new Element_Sequence'(From);
94      Set (Result, Separators, Mode);
95      S := Result;
96   end Create;
97
98   function Create
99     (From       : Element_Sequence;
100      Separators : Element_Set;
101      Mode       : Separator_Mode := Single) return Slice_Set is
102   begin
103      return Ret : Slice_Set do
104         Create (Ret, From, Separators, Mode);
105      end return;
106   end Create;
107
108   -----------
109   -- Count --
110   -----------
111
112   function Count
113     (Source  : Element_Sequence;
114      Pattern : Element_Set) return Natural
115   is
116      C : Natural := 0;
117   begin
118      for K in Source'Range loop
119         if Is_In (Source (K), Pattern) then
120            C := C + 1;
121         end if;
122      end loop;
123
124      return C;
125   end Count;
126
127   --------------
128   -- Finalize --
129   --------------
130
131   overriding procedure Finalize (S : in out Slice_Set) is
132
133      procedure Free is
134         new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
135
136      procedure Free is
137         new Ada.Unchecked_Deallocation (Data, Data_Access);
138
139      D : Data_Access := S.D;
140
141   begin
142      --  Ensure call is idempotent
143
144      S.D := null;
145
146      if D /= null then
147         D.Ref_Counter := D.Ref_Counter - 1;
148
149         if D.Ref_Counter = 0 then
150            Free (D.Source);
151            Free (D.Indexes);
152            Free (D.Slices);
153            Free (D);
154         end if;
155      end if;
156   end Finalize;
157
158   ----------------
159   -- Initialize --
160   ----------------
161
162   overriding procedure Initialize (S : in out Slice_Set) is
163   begin
164      S.D := new Data'(1, null, 0, null, null);
165   end Initialize;
166
167   ----------------
168   -- Separators --
169   ----------------
170
171   function Separators
172     (S     : Slice_Set;
173      Index : Slice_Number) return Slice_Separators
174   is
175   begin
176      if Index > S.D.N_Slice then
177         raise Index_Error;
178
179      elsif Index = 0
180        or else (Index = 1 and then S.D.N_Slice = 1)
181      then
182         --  Whole string, or no separator used
183
184         return (Before => Array_End,
185                 After  => Array_End);
186
187      elsif Index = 1 then
188         return (Before => Array_End,
189                 After  => S.D.Source (S.D.Slices (Index).Stop + 1));
190
191      elsif Index = S.D.N_Slice then
192         return (Before => S.D.Source (S.D.Slices (Index).Start - 1),
193                 After  => Array_End);
194
195      else
196         return (Before => S.D.Source (S.D.Slices (Index).Start - 1),
197                 After  => S.D.Source (S.D.Slices (Index).Stop + 1));
198      end if;
199   end Separators;
200
201   ----------------
202   -- Separators --
203   ----------------
204
205   function Separators (S : Slice_Set) return Separators_Indexes is
206   begin
207      return S.D.Indexes.all;
208   end Separators;
209
210   ---------
211   -- Set --
212   ---------
213
214   procedure Set
215     (S          : in out Slice_Set;
216      Separators : Element_Sequence;
217      Mode       : Separator_Mode := Single)
218   is
219   begin
220      Set (S, To_Set (Separators), Mode);
221   end Set;
222
223   ---------
224   -- Set --
225   ---------
226
227   procedure Set
228     (S          : in out Slice_Set;
229      Separators : Element_Set;
230      Mode       : Separator_Mode := Single)
231   is
232
233      procedure Copy_On_Write (S : in out Slice_Set);
234      --  Make a copy of S if shared with another variable
235
236      -------------------
237      -- Copy_On_Write --
238      -------------------
239
240      procedure Copy_On_Write (S : in out Slice_Set) is
241      begin
242         if S.D.Ref_Counter > 1 then
243            --  First let's remove our count from the current data
244
245            S.D.Ref_Counter := S.D.Ref_Counter - 1;
246
247            --  Then duplicate the data
248
249            S.D := new Data'(S.D.all);
250            S.D.Ref_Counter := 1;
251
252            if S.D.Source /= null then
253               S.D.Source := new Element_Sequence'(S.D.Source.all);
254               S.D.Indexes := null;
255               S.D.Slices := null;
256            end if;
257
258         else
259            --  If there is a single reference to this variable, free it now
260            --  as it will be redefined below.
261
262            Free (S.D.Indexes);
263            Free (S.D.Slices);
264         end if;
265      end Copy_On_Write;
266
267      Count_Sep : constant Natural := Count (S.D.Source.all, Separators);
268      J         : Positive;
269
270   begin
271      Copy_On_Write (S);
272
273      --  Compute all separator's indexes
274
275      S.D.Indexes := new Separators_Indexes (1 .. Count_Sep);
276      J := S.D.Indexes'First;
277
278      for K in S.D.Source'Range loop
279         if Is_In (S.D.Source (K), Separators) then
280            S.D.Indexes (J) := K;
281            J := J + 1;
282         end if;
283      end loop;
284
285      --  Compute slice info for fast slice access
286
287      declare
288         S_Info      : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1);
289         K           : Natural := 1;
290         Start, Stop : Natural;
291
292      begin
293         S.D.N_Slice := 0;
294
295         Start := S.D.Source'First;
296         Stop  := 0;
297
298         loop
299            if K > Count_Sep then
300
301               --  No more separators, last slice ends at end of source string
302
303               Stop := S.D.Source'Last;
304
305            else
306               Stop := S.D.Indexes (K) - 1;
307            end if;
308
309            --  Add slice to the table
310
311            S.D.N_Slice := S.D.N_Slice + 1;
312            S_Info (S.D.N_Slice) := (Start, Stop);
313
314            exit when K > Count_Sep;
315
316            case Mode is
317               when Single =>
318
319                  --  In this mode just set start to character next to the
320                  --  current separator, advance the separator index.
321
322                  Start := S.D.Indexes (K) + 1;
323                  K := K + 1;
324
325               when Multiple =>
326
327                  --  In this mode skip separators following each other
328
329                  loop
330                     Start := S.D.Indexes (K) + 1;
331                     K := K + 1;
332                     exit when K > Count_Sep
333                       or else S.D.Indexes (K) > S.D.Indexes (K - 1) + 1;
334                  end loop;
335            end case;
336         end loop;
337
338         S.D.Slices := new Slices_Indexes'(S_Info (1 .. S.D.N_Slice));
339      end;
340   end Set;
341
342   -----------
343   -- Slice --
344   -----------
345
346   function Slice
347     (S     : Slice_Set;
348      Index : Slice_Number) return Element_Sequence
349   is
350   begin
351      if Index = 0 then
352         return S.D.Source.all;
353
354      elsif Index > S.D.N_Slice then
355         raise Index_Error;
356
357      else
358         return
359           S.D.Source (S.D.Slices (Index).Start .. S.D.Slices (Index).Stop);
360      end if;
361   end Slice;
362
363   -----------------
364   -- Slice_Count --
365   -----------------
366
367   function Slice_Count (S : Slice_Set) return Slice_Number is
368   begin
369      return S.D.N_Slice;
370   end Slice_Count;
371
372end GNAT.Array_Split;
373