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