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