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