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          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       Test   : Membership;
 201       First  : out Positive;
 202       Last   : out Natural)
 203    is
 204    begin
 205       for J in Source'Range loop
 206          if Belongs (Source (J), Set, Test) then
 207             First := J;
 208
 209             for K in J + 1 .. Source'Last loop
 210                if not Belongs (Source (K), Set, Test) then
 211                   Last := K - 1;
 212                   return;
 213                end if;
 214             end loop;
 215
 216             --  Here if J indexes first char of token, and all chars after J
 217             --  are in the token.
 218
 219             Last := Source'Last;
 220             return;
 221          end if;
 222       end loop;
 223
 224       --  Here if no token found
 225
 226       First := Source'First;
 227       Last  := 0;
 228    end Find_Token;
 229
 230    -----------
 231    -- Index --
 232    -----------
 233
 234    function Index
 235      (Source  : String;
 236       Pattern : String;
 237       Going   : Direction := Forward;
 238       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 239    is
 240       PL1 : constant Integer := Pattern'Length - 1;
 241       Cur : Natural;
 242
 243       Ind : Integer;
 244       --  Index for start of match check. This can be negative if the pattern
 245       --  length is greater than the string length, which is why this variable
 246       --  is Integer instead of Natural. In this case, the search loops do not
 247       --  execute at all, so this Ind value is never used.
 248
 249    begin
 250       if Pattern = "" then
 251          raise Pattern_Error;
 252       end if;
 253
 254       --  Forwards case
 255
 256       if Going = Forward then
 257          Ind := Source'First;
 258
 259          --  Unmapped forward case
 260
 261          if Mapping'Address = Maps.Identity'Address then
 262             for J in 1 .. Source'Length - PL1 loop
 263                if Pattern = Source (Ind .. Ind + PL1) then
 264                   return Ind;
 265                else
 266                   Ind := Ind + 1;
 267                end if;
 268             end loop;
 269
 270          --  Mapped forward case
 271
 272          else
 273             for J in 1 .. Source'Length - PL1 loop
 274                Cur := Ind;
 275
 276                for K in Pattern'Range loop
 277                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 278                      goto Cont1;
 279                   else
 280                      Cur := Cur + 1;
 281                   end if;
 282                end loop;
 283
 284                return Ind;
 285
 286             <<Cont1>>
 287                Ind := Ind + 1;
 288             end loop;
 289          end if;
 290
 291       --  Backwards case
 292
 293       else
 294          --  Unmapped backward case
 295
 296          Ind := Source'Last - PL1;
 297
 298          if Mapping'Address = Maps.Identity'Address then
 299             for J in reverse 1 .. Source'Length - PL1 loop
 300                if Pattern = Source (Ind .. Ind + PL1) then
 301                   return Ind;
 302                else
 303                   Ind := Ind - 1;
 304                end if;
 305             end loop;
 306
 307          --  Mapped backward case
 308
 309          else
 310             for J in reverse 1 .. Source'Length - PL1 loop
 311                Cur := Ind;
 312
 313                for K in Pattern'Range loop
 314                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 315                      goto Cont2;
 316                   else
 317                      Cur := Cur + 1;
 318                   end if;
 319                end loop;
 320
 321                return Ind;
 322
 323             <<Cont2>>
 324                Ind := Ind - 1;
 325             end loop;
 326          end if;
 327       end if;
 328
 329       --  Fall through if no match found. Note that the loops are skipped
 330       --  completely in the case of the pattern being longer than the source.
 331
 332       return 0;
 333    end Index;
 334
 335    function Index
 336      (Source  : String;
 337       Pattern : String;
 338       Going   : Direction := Forward;
 339       Mapping : Maps.Character_Mapping_Function) return Natural
 340    is
 341       PL1 : constant Integer := Pattern'Length - 1;
 342       Ind : Natural;
 343       Cur : Natural;
 344
 345    begin
 346       if Pattern = "" then
 347          raise Pattern_Error;
 348       end if;
 349
 350       --  Check for null pointer in case checks are off
 351
 352       if Mapping = null then
 353          raise Constraint_Error;
 354       end if;
 355
 356       --  If Pattern longer than Source it can't be found
 357
 358       if Pattern'Length > Source'Length then
 359          return 0;
 360       end if;
 361
 362       --  Forwards case
 363
 364       if Going = Forward then
 365          Ind := Source'First;
 366          for J in 1 .. Source'Length - PL1 loop
 367             Cur := Ind;
 368
 369             for K in Pattern'Range loop
 370                if Pattern (K) /= Mapping.all (Source (Cur)) then
 371                   goto Cont1;
 372                else
 373                   Cur := Cur + 1;
 374                end if;
 375             end loop;
 376
 377             return Ind;
 378
 379          <<Cont1>>
 380             Ind := Ind + 1;
 381          end loop;
 382
 383       --  Backwards case
 384
 385       else
 386          Ind := Source'Last - PL1;
 387          for J in reverse 1 .. Source'Length - PL1 loop
 388             Cur := Ind;
 389
 390             for K in Pattern'Range loop
 391                if Pattern (K) /= Mapping.all (Source (Cur)) then
 392                   goto Cont2;
 393                else
 394                   Cur := Cur + 1;
 395                end if;
 396             end loop;
 397
 398             return Ind;
 399
 400          <<Cont2>>
 401             Ind := Ind - 1;
 402          end loop;
 403       end if;
 404
 405       --  Fall through if no match found. Note that the loops are skipped
 406       --  completely in the case of the pattern being longer than the source.
 407
 408       return 0;
 409    end Index;
 410
 411    function Index
 412      (Source : String;
 413       Set    : Maps.Character_Set;
 414       Test   : Membership := Inside;
 415       Going  : Direction  := Forward) return Natural
 416    is
 417    begin
 418       --  Forwards case
 419
 420       if Going = Forward then
 421          for J in Source'Range loop
 422             if Belongs (Source (J), Set, Test) then
 423                return J;
 424             end if;
 425          end loop;
 426
 427       --  Backwards case
 428
 429       else
 430          for J in reverse Source'Range loop
 431             if Belongs (Source (J), Set, Test) then
 432                return J;
 433             end if;
 434          end loop;
 435       end if;
 436
 437       --  Fall through if no match
 438
 439       return 0;
 440    end Index;
 441
 442    function Index
 443      (Source  : String;
 444       Pattern : String;
 445       From    : Positive;
 446       Going   : Direction := Forward;
 447       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 448    is
 449    begin
 450       if Going = Forward then
 451          if From < Source'First then
 452             raise Index_Error;
 453          end if;
 454
 455          return
 456            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 457
 458       else
 459          if From > Source'Last then
 460             raise Index_Error;
 461          end if;
 462
 463          return
 464            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 465       end if;
 466    end Index;
 467
 468    function Index
 469      (Source  : String;
 470       Pattern : String;
 471       From    : Positive;
 472       Going   : Direction := Forward;
 473       Mapping : Maps.Character_Mapping_Function) return Natural
 474    is
 475    begin
 476       if Going = Forward then
 477          if From < Source'First then
 478             raise Index_Error;
 479          end if;
 480
 481          return Index
 482            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 483
 484       else
 485          if From > Source'Last then
 486             raise Index_Error;
 487          end if;
 488
 489          return Index
 490            (Source (Source'First .. From), Pattern, Backward, Mapping);
 491       end if;
 492    end Index;
 493
 494    function Index
 495      (Source  : String;
 496       Set     : Maps.Character_Set;
 497       From    : Positive;
 498       Test    : Membership := Inside;
 499       Going   : Direction := Forward) return Natural
 500    is
 501    begin
 502       if Going = Forward then
 503          if From < Source'First then
 504             raise Index_Error;
 505          end if;
 506
 507          return
 508            Index (Source (From .. Source'Last), Set, Test, Forward);
 509
 510       else
 511          if From > Source'Last then
 512             raise Index_Error;
 513          end if;
 514
 515          return
 516            Index (Source (Source'First .. From), Set, Test, Backward);
 517       end if;
 518    end Index;
 519
 520    ---------------------
 521    -- Index_Non_Blank --
 522    ---------------------
 523
 524    function Index_Non_Blank
 525      (Source : String;
 526       Going  : Direction := Forward) return Natural
 527    is
 528    begin
 529       if Going = Forward then
 530          for J in Source'Range loop
 531             if Source (J) /= ' ' then
 532                return J;
 533             end if;
 534          end loop;
 535
 536       else -- Going = Backward
 537          for J in reverse Source'Range loop
 538             if Source (J) /= ' ' then
 539                return J;
 540             end if;
 541          end loop;
 542       end if;
 543
 544       --  Fall through if no match
 545
 546       return 0;
 547    end Index_Non_Blank;
 548
 549    function Index_Non_Blank
 550      (Source : String;
 551       From   : Positive;
 552       Going  : Direction := Forward) return Natural
 553    is
 554    begin
 555       if Going = Forward then
 556          if From < Source'First then
 557             raise Index_Error;
 558          end if;
 559
 560          return
 561            Index_Non_Blank (Source (From .. Source'Last), Forward);
 562
 563       else
 564          if From > Source'Last then
 565             raise Index_Error;
 566          end if;
 567
 568          return
 569            Index_Non_Blank (Source (Source'First .. From), Backward);
 570       end if;
 571    end Index_Non_Blank;
 572
 573 end Ada.Strings.Search;