URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-arrspl.adb] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                     G N A T . A R R A Y _ S P L I T                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2002-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Ada.Unchecked_Deallocation;
 
package body GNAT.Array_Split is
 
   procedure Free is
      new Ada.Unchecked_Deallocation (Slices_Indexes, Slices_Access);
 
   procedure Free is
      new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access);
 
   procedure Free is
      new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
 
   function Count
     (Source  : Element_Sequence;
      Pattern : Element_Set) return Natural;
   --  Returns the number of occurrences of Pattern elements in Source, 0 is
   --  returned if no occurrence is found in Source.
 
   ------------
   -- Adjust --
   ------------
 
   procedure Adjust (S : in out Slice_Set) is
   begin
      S.Ref_Counter.all := S.Ref_Counter.all + 1;
   end Adjust;
 
   ------------
   -- Create --
   ------------
 
   procedure Create
     (S          : out Slice_Set;
      From       : Element_Sequence;
      Separators : Element_Sequence;
      Mode       : Separator_Mode := Single)
   is
   begin
      Create (S, From, To_Set (Separators), Mode);
   end Create;
 
   ------------
   -- Create --
   ------------
 
   procedure Create
     (S          : out Slice_Set;
      From       : Element_Sequence;
      Separators : Element_Set;
      Mode       : Separator_Mode := Single)
   is
   begin
      Free (S.Source);
      S.Source := new Element_Sequence'(From);
      Set (S, Separators, Mode);
   end Create;
 
   -----------
   -- Count --
   -----------
 
   function Count
     (Source  : Element_Sequence;
      Pattern : Element_Set) return Natural
   is
      C : Natural := 0;
   begin
      for K in Source'Range loop
         if Is_In (Source (K), Pattern) then
            C := C + 1;
         end if;
      end loop;
 
      return C;
   end Count;
 
   --------------
   -- Finalize --
   --------------
 
   procedure Finalize (S : in out Slice_Set) is
 
      procedure Free is
         new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
 
      procedure Free is
         new Ada.Unchecked_Deallocation (Natural, Counter);
 
   begin
      S.Ref_Counter.all := S.Ref_Counter.all - 1;
 
      if S.Ref_Counter.all = 0 then
         Free (S.Source);
         Free (S.Indexes);
         Free (S.Slices);
         Free (S.Ref_Counter);
      end if;
   end Finalize;
 
   ----------------
   -- Initialize --
   ----------------
 
   procedure Initialize (S : in out Slice_Set) is
   begin
      S.Ref_Counter := new Natural'(1);
   end Initialize;
 
   ----------------
   -- Separators --
   ----------------
 
   function Separators
     (S     : Slice_Set;
      Index : Slice_Number) return Slice_Separators
   is
   begin
      if Index > S.N_Slice then
         raise Index_Error;
 
      elsif Index = 0
        or else (Index = 1 and then S.N_Slice = 1)
      then
         --  Whole string, or no separator used
 
         return (Before => Array_End,
                 After  => Array_End);
 
      elsif Index = 1 then
         return (Before => Array_End,
                 After  => S.Source (S.Slices (Index).Stop + 1));
 
      elsif Index = S.N_Slice then
         return (Before => S.Source (S.Slices (Index).Start - 1),
                 After  => Array_End);
 
      else
         return (Before => S.Source (S.Slices (Index).Start - 1),
                 After  => S.Source (S.Slices (Index).Stop + 1));
      end if;
   end Separators;
 
   ----------------
   -- Separators --
   ----------------
 
   function Separators (S : Slice_Set) return Separators_Indexes is
   begin
      return S.Indexes.all;
   end Separators;
 
   ---------
   -- Set --
   ---------
 
   procedure Set
     (S          : in out Slice_Set;
      Separators : Element_Sequence;
      Mode       : Separator_Mode := Single)
   is
   begin
      Set (S, To_Set (Separators), Mode);
   end Set;
 
   ---------
   -- Set --
   ---------
 
   procedure Set
     (S          : in out Slice_Set;
      Separators : Element_Set;
      Mode       : Separator_Mode := Single)
   is
      Count_Sep : constant Natural := Count (S.Source.all, Separators);
      J : Positive;
   begin
      --  Free old structure
      Free (S.Indexes);
      Free (S.Slices);
 
      --  Compute all separator's indexes
 
      S.Indexes := new Separators_Indexes (1 .. Count_Sep);
      J := S.Indexes'First;
 
      for K in S.Source'Range loop
         if Is_In (S.Source (K), Separators) then
            S.Indexes (J) := K;
            J := J + 1;
         end if;
      end loop;
 
      --  Compute slice info for fast slice access
 
      declare
         S_Info      : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1);
         K           : Natural := 1;
         Start, Stop : Natural;
 
      begin
         S.N_Slice := 0;
 
         Start := S.Source'First;
         Stop  := 0;
 
         loop
            if K > Count_Sep then
 
               --  No more separators, last slice ends at end of source string
 
               Stop := S.Source'Last;
 
            else
               Stop := S.Indexes (K) - 1;
            end if;
 
            --  Add slice to the table
 
            S.N_Slice := S.N_Slice + 1;
            S_Info (S.N_Slice) := (Start, Stop);
 
            exit when K > Count_Sep;
 
            case Mode is
 
               when Single =>
 
                  --  In this mode just set start to character next to the
                  --  current separator, advance the separator index.
 
                  Start := S.Indexes (K) + 1;
                  K := K + 1;
 
               when Multiple =>
 
                  --  In this mode skip separators following each other
 
                  loop
                     Start := S.Indexes (K) + 1;
                     K := K + 1;
                     exit when K > Count_Sep
                       or else S.Indexes (K) > S.Indexes (K - 1) + 1;
                  end loop;
 
            end case;
         end loop;
 
         S.Slices := new Slices_Indexes'(S_Info (1 .. S.N_Slice));
      end;
   end Set;
 
   -----------
   -- Slice --
   -----------
 
   function Slice
     (S     : Slice_Set;
      Index : Slice_Number) return Element_Sequence
   is
   begin
      if Index = 0 then
         return S.Source.all;
 
      elsif Index > S.N_Slice then
         raise Index_Error;
 
      else
         return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop);
      end if;
   end Slice;
 
   -----------------
   -- Slice_Count --
   -----------------
 
   function Slice_Count (S : Slice_Set) return Slice_Number is
   begin
      return S.N_Slice;
   end Slice_Count;
 
end GNAT.Array_Split;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-arrspl.adb] - Blame information for rev 801

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
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
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			`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
313			`end GNAT.Array_Split;`