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 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          Ind := Source'First;
  98          while Ind <= Source'Length - PL1 loop
  99             if Pattern = Source (Ind .. Ind + PL1) then
 100                Num := Num + 1;
 101                Ind := Ind + Pattern'Length;
 102             else
 103                Ind := Ind + 1;
 104             end if;
 105          end loop;
 106
 107       --  Mapped case
 108
 109       else
 110          Ind := Source'First;
 111          while Ind <= Source'Length - PL1 loop
 112             Cur := Ind;
 113             for K in Pattern'Range loop
 114                if Pattern (K) /= Value (Mapping, Source (Cur)) then
 115                   Ind := Ind + 1;
 116                   goto Cont;
 117                else
 118                   Cur := Cur + 1;
 119                end if;
 120             end loop;
 121
 122             Num := Num + 1;
 123             Ind := Ind + Pattern'Length;
 124
 125          <<Cont>>
 126             null;
 127          end loop;
 128       end if;
 129
 130       --  Return result
 131
 132       return Num;
 133    end Count;
 134
 135    function Count
 136      (Source  : String;
 137       Pattern : String;
 138       Mapping : Maps.Character_Mapping_Function) return Natural
 139    is
 140       PL1 : constant Integer := Pattern'Length - 1;
 141       Num : Natural;
 142       Ind : Natural;
 143       Cur : Natural;
 144
 145    begin
 146       if Pattern = "" then
 147          raise Pattern_Error;
 148       end if;
 149
 150       --  Check for null pointer in case checks are off
 151
 152       if Mapping = null then
 153          raise Constraint_Error;
 154       end if;
 155
 156       Num := 0;
 157       Ind := Source'First;
 158       while Ind <= Source'Last - PL1 loop
 159          Cur := Ind;
 160          for K in Pattern'Range loop
 161             if Pattern (K) /= Mapping (Source (Cur)) then
 162                Ind := Ind + 1;
 163                goto Cont;
 164             else
 165                Cur := Cur + 1;
 166             end if;
 167          end loop;
 168
 169          Num := Num + 1;
 170          Ind := Ind + Pattern'Length;
 171
 172       <<Cont>>
 173          null;
 174       end loop;
 175
 176       return Num;
 177    end Count;
 178
 179    function Count
 180      (Source : String;
 181       Set    : Maps.Character_Set) return Natural
 182    is
 183       N : Natural := 0;
 184
 185    begin
 186       for J in Source'Range loop
 187          if Is_In (Source (J), Set) then
 188             N := N + 1;
 189          end if;
 190       end loop;
 191
 192       return N;
 193    end Count;
 194
 195    ----------------
 196    -- Find_Token --
 197    ----------------
 198
 199    procedure Find_Token
 200      (Source : String;
 201       Set    : Maps.Character_Set;
 202       Test   : Membership;
 203       First  : out Positive;
 204       Last   : out Natural)
 205    is
 206    begin
 207       for J in Source'Range loop
 208          if Belongs (Source (J), Set, Test) then
 209             First := J;
 210
 211             for K in J + 1 .. Source'Last loop
 212                if not Belongs (Source (K), Set, Test) then
 213                   Last := K - 1;
 214                   return;
 215                end if;
 216             end loop;
 217
 218             --  Here if J indexes first char of token, and all chars after J
 219             --  are in the token.
 220
 221             Last := Source'Last;
 222             return;
 223          end if;
 224       end loop;
 225
 226       --  Here if no token found
 227
 228       First := Source'First;
 229       Last  := 0;
 230    end Find_Token;
 231
 232    -----------
 233    -- Index --
 234    -----------
 235
 236    function Index
 237      (Source  : String;
 238       Pattern : String;
 239       Going   : Direction := Forward;
 240       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 241    is
 242       PL1 : constant Integer := Pattern'Length - 1;
 243       Ind : Natural;
 244       Cur : Natural;
 245
 246    begin
 247       if Pattern = "" then
 248          raise Pattern_Error;
 249       end if;
 250
 251       --  Forwards case
 252
 253       if Going = Forward then
 254          Ind := Source'First;
 255
 256          --  Unmapped forward case
 257
 258          if Mapping'Address = Maps.Identity'Address then
 259             for J in 1 .. Source'Length - PL1 loop
 260                if Pattern = Source (Ind .. Ind + PL1) then
 261                   return Ind;
 262                else
 263                   Ind := Ind + 1;
 264                end if;
 265             end loop;
 266
 267          --  Mapped forward case
 268
 269          else
 270             for J in 1 .. Source'Length - PL1 loop
 271                Cur := Ind;
 272
 273                for K in Pattern'Range loop
 274                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 275                      goto Cont1;
 276                   else
 277                      Cur := Cur + 1;
 278                   end if;
 279                end loop;
 280
 281                return Ind;
 282
 283             <<Cont1>>
 284                Ind := Ind + 1;
 285             end loop;
 286          end if;
 287
 288       --  Backwards case
 289
 290       else
 291          --  Unmapped backward case
 292
 293          Ind := Source'Last - PL1;
 294
 295          if Mapping'Address = Maps.Identity'Address then
 296             for J in reverse 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 backward case
 305
 306          else
 307             for J in reverse 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 Cont2;
 313                   else
 314                      Cur := Cur + 1;
 315                   end if;
 316                end loop;
 317
 318                return Ind;
 319
 320             <<Cont2>>
 321                Ind := Ind - 1;
 322             end loop;
 323          end if;
 324       end if;
 325
 326       --  Fall through if no match found. Note that the loops are skipped
 327       --  completely in the case of the pattern being longer than the source.
 328
 329       return 0;
 330    end Index;
 331
 332    function Index
 333      (Source  : String;
 334       Pattern : String;
 335       Going   : Direction := Forward;
 336       Mapping : Maps.Character_Mapping_Function) return Natural
 337    is
 338       PL1 : constant Integer := Pattern'Length - 1;
 339       Ind : Natural;
 340       Cur : Natural;
 341
 342    begin
 343       if Pattern = "" then
 344          raise Pattern_Error;
 345       end if;
 346
 347       --  Check for null pointer in case checks are off
 348
 349       if Mapping = null then
 350          raise Constraint_Error;
 351       end if;
 352
 353       --  Forwards case
 354
 355       if Going = Forward then
 356          Ind := Source'First;
 357          for J in 1 .. Source'Length - PL1 loop
 358             Cur := Ind;
 359
 360             for K in Pattern'Range loop
 361                if Pattern (K) /= Mapping.all (Source (Cur)) then
 362                   goto Cont1;
 363                else
 364                   Cur := Cur + 1;
 365                end if;
 366             end loop;
 367
 368             return Ind;
 369
 370          <<Cont1>>
 371             Ind := Ind + 1;
 372          end loop;
 373
 374       --  Backwards case
 375
 376       else
 377          Ind := Source'Last - PL1;
 378          for J in reverse 1 .. Source'Length - PL1 loop
 379             Cur := Ind;
 380
 381             for K in Pattern'Range loop
 382                if Pattern (K) /= Mapping.all (Source (Cur)) then
 383                   goto Cont2;
 384                else
 385                   Cur := Cur + 1;
 386                end if;
 387             end loop;
 388
 389             return Ind;
 390
 391          <<Cont2>>
 392             Ind := Ind - 1;
 393          end loop;
 394       end if;
 395
 396       --  Fall through if no match found. Note that the loops are skipped
 397       --  completely in the case of the pattern being longer than the source.
 398
 399       return 0;
 400    end Index;
 401
 402    function Index
 403      (Source : String;
 404       Set    : Maps.Character_Set;
 405       Test   : Membership := Inside;
 406       Going  : Direction  := Forward) return Natural
 407    is
 408    begin
 409       --  Forwards case
 410
 411       if Going = Forward then
 412          for J in Source'Range loop
 413             if Belongs (Source (J), Set, Test) then
 414                return J;
 415             end if;
 416          end loop;
 417
 418       --  Backwards case
 419
 420       else
 421          for J in reverse Source'Range loop
 422             if Belongs (Source (J), Set, Test) then
 423                return J;
 424             end if;
 425          end loop;
 426       end if;
 427
 428       --  Fall through if no match
 429
 430       return 0;
 431    end Index;
 432
 433    function Index
 434      (Source  : String;
 435       Pattern : String;
 436       From    : Positive;
 437       Going   : Direction := Forward;
 438       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 439    is
 440    begin
 441       if Going = Forward then
 442          if From < Source'First then
 443             raise Index_Error;
 444          end if;
 445
 446          return
 447            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 448
 449       else
 450          if From > Source'Last then
 451             raise Index_Error;
 452          end if;
 453
 454          return
 455            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 456       end if;
 457    end Index;
 458
 459    function Index
 460      (Source  : String;
 461       Pattern : String;
 462       From    : Positive;
 463       Going   : Direction := Forward;
 464       Mapping : Maps.Character_Mapping_Function) return Natural
 465    is
 466    begin
 467       if Going = Forward then
 468          if From < Source'First then
 469             raise Index_Error;
 470          end if;
 471
 472          return Index
 473            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 474
 475       else
 476          if From > Source'Last then
 477             raise Index_Error;
 478          end if;
 479
 480          return Index
 481            (Source (Source'First .. From), Pattern, Backward, Mapping);
 482       end if;
 483    end Index;
 484
 485    function Index
 486      (Source  : String;
 487       Set     : Maps.Character_Set;
 488       From    : Positive;
 489       Test    : Membership := Inside;
 490       Going   : Direction := Forward) return Natural
 491    is
 492    begin
 493       if Going = Forward then
 494          if From < Source'First then
 495             raise Index_Error;
 496          end if;
 497
 498          return
 499            Index (Source (From .. Source'Last), Set, Test, Forward);
 500
 501       else
 502          if From > Source'Last then
 503             raise Index_Error;
 504          end if;
 505
 506          return
 507            Index (Source (Source'First .. From), Set, Test, Backward);
 508       end if;
 509    end Index;
 510
 511    ---------------------
 512    -- Index_Non_Blank --
 513    ---------------------
 514
 515    function Index_Non_Blank
 516      (Source : String;
 517       Going  : Direction := Forward) return Natural
 518    is
 519    begin
 520       if Going = Forward then
 521          for J in Source'Range loop
 522             if Source (J) /= ' ' then
 523                return J;
 524             end if;
 525          end loop;
 526
 527       else -- Going = Backward
 528          for J in reverse Source'Range loop
 529             if Source (J) /= ' ' then
 530                return J;
 531             end if;
 532          end loop;
 533       end if;
 534
 535       --  Fall through if no match
 536
 537       return 0;
 538    end Index_Non_Blank;
 539
 540    function Index_Non_Blank
 541      (Source : String;
 542       From   : Positive;
 543       Going  : Direction := Forward) return Natural
 544    is
 545    begin
 546       if Going = Forward then
 547          if From < Source'First then
 548             raise Index_Error;
 549          end if;
 550
 551          return
 552            Index_Non_Blank (Source (From .. Source'Last), Forward);
 553
 554       else
 555          if From > Source'Last then
 556             raise Index_Error;
 557          end if;
 558
 559          return
 560            Index_Non_Blank (Source (Source'First .. From), Backward);
 561       end if;
 562    end Index_Non_Blank;
 563
 564 end Ada.Strings.Search;