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-2013, 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
298               when Single =>
299
300                  --  In this mode just set start to character next to the
301                  --  current separator, advance the separator index.
302
303                  Start := S.D.Indexes (K) + 1;
304                  K := K + 1;
305
306               when Multiple =>
307
308                  --  In this mode skip separators following each other
309
310                  loop
311                     Start := S.D.Indexes (K) + 1;
312                     K := K + 1;
313                     exit when K > Count_Sep
314                       or else S.D.Indexes (K) > S.D.Indexes (K - 1) + 1;
315                  end loop;
316
317            end case;
318         end loop;
319
320         S.D.Slices := new Slices_Indexes'(S_Info (1 .. S.D.N_Slice));
321      end;
322   end Set;
323
324   -----------
325   -- Slice --
326   -----------
327
328   function Slice
329     (S     : Slice_Set;
330      Index : Slice_Number) return Element_Sequence
331   is
332   begin
333      if Index = 0 then
334         return S.D.Source.all;
335
336      elsif Index > S.D.N_Slice then
337         raise Index_Error;
338
339      else
340         return
341           S.D.Source (S.D.Slices (Index).Start .. S.D.Slices (Index).Stop);
342      end if;
343   end Slice;
344
345   -----------------
346   -- Slice_Count --
347   -----------------
348
349   function Slice_Count (S : Slice_Set) return Slice_Number is
350   begin
351      return S.D.N_Slice;
352   end Slice_Count;
353
354end GNAT.Array_Split;
355