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-2013, 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       Ref_Counter : Counter := S.Ref_Counter;
 122
 123    begin
 124       --  Ensure call is idempotent
 125
 126       S.Ref_Counter := null;
 127
 128       if Ref_Counter /= null then
 129          Ref_Counter.all := Ref_Counter.all - 1;
 130
 131          if Ref_Counter.all = 0 then
 132             Free (S.Source);
 133             Free (S.Indexes);
 134             Free (S.Slices);
 135             Free (Ref_Counter);
 136          end if;
 137       end if;
 138    end Finalize;
 139
 140    ----------------
 141    -- Initialize --
 142    ----------------
 143
 144    procedure Initialize (S : in out Slice_Set) is
 145    begin
 146       S.Ref_Counter := new Natural'(1);
 147    end Initialize;
 148
 149    ----------------
 150    -- Separators --
 151    ----------------
 152
 153    function Separators
 154      (S     : Slice_Set;
 155       Index : Slice_Number) return Slice_Separators
 156    is
 157    begin
 158       if Index > S.N_Slice then
 159          raise Index_Error;
 160
 161       elsif Index = 0
 162         or else (Index = 1 and then S.N_Slice = 1)
 163       then
 164          --  Whole string, or no separator used
 165
 166          return (Before => Array_End,
 167                  After  => Array_End);
 168
 169       elsif Index = 1 then
 170          return (Before => Array_End,
 171                  After  => S.Source (S.Slices (Index).Stop + 1));
 172
 173       elsif Index = S.N_Slice then
 174          return (Before => S.Source (S.Slices (Index).Start - 1),
 175                  After  => Array_End);
 176
 177       else
 178          return (Before => S.Source (S.Slices (Index).Start - 1),
 179                  After  => S.Source (S.Slices (Index).Stop + 1));
 180       end if;
 181    end Separators;
 182
 183    ----------------
 184    -- Separators --
 185    ----------------
 186
 187    function Separators (S : Slice_Set) return Separators_Indexes is
 188    begin
 189       return S.Indexes.all;
 190    end Separators;
 191
 192    ---------
 193    -- Set --
 194    ---------
 195
 196    procedure Set
 197      (S          : in out Slice_Set;
 198       Separators : Element_Sequence;
 199       Mode       : Separator_Mode := Single)
 200    is
 201    begin
 202       Set (S, To_Set (Separators), Mode);
 203    end Set;
 204
 205    ---------
 206    -- Set --
 207    ---------
 208
 209    procedure Set
 210      (S          : in out Slice_Set;
 211       Separators : Element_Set;
 212       Mode       : Separator_Mode := Single)
 213    is
 214       Count_Sep : constant Natural := Count (S.Source.all, Separators);
 215       J : Positive;
 216    begin
 217       --  Free old structure
 218       Free (S.Indexes);
 219       Free (S.Slices);
 220
 221       --  Compute all separator's indexes
 222
 223       S.Indexes := new Separators_Indexes (1 .. Count_Sep);
 224       J := S.Indexes'First;
 225
 226       for K in S.Source'Range loop
 227          if Is_In (S.Source (K), Separators) then
 228             S.Indexes (J) := K;
 229             J := J + 1;
 230          end if;
 231       end loop;
 232
 233       --  Compute slice info for fast slice access
 234
 235       declare
 236          S_Info      : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1);
 237          K           : Natural := 1;
 238          Start, Stop : Natural;
 239
 240       begin
 241          S.N_Slice := 0;
 242
 243          Start := S.Source'First;
 244          Stop  := 0;
 245
 246          loop
 247             if K > Count_Sep then
 248
 249                --  No more separators, last slice ends at end of source string
 250
 251                Stop := S.Source'Last;
 252
 253             else
 254                Stop := S.Indexes (K) - 1;
 255             end if;
 256
 257             --  Add slice to the table
 258
 259             S.N_Slice := S.N_Slice + 1;
 260             S_Info (S.N_Slice) := (Start, Stop);
 261
 262             exit when K > Count_Sep;
 263
 264             case Mode is
 265
 266                when Single =>
 267
 268                   --  In this mode just set start to character next to the
 269                   --  current separator, advance the separator index.
 270
 271                   Start := S.Indexes (K) + 1;
 272                   K := K + 1;
 273
 274                when Multiple =>
 275
 276                   --  In this mode skip separators following each other
 277
 278                   loop
 279                      Start := S.Indexes (K) + 1;
 280                      K := K + 1;
 281                      exit when K > Count_Sep
 282                        or else S.Indexes (K) > S.Indexes (K - 1) + 1;
 283                   end loop;
 284
 285             end case;
 286          end loop;
 287
 288          S.Slices := new Slices_Indexes'(S_Info (1 .. S.N_Slice));
 289       end;
 290    end Set;
 291
 292    -----------
 293    -- Slice --
 294    -----------
 295
 296    function Slice
 297      (S     : Slice_Set;
 298       Index : Slice_Number) return Element_Sequence
 299    is
 300    begin
 301       if Index = 0 then
 302          return S.Source.all;
 303
 304       elsif Index > S.N_Slice then
 305          raise Index_Error;
 306
 307       else
 308          return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop);
 309       end if;
 310    end Slice;
 311
 312    -----------------
 313    -- Slice_Count --
 314    -----------------
 315
 316    function Slice_Count (S : Slice_Set) return Slice_Number is
 317    begin
 318       return S.N_Slice;
 319    end Slice_Count;
 320
 321 end GNAT.Array_Split;