gcc/ada/g-arrspl.adb

   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
  34 with Ada.Unchecked_Deallocation;
  35
  36 package 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
 309 end GNAT.Array_Split;