gcc/ada/a-strsea.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                   A D A . S T R I N G S . S E A R C H                    --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2005, 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 --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  35 --  versions of the Appendix C string handling packages (code extracted
  36 --  from Ada.Strings.Fixed). A significant change is that we optimize the
  37 --  case of identity mappings for Count and Index, and also Index_Non_Blank
  38 --  is specialized (rather than using the general Index routine).
  39
  40 with Ada.Strings.Maps; use Ada.Strings.Maps;
  41
  42 package body Ada.Strings.Search is
  43
  44    -----------------------
  45    -- Local Subprograms --
  46    -----------------------
  47
  48    function Belongs
  49      (Element : Character;
  50       Set     : Maps.Character_Set;
  51       Test    : Membership) return Boolean;
  52    pragma Inline (Belongs);
  53    --  Determines if the given element is in (Test = Inside) or not in
  54    --  (Test = Outside) the given character set.
  55
  56    -------------
  57    -- Belongs --
  58    -------------
  59
  60    function Belongs
  61      (Element : Character;
  62       Set     : Maps.Character_Set;
  63       Test    : Membership) return Boolean
  64    is
  65    begin
  66       if Test = Inside then
  67          return Is_In (Element, Set);
  68       else
  69          return not Is_In (Element, Set);
  70       end if;
  71    end Belongs;
  72
  73    -----------
  74    -- Count --
  75    -----------
  76
  77    function Count
  78      (Source  : String;
  79       Pattern : String;
  80       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
  81    is
  82       N : Natural;
  83       J : Natural;
  84
  85       Mapped_Source : String (Source'Range);
  86
  87    begin
  88       for J in Source'Range loop
  89          Mapped_Source (J) := Value (Mapping, Source (J));
  90       end loop;
  91
  92       if Pattern = "" then
  93          raise Pattern_Error;
  94       end if;
  95
  96       N := 0;
  97       J := Source'First;
  98
  99       while J <= Source'Last - (Pattern'Length - 1) loop
 100          if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
 101             N := N + 1;
 102             J := J + Pattern'Length;
 103          else
 104             J := J + 1;
 105          end if;
 106       end loop;
 107
 108       return N;
 109    end Count;
 110
 111    function Count
 112      (Source  : String;
 113       Pattern : String;
 114       Mapping : Maps.Character_Mapping_Function) return Natural
 115    is
 116       Mapped_Source : String (Source'Range);
 117       N             : Natural;
 118       J             : Natural;
 119
 120    begin
 121       if Pattern = "" then
 122          raise Pattern_Error;
 123       end if;
 124
 125       --  We make sure Access_Check is unsuppressed so that the Mapping.all
 126       --  call will generate a friendly Constraint_Error if the value for
 127       --  Mapping is uninitialized (and hence null).
 128
 129       declare
 130          pragma Unsuppress (Access_Check);
 131
 132       begin
 133          for J in Source'Range loop
 134             Mapped_Source (J) := Mapping.all (Source (J));
 135          end loop;
 136       end;
 137
 138       N := 0;
 139       J := Source'First;
 140
 141       while J <= Source'Last - (Pattern'Length - 1) loop
 142          if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
 143             N := N + 1;
 144             J := J + Pattern'Length;
 145          else
 146             J := J + 1;
 147          end if;
 148       end loop;
 149
 150       return N;
 151    end Count;
 152
 153    function Count
 154      (Source : String;
 155       Set    : Maps.Character_Set) return Natural
 156    is
 157       N : Natural := 0;
 158
 159    begin
 160       for J in Source'Range loop
 161          if Is_In (Source (J), Set) then
 162             N := N + 1;
 163          end if;
 164       end loop;
 165
 166       return N;
 167    end Count;
 168
 169    ----------------
 170    -- Find_Token --
 171    ----------------
 172
 173    procedure Find_Token
 174      (Source : String;
 175       Set    : Maps.Character_Set;
 176       Test   : Membership;
 177       First  : out Positive;
 178       Last   : out Natural)
 179    is
 180    begin
 181       for J in Source'Range loop
 182          if Belongs (Source (J), Set, Test) then
 183             First := J;
 184
 185             for K in J + 1 .. Source'Last loop
 186                if not Belongs (Source (K), Set, Test) then
 187                   Last := K - 1;
 188                   return;
 189                end if;
 190             end loop;
 191
 192             --  Here if J indexes 1st char of token, and all chars
 193             --  after J are in the token
 194
 195             Last := Source'Last;
 196             return;
 197          end if;
 198       end loop;
 199
 200       --  Here if no token found
 201
 202       First := Source'First;
 203       Last  := 0;
 204    end Find_Token;
 205
 206    -----------
 207    -- Index --
 208    -----------
 209
 210    function Index
 211      (Source  : String;
 212       Pattern : String;
 213       Going   : Direction := Forward;
 214       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 215    is
 216       Cur_Index     : Natural;
 217       Mapped_Source : String (Source'Range);
 218
 219    begin
 220       if Pattern = "" then
 221          raise Pattern_Error;
 222       end if;
 223
 224       for J in Source'Range loop
 225          Mapped_Source (J) := Value (Mapping, Source (J));
 226       end loop;
 227
 228       --  Forwards case
 229
 230       if Going = Forward then
 231          for J in 1 .. Source'Length - Pattern'Length + 1 loop
 232             Cur_Index := Source'First + J - 1;
 233
 234             if Pattern = Mapped_Source
 235                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
 236             then
 237                return Cur_Index;
 238             end if;
 239          end loop;
 240
 241       --  Backwards case
 242
 243       else
 244          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
 245             Cur_Index := Source'First + J - 1;
 246
 247             if Pattern = Mapped_Source
 248                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
 249             then
 250                return Cur_Index;
 251             end if;
 252          end loop;
 253       end if;
 254
 255       --  Fall through if no match found. Note that the loops are skipped
 256       --  completely in the case of the pattern being longer than the source.
 257
 258       return 0;
 259    end Index;
 260
 261    function Index
 262      (Source  : String;
 263       Pattern : String;
 264       Going   : Direction := Forward;
 265       Mapping : Maps.Character_Mapping_Function) return Natural
 266    is
 267       Mapped_Source : String (Source'Range);
 268       Cur_Index     : Natural;
 269
 270    begin
 271       if Pattern = "" then
 272          raise Pattern_Error;
 273       end if;
 274
 275       --  We make sure Access_Check is unsuppressed so that the Mapping.all
 276       --  call will generate a friendly Constraint_Error if the value for
 277       --  Mapping is uninitialized (and hence null).
 278
 279       declare
 280          pragma Unsuppress (Access_Check);
 281       begin
 282          for J in Source'Range loop
 283             Mapped_Source (J) := Mapping.all (Source (J));
 284          end loop;
 285       end;
 286
 287       --  Forwards case
 288
 289       if Going = Forward then
 290          for J in 1 .. Source'Length - Pattern'Length + 1 loop
 291             Cur_Index := Source'First + J - 1;
 292
 293             if Pattern = Mapped_Source
 294                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
 295             then
 296                return Cur_Index;
 297             end if;
 298          end loop;
 299
 300       --  Backwards case
 301
 302       else
 303          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
 304             Cur_Index := Source'First + J - 1;
 305
 306             if Pattern = Mapped_Source
 307                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
 308             then
 309                return Cur_Index;
 310             end if;
 311          end loop;
 312       end if;
 313
 314       return 0;
 315    end Index;
 316
 317    function Index
 318      (Source : String;
 319       Set    : Maps.Character_Set;
 320       Test   : Membership := Inside;
 321       Going  : Direction  := Forward) return Natural
 322    is
 323    begin
 324       --  Forwards case
 325
 326       if Going = Forward then
 327          for J in Source'Range loop
 328             if Belongs (Source (J), Set, Test) then
 329                return J;
 330             end if;
 331          end loop;
 332
 333       --  Backwards case
 334
 335       else
 336          for J in reverse Source'Range loop
 337             if Belongs (Source (J), Set, Test) then
 338                return J;
 339             end if;
 340          end loop;
 341       end if;
 342
 343       --  Fall through if no match
 344
 345       return 0;
 346    end Index;
 347
 348    function Index
 349      (Source  : String;
 350       Pattern : String;
 351       From    : Positive;
 352       Going   : Direction := Forward;
 353       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 354    is
 355    begin
 356       if Going = Forward then
 357          if From < Source'First then
 358             raise Index_Error;
 359          end if;
 360
 361          return
 362            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 363
 364       else
 365          if From > Source'Last then
 366             raise Index_Error;
 367          end if;
 368
 369          return
 370            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 371       end if;
 372    end Index;
 373
 374    function Index
 375      (Source  : String;
 376       Pattern : String;
 377       From    : Positive;
 378       Going   : Direction := Forward;
 379       Mapping : Maps.Character_Mapping_Function) return Natural
 380    is
 381    begin
 382       if Going = Forward then
 383          if From < Source'First then
 384             raise Index_Error;
 385          end if;
 386
 387          return Index
 388            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 389
 390       else
 391          if From > Source'Last then
 392             raise Index_Error;
 393          end if;
 394
 395          return Index
 396            (Source (Source'First .. From), Pattern, Backward, Mapping);
 397       end if;
 398    end Index;
 399
 400    function Index
 401      (Source  : String;
 402       Set     : Maps.Character_Set;
 403       From    : Positive;
 404       Test    : Membership := Inside;
 405       Going   : Direction := Forward) return Natural
 406    is
 407    begin
 408       if Going = Forward then
 409          if From < Source'First then
 410             raise Index_Error;
 411          end if;
 412
 413          return
 414            Index (Source (From .. Source'Last), Set, Test, Forward);
 415
 416       else
 417          if From > Source'Last then
 418             raise Index_Error;
 419          end if;
 420
 421          return
 422            Index (Source (Source'First .. From), Set, Test, Backward);
 423       end if;
 424    end Index;
 425
 426    ---------------------
 427    -- Index_Non_Blank --
 428    ---------------------
 429
 430    function Index_Non_Blank
 431      (Source : String;
 432       Going  : Direction := Forward) return Natural
 433    is
 434    begin
 435       if Going = Forward then
 436          for J in Source'Range loop
 437             if Source (J) /= ' ' then
 438                return J;
 439             end if;
 440          end loop;
 441
 442       else -- Going = Backward
 443          for J in reverse Source'Range loop
 444             if Source (J) /= ' ' then
 445                return J;
 446             end if;
 447          end loop;
 448       end if;
 449
 450       --  Fall through if no match
 451
 452       return 0;
 453    end Index_Non_Blank;
 454
 455    function Index_Non_Blank
 456      (Source : String;
 457       From   : Positive;
 458       Going  : Direction := Forward) return Natural
 459    is
 460    begin
 461       if Going = Forward then
 462          if From < Source'First then
 463             raise Index_Error;
 464          end if;
 465
 466          return
 467            Index_Non_Blank (Source (From .. Source'Last), Forward);
 468
 469       else
 470          if From > Source'Last then
 471             raise Index_Error;
 472          end if;
 473
 474          return
 475            Index_Non_Blank (Source (Source'First .. From), Backward);
 476       end if;
 477    end Index_Non_Blank;
 478
 479 end Ada.Strings.Search;