gcc/ada/g-arrspl.adb

   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
  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 the end of the source
 242                --  string.
 243
 244                Stop := S.Source'Last;
 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;