gcc/ada/a-stwise.adb

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