1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                      G N A T . A R R A Y _ S P I T                       --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 2002-2003 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 2,  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.  See the GNU General Public License --
17-- for  more details.  You should have  received  a copy of the GNU General --
18-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
20-- MA 02111-1307, USA.                                                      --
21--                                                                          --
22-- As a special exception,  if other files  instantiate  generics from this --
23-- unit, or you link  this unit with other files  to produce an executable, --
24-- this  unit  does not  by itself cause  the resulting  executable  to  be --
25-- covered  by the  GNU  General  Public  License.  This exception does not --
26-- however invalidate  any other reasons why  the executable file  might be --
27-- covered by the  GNU Public License.                                      --
28--                                                                          --
29-- GNAT was originally developed  by the GNAT team at  New York University. --
30-- Extensive contributions were provided by Ada Core Technologies Inc.      --
31--                                                                          --
32------------------------------------------------------------------------------
33
34with Ada.Unchecked_Deallocation;
35
36package body GNAT.Array_Split is
37
38   procedure Free is
39      new Ada.Unchecked_Deallocation (Slices_Indexes, Slices_Access);
40
41   procedure Free is
42      new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access);
43
44   function Count
45     (Source  : Element_Sequence;
46      Pattern : Element_Set)
47      return    Natural;
48   --  Returns the number of occurences of Pattern elements in Source, 0 is
49   --  returned if no occurence 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      S.Source := new Element_Sequence'(From);
86      Set (S, Separators, Mode);
87   end Create;
88
89   -----------
90   -- Count --
91   -----------
92
93   function Count
94     (Source  : Element_Sequence;
95      Pattern : Element_Set)
96      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)
148      return  Slice_Separators
149   is
150   begin
151      if Index > S.N_Slice then
152         raise Index_Error;
153
154      elsif Index = 0
155        or else (Index = 1 and then S.N_Slice = 1)
156      then
157         --  Whole string, or no separator used.
158
159         return (Before => Array_End,
160                 After  => Array_End);
161
162      elsif Index = 1 then
163         return (Before => Array_End,
164                 After  => S.Source (S.Slices (Index).Stop + 1));
165
166      elsif Index = S.N_Slice then
167         return (Before => S.Source (S.Slices (Index).Start - 1),
168                 After  => Array_End);
169
170      else
171         return (Before => S.Source (S.Slices (Index).Start - 1),
172                 After  => S.Source (S.Slices (Index).Stop + 1));
173      end if;
174   end Separators;
175
176   ----------------
177   -- Separators --
178   ----------------
179
180   function Separators (S : Slice_Set) return Separators_Indexes is
181   begin
182      return S.Indexes.all;
183   end Separators;
184
185   ---------
186   -- Set --
187   ---------
188
189   procedure Set
190     (S          : in out Slice_Set;
191      Separators : Element_Sequence;
192      Mode       : Separator_Mode := Single)
193   is
194   begin
195      Set (S, To_Set (Separators), Mode);
196   end Set;
197
198   ---------
199   -- Set --
200   ---------
201
202   procedure Set
203     (S          : in out Slice_Set;
204      Separators : Element_Set;
205      Mode       : Separator_Mode := Single)
206   is
207      Count_Sep : constant Natural := Count (S.Source.all, Separators);
208      J : Positive;
209   begin
210      --  Free old structure
211      Free (S.Indexes);
212      Free (S.Slices);
213
214      --  Compute all separator's indexes
215
216      S.Indexes := new Separators_Indexes (1 .. Count_Sep);
217      J := S.Indexes'First;
218
219      for K in S.Source'Range loop
220         if Is_In (S.Source (K), Separators) then
221            S.Indexes (J) := K;
222            J := J + 1;
223         end if;
224      end loop;
225
226      --  Compute slice info for fast slice access
227
228      declare
229         S_Info      : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1);
230         K           : Natural := 1;
231         Start, Stop : Natural;
232
233      begin
234         S.N_Slice := 0;
235
236         Start := S.Source'First;
237         Stop  := 0;
238
239         loop
240            if K > Count_Sep then
241               --  No more separator, last slice end at the end of the source
242               --  string.
243               Stop := S.Source'Last;
244            else
245               Stop := S.Indexes (K) - 1;
246            end if;
247
248            --  Add slice to the table
249
250            S.N_Slice := S.N_Slice + 1;
251            S_Info (S.N_Slice) := (Start, Stop);
252
253            exit when K > Count_Sep;
254
255            case Mode is
256
257               when Single =>
258                  --  In this mode just set start to character next to the
259                  --  current separator, advance the separator index.
260                  Start := S.Indexes (K) + 1;
261                  K := K + 1;
262
263               when Multiple =>
264                  --  In this mode skip separators following each others
265                  loop
266                     Start := S.Indexes (K) + 1;
267                     K := K + 1;
268                     exit when K > Count_Sep
269                       or else S.Indexes (K) > S.Indexes (K - 1) + 1;
270                  end loop;
271
272            end case;
273         end loop;
274
275         S.Slices := new Slices_Indexes'(S_Info (1 .. S.N_Slice));
276      end;
277   end Set;
278
279   -----------
280   -- Slice --
281   -----------
282
283   function Slice
284     (S     : Slice_Set;
285      Index : Slice_Number)
286      return Element_Sequence
287   is
288   begin
289      if Index = 0 then
290         return S.Source.all;
291
292      elsif Index > S.N_Slice then
293         raise Index_Error;
294
295      else
296         return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop);
297      end if;
298   end Slice;
299
300   -----------------
301   -- Slice_Count --
302   -----------------
303
304   function Slice_Count (S : Slice_Set) return Slice_Number is
305   begin
306      return S.N_Slice;
307   end Slice_Count;
308
309end GNAT.Array_Split;
310