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-2010, 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 with System;           use System;
  40
  41 package body Ada.Strings.Search is
  42
  43    -----------------------
  44    -- Local Subprograms --
  45    -----------------------
  46
  47    function Belongs
  48      (Element : Character;
  49       Set     : Maps.Character_Set;
  50       Test    : Membership) return Boolean;
  51    pragma Inline (Belongs);
  52    --  Determines if the given element is in (Test = Inside) or not in
  53    --  (Test = Outside) the given character set.
  54
  55    -------------
  56    -- Belongs --
  57    -------------
  58
  59    function Belongs
  60      (Element : Character;
  61       Set     : Maps.Character_Set;
  62       Test    : Membership) return Boolean
  63    is
  64    begin
  65       if Test = Inside then
  66          return Is_In (Element, Set);
  67       else
  68          return not Is_In (Element, Set);
  69       end if;
  70    end Belongs;
  71
  72    -----------
  73    -- Count --
  74    -----------
  75
  76    function Count
  77      (Source  : String;
  78       Pattern : String;
  79       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
  80    is
  81       PL1 : constant Integer := Pattern'Length - 1;
  82       Num : Natural;
  83       Ind : Natural;
  84       Cur : Natural;
  85
  86    begin
  87       if Pattern = "" then
  88          raise Pattern_Error;
  89       end if;
  90
  91       Num := 0;
  92       Ind := Source'First;
  93
  94       --  Unmapped case
  95
  96       if Mapping'Address = Maps.Identity'Address then
  97          while Ind <= Source'Last - PL1 loop
  98             if Pattern = Source (Ind .. Ind + PL1) then
  99                Num := Num + 1;
 100                Ind := Ind + Pattern'Length;
 101             else
 102                Ind := Ind + 1;
 103             end if;
 104          end loop;
 105
 106       --  Mapped case
 107
 108       else
 109          while Ind <= Source'Last - PL1 loop
 110             Cur := Ind;
 111             for K in Pattern'Range loop
 112                if Pattern (K) /= Value (Mapping, Source (Cur)) then
 113                   Ind := Ind + 1;
 114                   goto Cont;
 115                else
 116                   Cur := Cur + 1;
 117                end if;
 118             end loop;
 119
 120             Num := Num + 1;
 121             Ind := Ind + Pattern'Length;
 122
 123          <<Cont>>
 124             null;
 125          end loop;
 126       end if;
 127
 128       --  Return result
 129
 130       return Num;
 131    end Count;
 132
 133    function Count
 134      (Source  : String;
 135       Pattern : String;
 136       Mapping : Maps.Character_Mapping_Function) return Natural
 137    is
 138       PL1 : constant Integer := Pattern'Length - 1;
 139       Num : Natural;
 140       Ind : Natural;
 141       Cur : Natural;
 142
 143    begin
 144       if Pattern = "" then
 145          raise Pattern_Error;
 146       end if;
 147
 148       --  Check for null pointer in case checks are off
 149
 150       if Mapping = null then
 151          raise Constraint_Error;
 152       end if;
 153
 154       Num := 0;
 155       Ind := Source'First;
 156       while Ind <= Source'Last - PL1 loop
 157          Cur := Ind;
 158          for K in Pattern'Range loop
 159             if Pattern (K) /= Mapping (Source (Cur)) then
 160                Ind := Ind + 1;
 161                goto Cont;
 162             else
 163                Cur := Cur + 1;
 164             end if;
 165          end loop;
 166
 167          Num := Num + 1;
 168          Ind := Ind + Pattern'Length;
 169
 170       <<Cont>>
 171          null;
 172       end loop;
 173
 174       return Num;
 175    end Count;
 176
 177    function Count
 178      (Source : String;
 179       Set    : Maps.Character_Set) return Natural
 180    is
 181       N : Natural := 0;
 182
 183    begin
 184       for J in Source'Range loop
 185          if Is_In (Source (J), Set) then
 186             N := N + 1;
 187          end if;
 188       end loop;
 189
 190       return N;
 191    end Count;
 192
 193    ----------------
 194    -- Find_Token --
 195    ----------------
 196
 197    procedure Find_Token
 198      (Source : String;
 199       Set    : Maps.Character_Set;
 200       From   : Positive;
 201       Test   : Membership;
 202       First  : out Positive;
 203       Last   : out Natural)
 204    is
 205    begin
 206       for J in From .. Source'Last loop
 207          if Belongs (Source (J), Set, Test) then
 208             First := J;
 209
 210             for K in J + 1 .. Source'Last loop
 211                if not Belongs (Source (K), Set, Test) then
 212                   Last := K - 1;
 213                   return;
 214                end if;
 215             end loop;
 216
 217             --  Here if J indexes first char of token, and all chars after J
 218             --  are in the token.
 219
 220             Last := Source'Last;
 221             return;
 222          end if;
 223       end loop;
 224
 225       --  Here if no token found
 226
 227       First := From;
 228       Last  := 0;
 229    end Find_Token;
 230
 231    procedure Find_Token
 232      (Source : String;
 233       Set    : Maps.Character_Set;
 234       Test   : Membership;
 235       First  : out Positive;
 236       Last   : out Natural)
 237    is
 238    begin
 239       for J in Source'Range loop
 240          if Belongs (Source (J), Set, Test) then
 241             First := J;
 242
 243             for K in J + 1 .. Source'Last loop
 244                if not Belongs (Source (K), Set, Test) then
 245                   Last := K - 1;
 246                   return;
 247                end if;
 248             end loop;
 249
 250             --  Here if J indexes first char of token, and all chars after J
 251             --  are in the token.
 252
 253             Last := Source'Last;
 254             return;
 255          end if;
 256       end loop;
 257
 258       --  Here if no token found
 259
 260       First := Source'First;
 261       Last  := 0;
 262    end Find_Token;
 263
 264    -----------
 265    -- Index --
 266    -----------
 267
 268    function Index
 269      (Source  : String;
 270       Pattern : String;
 271       Going   : Direction := Forward;
 272       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 273    is
 274       PL1 : constant Integer := Pattern'Length - 1;
 275       Cur : Natural;
 276
 277       Ind : Integer;
 278       --  Index for start of match check. This can be negative if the pattern
 279       --  length is greater than the string length, which is why this variable
 280       --  is Integer instead of Natural. In this case, the search loops do not
 281       --  execute at all, so this Ind value is never used.
 282
 283    begin
 284       if Pattern = "" then
 285          raise Pattern_Error;
 286       end if;
 287
 288       --  Forwards case
 289
 290       if Going = Forward then
 291          Ind := Source'First;
 292
 293          --  Unmapped forward case
 294
 295          if Mapping'Address = Maps.Identity'Address then
 296             for J in 1 .. Source'Length - PL1 loop
 297                if Pattern = Source (Ind .. Ind + PL1) then
 298                   return Ind;
 299                else
 300                   Ind := Ind + 1;
 301                end if;
 302             end loop;
 303
 304          --  Mapped forward case
 305
 306          else
 307             for J in 1 .. Source'Length - PL1 loop
 308                Cur := Ind;
 309
 310                for K in Pattern'Range loop
 311                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 312                      goto Cont1;
 313                   else
 314                      Cur := Cur + 1;
 315                   end if;
 316                end loop;
 317
 318                return Ind;
 319
 320             <<Cont1>>
 321                Ind := Ind + 1;
 322             end loop;
 323          end if;
 324
 325       --  Backwards case
 326
 327       else
 328          --  Unmapped backward case
 329
 330          Ind := Source'Last - PL1;
 331
 332          if Mapping'Address = Maps.Identity'Address then
 333             for J in reverse 1 .. Source'Length - PL1 loop
 334                if Pattern = Source (Ind .. Ind + PL1) then
 335                   return Ind;
 336                else
 337                   Ind := Ind - 1;
 338                end if;
 339             end loop;
 340
 341          --  Mapped backward case
 342
 343          else
 344             for J in reverse 1 .. Source'Length - PL1 loop
 345                Cur := Ind;
 346
 347                for K in Pattern'Range loop
 348                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 349                      goto Cont2;
 350                   else
 351                      Cur := Cur + 1;
 352                   end if;
 353                end loop;
 354
 355                return Ind;
 356
 357             <<Cont2>>
 358                Ind := Ind - 1;
 359             end loop;
 360          end if;
 361       end if;
 362
 363       --  Fall through if no match found. Note that the loops are skipped
 364       --  completely in the case of the pattern being longer than the source.
 365
 366       return 0;
 367    end Index;
 368
 369    function Index
 370      (Source  : String;
 371       Pattern : String;
 372       Going   : Direction := Forward;
 373       Mapping : Maps.Character_Mapping_Function) return Natural
 374    is
 375       PL1 : constant Integer := Pattern'Length - 1;
 376       Ind : Natural;
 377       Cur : Natural;
 378
 379    begin
 380       if Pattern = "" then
 381          raise Pattern_Error;
 382       end if;
 383
 384       --  Check for null pointer in case checks are off
 385
 386       if Mapping = null then
 387          raise Constraint_Error;
 388       end if;
 389
 390       --  If Pattern longer than Source it can't be found
 391
 392       if Pattern'Length > Source'Length then
 393          return 0;
 394       end if;
 395
 396       --  Forwards case
 397
 398       if Going = Forward then
 399          Ind := Source'First;
 400          for J in 1 .. Source'Length - PL1 loop
 401             Cur := Ind;
 402
 403             for K in Pattern'Range loop
 404                if Pattern (K) /= Mapping.all (Source (Cur)) then
 405                   goto Cont1;
 406                else
 407                   Cur := Cur + 1;
 408                end if;
 409             end loop;
 410
 411             return Ind;
 412
 413          <<Cont1>>
 414             Ind := Ind + 1;
 415          end loop;
 416
 417       --  Backwards case
 418
 419       else
 420          Ind := Source'Last - PL1;
 421          for J in reverse 1 .. Source'Length - PL1 loop
 422             Cur := Ind;
 423
 424             for K in Pattern'Range loop
 425                if Pattern (K) /= Mapping.all (Source (Cur)) then
 426                   goto Cont2;
 427                else
 428                   Cur := Cur + 1;
 429                end if;
 430             end loop;
 431
 432             return Ind;
 433
 434          <<Cont2>>
 435             Ind := Ind - 1;
 436          end loop;
 437       end if;
 438
 439       --  Fall through if no match found. Note that the loops are skipped
 440       --  completely in the case of the pattern being longer than the source.
 441
 442       return 0;
 443    end Index;
 444
 445    function Index
 446      (Source : String;
 447       Set    : Maps.Character_Set;
 448       Test   : Membership := Inside;
 449       Going  : Direction  := Forward) return Natural
 450    is
 451    begin
 452       --  Forwards case
 453
 454       if Going = Forward then
 455          for J in Source'Range loop
 456             if Belongs (Source (J), Set, Test) then
 457                return J;
 458             end if;
 459          end loop;
 460
 461       --  Backwards case
 462
 463       else
 464          for J in reverse Source'Range loop
 465             if Belongs (Source (J), Set, Test) then
 466                return J;
 467             end if;
 468          end loop;
 469       end if;
 470
 471       --  Fall through if no match
 472
 473       return 0;
 474    end Index;
 475
 476    function Index
 477      (Source  : String;
 478       Pattern : String;
 479       From    : Positive;
 480       Going   : Direction := Forward;
 481       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 482    is
 483    begin
 484       if Going = Forward then
 485          if From < Source'First then
 486             raise Index_Error;
 487          end if;
 488
 489          return
 490            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 491
 492       else
 493          if From > Source'Last then
 494             raise Index_Error;
 495          end if;
 496
 497          return
 498            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 499       end if;
 500    end Index;
 501
 502    function Index
 503      (Source  : String;
 504       Pattern : String;
 505       From    : Positive;
 506       Going   : Direction := Forward;
 507       Mapping : Maps.Character_Mapping_Function) return Natural
 508    is
 509    begin
 510       if Going = Forward then
 511          if From < Source'First then
 512             raise Index_Error;
 513          end if;
 514
 515          return Index
 516            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 517
 518       else
 519          if From > Source'Last then
 520             raise Index_Error;
 521          end if;
 522
 523          return Index
 524            (Source (Source'First .. From), Pattern, Backward, Mapping);
 525       end if;
 526    end Index;
 527
 528    function Index
 529      (Source  : String;
 530       Set     : Maps.Character_Set;
 531       From    : Positive;
 532       Test    : Membership := Inside;
 533       Going   : Direction := Forward) return Natural
 534    is
 535    begin
 536       if Going = Forward then
 537          if From < Source'First then
 538             raise Index_Error;
 539          end if;
 540
 541          return
 542            Index (Source (From .. Source'Last), Set, Test, Forward);
 543
 544       else
 545          if From > Source'Last then
 546             raise Index_Error;
 547          end if;
 548
 549          return
 550            Index (Source (Source'First .. From), Set, Test, Backward);
 551       end if;
 552    end Index;
 553
 554    ---------------------
 555    -- Index_Non_Blank --
 556    ---------------------
 557
 558    function Index_Non_Blank
 559      (Source : String;
 560       Going  : Direction := Forward) return Natural
 561    is
 562    begin
 563       if Going = Forward then
 564          for J in Source'Range loop
 565             if Source (J) /= ' ' then
 566                return J;
 567             end if;
 568          end loop;
 569
 570       else -- Going = Backward
 571          for J in reverse Source'Range loop
 572             if Source (J) /= ' ' then
 573                return J;
 574             end if;
 575          end loop;
 576       end if;
 577
 578       --  Fall through if no match
 579
 580       return 0;
 581    end Index_Non_Blank;
 582
 583    function Index_Non_Blank
 584      (Source : String;
 585       From   : Positive;
 586       Going  : Direction := Forward) return Natural
 587    is
 588    begin
 589       if Going = Forward then
 590          if From < Source'First then
 591             raise Index_Error;
 592          end if;
 593
 594          return
 595            Index_Non_Blank (Source (From .. Source'Last), Forward);
 596
 597       else
 598          if From > Source'Last then
 599             raise Index_Error;
 600          end if;
 601
 602          return
 603            Index_Non_Blank (Source (Source'First .. From), Backward);
 604       end if;
 605    end Index_Non_Blank;
 606
 607 end Ada.Strings.Search;