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-2006, 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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    procedure Free is
  45       new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
  46
  47    function Count
  48      (Source  : Element_Sequence;
  49       Pattern : Element_Set) return Natural;
  50    --  Returns the number of occurences of Pattern elements in Source, 0 is
  51    --  returned if no occurence is found in Source.
  52
  53    ------------
  54    -- Adjust --
  55    ------------
  56
  57    procedure Adjust (S : in out Slice_Set) is
  58    begin
  59       S.Ref_Counter.all := S.Ref_Counter.all + 1;
  60    end Adjust;
  61
  62    ------------
  63    -- Create --
  64    ------------
  65
  66    procedure Create
  67      (S          : out Slice_Set;
  68       From       : Element_Sequence;
  69       Separators : Element_Sequence;
  70       Mode       : Separator_Mode := Single)
  71    is
  72    begin
  73       Create (S, From, To_Set (Separators), Mode);
  74    end Create;
  75
  76    ------------
  77    -- Create --
  78    ------------
  79
  80    procedure Create
  81      (S          : out Slice_Set;
  82       From       : Element_Sequence;
  83       Separators : Element_Set;
  84       Mode       : Separator_Mode := Single)
  85    is
  86    begin
  87       Free (S.Source);
  88       S.Source := new Element_Sequence'(From);
  89       Set (S, Separators, Mode);
  90    end Create;
  91
  92    -----------
  93    -- Count --
  94    -----------
  95
  96    function Count
  97      (Source  : Element_Sequence;
  98       Pattern : Element_Set) return Natural
  99    is
 100       C : Natural := 0;
 101    begin
 102       for K in Source'Range loop
 103          if Is_In (Source (K), Pattern) then
 104             C := C + 1;
 105          end if;
 106       end loop;
 107
 108       return C;
 109    end Count;
 110
 111    --------------
 112    -- Finalize --
 113    --------------
 114
 115    procedure Finalize (S : in out Slice_Set) is
 116
 117       procedure Free is
 118          new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
 119
 120       procedure Free is
 121          new Ada.Unchecked_Deallocation (Natural, Counter);
 122
 123    begin
 124       S.Ref_Counter.all := S.Ref_Counter.all - 1;
 125
 126       if S.Ref_Counter.all = 0 then
 127          Free (S.Source);
 128          Free (S.Indexes);
 129          Free (S.Slices);
 130          Free (S.Ref_Counter);
 131       end if;
 132    end Finalize;
 133
 134    ----------------
 135    -- Initialize --
 136    ----------------
 137
 138    procedure Initialize (S : in out Slice_Set) is
 139    begin
 140       S.Ref_Counter := new Natural'(1);
 141    end Initialize;
 142
 143    ----------------
 144    -- Separators --
 145    ----------------
 146
 147    function Separators
 148      (S     : Slice_Set;
 149       Index : Slice_Number) return Slice_Separators
 150    is
 151    begin
 152       if Index > S.N_Slice then
 153          raise Index_Error;
 154
 155       elsif Index = 0
 156         or else (Index = 1 and then S.N_Slice = 1)
 157       then
 158          --  Whole string, or no separator used
 159
 160          return (Before => Array_End,
 161                  After  => Array_End);
 162
 163       elsif Index = 1 then
 164          return (Before => Array_End,
 165                  After  => S.Source (S.Slices (Index).Stop + 1));
 166
 167       elsif Index = S.N_Slice then
 168          return (Before => S.Source (S.Slices (Index).Start - 1),
 169                  After  => Array_End);
 170
 171       else
 172          return (Before => S.Source (S.Slices (Index).Start - 1),
 173                  After  => S.Source (S.Slices (Index).Stop + 1));
 174       end if;
 175    end Separators;
 176
 177    ----------------
 178    -- Separators --
 179    ----------------
 180
 181    function Separators (S : Slice_Set) return Separators_Indexes is
 182    begin
 183       return S.Indexes.all;
 184    end Separators;
 185
 186    ---------
 187    -- Set --
 188    ---------
 189
 190    procedure Set
 191      (S          : in out Slice_Set;
 192       Separators : Element_Sequence;
 193       Mode       : Separator_Mode := Single)
 194    is
 195    begin
 196       Set (S, To_Set (Separators), Mode);
 197    end Set;
 198
 199    ---------
 200    -- Set --
 201    ---------
 202
 203    procedure Set
 204      (S          : in out Slice_Set;
 205       Separators : Element_Set;
 206       Mode       : Separator_Mode := Single)
 207    is
 208       Count_Sep : constant Natural := Count (S.Source.all, Separators);
 209       J : Positive;
 210    begin
 211       --  Free old structure
 212       Free (S.Indexes);
 213       Free (S.Slices);
 214
 215       --  Compute all separator's indexes
 216
 217       S.Indexes := new Separators_Indexes (1 .. Count_Sep);
 218       J := S.Indexes'First;
 219
 220       for K in S.Source'Range loop
 221          if Is_In (S.Source (K), Separators) then
 222             S.Indexes (J) := K;
 223             J := J + 1;
 224          end if;
 225       end loop;
 226
 227       --  Compute slice info for fast slice access
 228
 229       declare
 230          S_Info      : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1);
 231          K           : Natural := 1;
 232          Start, Stop : Natural;
 233
 234       begin
 235          S.N_Slice := 0;
 236
 237          Start := S.Source'First;
 238          Stop  := 0;
 239
 240          loop
 241             if K > Count_Sep then
 242
 243                --  No more separators, last slice ends at the end of the source
 244                --  string.
 245
 246                Stop := S.Source'Last;
 247             else
 248                Stop := S.Indexes (K) - 1;
 249             end if;
 250
 251             --  Add slice to the table
 252
 253             S.N_Slice := S.N_Slice + 1;
 254             S_Info (S.N_Slice) := (Start, Stop);
 255
 256             exit when K > Count_Sep;
 257
 258             case Mode is
 259
 260                when Single =>
 261
 262                   --  In this mode just set start to character next to the
 263                   --  current separator, advance the separator index.
 264
 265                   Start := S.Indexes (K) + 1;
 266                   K := K + 1;
 267
 268                when Multiple =>
 269
 270                   --  In this mode skip separators following each other
 271
 272                   loop
 273                      Start := S.Indexes (K) + 1;
 274                      K := K + 1;
 275                      exit when K > Count_Sep
 276                        or else S.Indexes (K) > S.Indexes (K - 1) + 1;
 277                   end loop;
 278
 279             end case;
 280          end loop;
 281
 282          S.Slices := new Slices_Indexes'(S_Info (1 .. S.N_Slice));
 283       end;
 284    end Set;
 285
 286    -----------
 287    -- Slice --
 288    -----------
 289
 290    function Slice
 291      (S     : Slice_Set;
 292       Index : Slice_Number) return Element_Sequence
 293    is
 294    begin
 295       if Index = 0 then
 296          return S.Source.all;
 297
 298       elsif Index > S.N_Slice then
 299          raise Index_Error;
 300
 301       else
 302          return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop);
 303       end if;
 304    end Slice;
 305
 306    -----------------
 307    -- Slice_Count --
 308    -----------------
 309
 310    function Slice_Count (S : Slice_Set) return Slice_Number is
 311    begin
 312       return S.N_Slice;
 313    end Slice_Count;
 314
 315 end GNAT.Array_Split;