gcc/ada/libgnat/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-2024, 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    function Count
  43      (Source  : Element_Sequence;
  44       Pattern : Element_Set) return Natural;
  45    --  Returns the number of occurrences of Pattern elements in Source, 0 is
  46    --  returned if no occurrence is found in Source.
  47
  48    ------------
  49    -- Adjust --
  50    ------------
  51
  52    overriding procedure Adjust (S : in out Slice_Set) is
  53    begin
  54       S.D.Ref_Counter := S.D.Ref_Counter + 1;
  55    end Adjust;
  56
  57    ------------
  58    -- Create --
  59    ------------
  60
  61    procedure Create
  62      (S          : out Slice_Set;
  63       From       : Element_Sequence;
  64       Separators : Element_Sequence;
  65       Mode       : Separator_Mode := Single)
  66    is
  67    begin
  68       Create (S, From, To_Set (Separators), Mode);
  69    end Create;
  70
  71    function Create
  72      (From       : Element_Sequence;
  73       Separators : Element_Sequence;
  74       Mode       : Separator_Mode := Single) return Slice_Set is
  75    begin
  76       return Ret : Slice_Set do
  77          Create (Ret, From, Separators, Mode);
  78       end return;
  79    end Create;
  80
  81    ------------
  82    -- Create --
  83    ------------
  84
  85    procedure Create
  86      (S          : out Slice_Set;
  87       From       : Element_Sequence;
  88       Separators : Element_Set;
  89       Mode       : Separator_Mode := Single)
  90    is
  91       Result : Slice_Set;
  92    begin
  93       Result.D.Source := new Element_Sequence'(From);
  94       Set (Result, Separators, Mode);
  95       S := Result;
  96    end Create;
  97
  98    function Create
  99      (From       : Element_Sequence;
 100       Separators : Element_Set;
 101       Mode       : Separator_Mode := Single) return Slice_Set is
 102    begin
 103       return Ret : Slice_Set do
 104          Create (Ret, From, Separators, Mode);
 105       end return;
 106    end Create;
 107
 108    -----------
 109    -- Count --
 110    -----------
 111
 112    function Count
 113      (Source  : Element_Sequence;
 114       Pattern : Element_Set) return Natural
 115    is
 116       C : Natural := 0;
 117    begin
 118       for K in Source'Range loop
 119          if Is_In (Source (K), Pattern) then
 120             C := C + 1;
 121          end if;
 122       end loop;
 123
 124       return C;
 125    end Count;
 126
 127    --------------
 128    -- Finalize --
 129    --------------
 130
 131    overriding procedure Finalize (S : in out Slice_Set) is
 132
 133       procedure Free is
 134          new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
 135
 136       procedure Free is
 137          new Ada.Unchecked_Deallocation (Data, Data_Access);
 138
 139       D : Data_Access := S.D;
 140
 141    begin
 142       --  Ensure call is idempotent
 143
 144       S.D := null;
 145
 146       if D /= null then
 147          D.Ref_Counter := D.Ref_Counter - 1;
 148
 149          if D.Ref_Counter = 0 then
 150             Free (D.Source);
 151             Free (D.Indexes);
 152             Free (D.Slices);
 153             Free (D);
 154          end if;
 155       end if;
 156    end Finalize;
 157
 158    ----------------
 159    -- Initialize --
 160    ----------------
 161
 162    overriding procedure Initialize (S : in out Slice_Set) is
 163    begin
 164       S.D := new Data'(1, null, 0, null, null);
 165    end Initialize;
 166
 167    ----------------
 168    -- Separators --
 169    ----------------
 170
 171    function Separators
 172      (S     : Slice_Set;
 173       Index : Slice_Number) return Slice_Separators
 174    is
 175    begin
 176       if Index > S.D.N_Slice then
 177          raise Index_Error;
 178
 179       elsif Index = 0
 180         or else (Index = 1 and then S.D.N_Slice = 1)
 181       then
 182          --  Whole string, or no separator used
 183
 184          return [Before => Array_End,
 185                  After  => Array_End];
 186
 187       elsif Index = 1 then
 188          return [Before => Array_End,
 189                  After  => S.D.Source (S.D.Slices (Index).Stop + 1)];
 190
 191       elsif Index = S.D.N_Slice then
 192          return [Before => S.D.Source (S.D.Slices (Index).Start - 1),
 193                  After  => Array_End];
 194
 195       else
 196          return [Before => S.D.Source (S.D.Slices (Index).Start - 1),
 197                  After  => S.D.Source (S.D.Slices (Index).Stop + 1)];
 198       end if;
 199    end Separators;
 200
 201    ----------------
 202    -- Separators --
 203    ----------------
 204
 205    function Separators (S : Slice_Set) return Separators_Indexes is
 206    begin
 207       return S.D.Indexes.all;
 208    end Separators;
 209
 210    ---------
 211    -- Set --
 212    ---------
 213
 214    procedure Set
 215      (S          : in out Slice_Set;
 216       Separators : Element_Sequence;
 217       Mode       : Separator_Mode := Single)
 218    is
 219    begin
 220       Set (S, To_Set (Separators), Mode);
 221    end Set;
 222
 223    ---------
 224    -- Set --
 225    ---------
 226
 227    procedure Set
 228      (S          : in out Slice_Set;
 229       Separators : Element_Set;
 230       Mode       : Separator_Mode := Single)
 231    is
 232
 233       procedure Copy_On_Write (S : in out Slice_Set);
 234       --  Make a copy of S if shared with another variable
 235
 236       -------------------
 237       -- Copy_On_Write --
 238       -------------------
 239
 240       procedure Copy_On_Write (S : in out Slice_Set) is
 241       begin
 242          if S.D.Ref_Counter > 1 then
 243             --  First let's remove our count from the current data
 244
 245             S.D.Ref_Counter := S.D.Ref_Counter - 1;
 246
 247             --  Then duplicate the data
 248
 249             S.D := new Data'(S.D.all);
 250             S.D.Ref_Counter := 1;
 251
 252             if S.D.Source /= null then
 253                S.D.Source := new Element_Sequence'(S.D.Source.all);
 254                S.D.Indexes := null;
 255                S.D.Slices := null;
 256             end if;
 257
 258          else
 259             --  If there is a single reference to this variable, free it now
 260             --  as it will be redefined below.
 261
 262             Free (S.D.Indexes);
 263             Free (S.D.Slices);
 264          end if;
 265       end Copy_On_Write;
 266
 267       Count_Sep : constant Natural := Count (S.D.Source.all, Separators);
 268       J         : Positive;
 269
 270    begin
 271       Copy_On_Write (S);
 272
 273       --  Compute all separator's indexes
 274
 275       S.D.Indexes := new Separators_Indexes (1 .. Count_Sep);
 276       J := S.D.Indexes'First;
 277
 278       for K in S.D.Source'Range loop
 279          if Is_In (S.D.Source (K), Separators) then
 280             S.D.Indexes (J) := K;
 281             J := J + 1;
 282          end if;
 283       end loop;
 284
 285       --  Compute slice info for fast slice access
 286
 287       declare
 288          S_Info      : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1);
 289          K           : Natural := 1;
 290          Start, Stop : Natural;
 291
 292       begin
 293          S.D.N_Slice := 0;
 294
 295          Start := S.D.Source'First;
 296          Stop  := 0;
 297
 298          loop
 299             if K > Count_Sep then
 300
 301                --  No more separators, last slice ends at end of source string
 302
 303                Stop := S.D.Source'Last;
 304
 305             else
 306                Stop := S.D.Indexes (K) - 1;
 307             end if;
 308
 309             --  Add slice to the table
 310
 311             S.D.N_Slice := S.D.N_Slice + 1;
 312             S_Info (S.D.N_Slice) := (Start, Stop);
 313
 314             exit when K > Count_Sep;
 315
 316             case Mode is
 317                when Single =>
 318
 319                   --  In this mode just set start to character next to the
 320                   --  current separator, advance the separator index.
 321
 322                   Start := S.D.Indexes (K) + 1;
 323                   K := K + 1;
 324
 325                when Multiple =>
 326
 327                   --  In this mode skip separators following each other
 328
 329                   loop
 330                      Start := S.D.Indexes (K) + 1;
 331                      K := K + 1;
 332                      exit when K > Count_Sep
 333                        or else S.D.Indexes (K) > S.D.Indexes (K - 1) + 1;
 334                   end loop;
 335             end case;
 336          end loop;
 337
 338          S.D.Slices := new Slices_Indexes'(S_Info (1 .. S.D.N_Slice));
 339       end;
 340    end Set;
 341
 342    -----------
 343    -- Slice --
 344    -----------
 345
 346    function Slice
 347      (S     : Slice_Set;
 348       Index : Slice_Number) return Element_Sequence
 349    is
 350    begin
 351       if Index = 0 then
 352          return S.D.Source.all;
 353
 354       elsif Index > S.D.N_Slice then
 355          raise Index_Error;
 356
 357       else
 358          return
 359            S.D.Source (S.D.Slices (Index).Start .. S.D.Slices (Index).Stop);
 360       end if;
 361    end Slice;
 362
 363    -----------------
 364    -- Slice_Count --
 365    -----------------
 366
 367    function Slice_Count (S : Slice_Set) return Slice_Number is
 368    begin
 369       return S.D.N_Slice;
 370    end Slice_Count;
 371
 372 end GNAT.Array_Split;