gcc/ada/a-stzsea.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --         A D A . S T R I N G S . W I D E _ W I D E _ 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 with Ada.Strings.Wide_Wide_Maps; use Ada.Strings.Wide_Wide_Maps;
  33 with System; use System;
  34
  35 package body Ada.Strings.Wide_Wide_Search is
  36
  37    -----------------------
  38    -- Local Subprograms --
  39    -----------------------
  40
  41    function Belongs
  42      (Element : Wide_Wide_Character;
  43       Set     : Wide_Wide_Maps.Wide_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_Wide_Character;
  55       Set     : Wide_Wide_Maps.Wide_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_Wide_String;
  72       Pattern : Wide_Wide_String;
  73       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
  74                   Wide_Wide_Maps.Identity)
  75       return Natural
  76    is
  77       PL1 : constant Integer := Pattern'Length - 1;
  78       Num : Natural;
  79       Ind : Natural;
  80       Cur : Natural;
  81
  82    begin
  83       if Pattern = "" then
  84          raise Pattern_Error;
  85       end if;
  86
  87       Num := 0;
  88       Ind := Source'First;
  89
  90       --  Unmapped case
  91
  92       if Mapping'Address = Wide_Wide_Maps.Identity'Address then
  93          while Ind <= Source'Last - PL1 loop
  94             if Pattern = Source (Ind .. Ind + PL1) then
  95                Num := Num + 1;
  96                Ind := Ind + Pattern'Length;
  97             else
  98                Ind := Ind + 1;
  99             end if;
 100          end loop;
 101
 102       --  Mapped case
 103
 104       else
 105          while Ind <= Source'Last - PL1 loop
 106             Cur := Ind;
 107             for K in Pattern'Range loop
 108                if Pattern (K) /= Value (Mapping, Source (Cur)) then
 109                   Ind := Ind + 1;
 110                   goto Cont;
 111                else
 112                   Cur := Cur + 1;
 113                end if;
 114             end loop;
 115
 116             Num := Num + 1;
 117             Ind := Ind + Pattern'Length;
 118
 119          <<Cont>>
 120             null;
 121          end loop;
 122       end if;
 123
 124       --  Return result
 125
 126       return Num;
 127    end Count;
 128
 129    function Count
 130      (Source  : Wide_Wide_String;
 131       Pattern : Wide_Wide_String;
 132       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 133       return Natural
 134    is
 135       PL1 : constant Integer := Pattern'Length - 1;
 136       Num : Natural;
 137       Ind : Natural;
 138       Cur : Natural;
 139
 140    begin
 141       if Pattern = "" then
 142          raise Pattern_Error;
 143       end if;
 144
 145       --  Check for null pointer in case checks are off
 146
 147       if Mapping = null then
 148          raise Constraint_Error;
 149       end if;
 150
 151       Num := 0;
 152       Ind := Source'First;
 153       while Ind <= Source'Last - PL1 loop
 154          Cur := Ind;
 155          for K in Pattern'Range loop
 156             if Pattern (K) /= Mapping (Source (Cur)) then
 157                Ind := Ind + 1;
 158                goto Cont;
 159             else
 160                Cur := Cur + 1;
 161             end if;
 162          end loop;
 163
 164          Num := Num + 1;
 165          Ind := Ind + Pattern'Length;
 166
 167       <<Cont>>
 168          null;
 169       end loop;
 170
 171       return Num;
 172    end Count;
 173
 174    function Count
 175      (Source : Wide_Wide_String;
 176       Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
 177    is
 178       N : Natural := 0;
 179
 180    begin
 181       for J in Source'Range loop
 182          if Is_In (Source (J), Set) then
 183             N := N + 1;
 184          end if;
 185       end loop;
 186
 187       return N;
 188    end Count;
 189
 190    ----------------
 191    -- Find_Token --
 192    ----------------
 193
 194    procedure Find_Token
 195      (Source : Wide_Wide_String;
 196       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 197       From   : Positive;
 198       Test   : Membership;
 199       First  : out Positive;
 200       Last   : out Natural)
 201    is
 202    begin
 203       for J in From .. Source'Last loop
 204          if Belongs (Source (J), Set, Test) then
 205             First := J;
 206
 207             for K in J + 1 .. Source'Last loop
 208                if not Belongs (Source (K), Set, Test) then
 209                   Last := K - 1;
 210                   return;
 211                end if;
 212             end loop;
 213
 214             --  Here if J indexes first char of token, and all chars after J
 215             --  are in the token.
 216
 217             Last := Source'Last;
 218             return;
 219          end if;
 220       end loop;
 221
 222       --  Here if no token found
 223
 224       First := From;
 225       Last  := 0;
 226    end Find_Token;
 227
 228    procedure Find_Token
 229      (Source : Wide_Wide_String;
 230       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 231       Test   : Membership;
 232       First  : out Positive;
 233       Last   : out Natural)
 234    is
 235    begin
 236       for J in Source'Range loop
 237          if Belongs (Source (J), Set, Test) then
 238             First := J;
 239
 240             for K in J + 1 .. Source'Last loop
 241                if not Belongs (Source (K), Set, Test) then
 242                   Last := K - 1;
 243                   return;
 244                end if;
 245             end loop;
 246
 247             --  Here if J indexes first char of token, and all chars after J
 248             --  are in the token.
 249
 250             Last := Source'Last;
 251             return;
 252          end if;
 253       end loop;
 254
 255       --  Here if no token found
 256
 257       First := Source'First;
 258       Last  := 0;
 259    end Find_Token;
 260
 261    -----------
 262    -- Index --
 263    -----------
 264
 265    function Index
 266      (Source  : Wide_Wide_String;
 267       Pattern : Wide_Wide_String;
 268       Going   : Direction := Forward;
 269       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 270                   Wide_Wide_Maps.Identity)
 271       return Natural
 272    is
 273       PL1 : constant Integer := Pattern'Length - 1;
 274       Cur : Natural;
 275
 276       Ind : Integer;
 277       --  Index for start of match check. This can be negative if the pattern
 278       --  length is greater than the string length, which is why this variable
 279       --  is Integer instead of Natural. In this case, the search loops do not
 280       --  execute at all, so this Ind value is never used.
 281
 282    begin
 283       if Pattern = "" then
 284          raise Pattern_Error;
 285       end if;
 286
 287       --  Forwards case
 288
 289       if Going = Forward then
 290          Ind := Source'First;
 291
 292          --  Unmapped forward case
 293
 294          if Mapping'Address = Wide_Wide_Maps.Identity'Address then
 295             for J in 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 forward case
 304
 305          else
 306             for J in 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 Cont1;
 312                   else
 313                      Cur := Cur + 1;
 314                   end if;
 315                end loop;
 316
 317                return Ind;
 318
 319             <<Cont1>>
 320                Ind := Ind + 1;
 321             end loop;
 322          end if;
 323
 324       --  Backwards case
 325
 326       else
 327          --  Unmapped backward case
 328
 329          Ind := Source'Last - PL1;
 330
 331          if Mapping'Address = Wide_Wide_Maps.Identity'Address then
 332             for J in reverse 1 .. Source'Length - PL1 loop
 333                if Pattern = Source (Ind .. Ind + PL1) then
 334                   return Ind;
 335                else
 336                   Ind := Ind - 1;
 337                end if;
 338             end loop;
 339
 340          --  Mapped backward case
 341
 342          else
 343             for J in reverse 1 .. Source'Length - PL1 loop
 344                Cur := Ind;
 345
 346                for K in Pattern'Range loop
 347                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 348                      goto Cont2;
 349                   else
 350                      Cur := Cur + 1;
 351                   end if;
 352                end loop;
 353
 354                return Ind;
 355
 356             <<Cont2>>
 357                Ind := Ind - 1;
 358             end loop;
 359          end if;
 360       end if;
 361
 362       --  Fall through if no match found. Note that the loops are skipped
 363       --  completely in the case of the pattern being longer than the source.
 364
 365       return 0;
 366    end Index;
 367
 368    function Index
 369      (Source  : Wide_Wide_String;
 370       Pattern : Wide_Wide_String;
 371       Going   : Direction := Forward;
 372       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 373       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 : Wide_Wide_String;
 447       Set    : Wide_Wide_Maps.Wide_Wide_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  : Wide_Wide_String;
 478       Pattern : Wide_Wide_String;
 479       From    : Positive;
 480       Going   : Direction := Forward;
 481       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 482                   Wide_Wide_Maps.Identity)
 483       return Natural
 484    is
 485    begin
 486       if Going = Forward then
 487          if From < Source'First then
 488             raise Index_Error;
 489          end if;
 490
 491          return
 492            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 493
 494       else
 495          if From > Source'Last then
 496             raise Index_Error;
 497          end if;
 498
 499          return
 500            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 501       end if;
 502    end Index;
 503
 504    function Index
 505      (Source  : Wide_Wide_String;
 506       Pattern : Wide_Wide_String;
 507       From    : Positive;
 508       Going   : Direction := Forward;
 509       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 510       return Natural
 511    is
 512    begin
 513       if Going = Forward then
 514          if From < Source'First then
 515             raise Index_Error;
 516          end if;
 517
 518          return Index
 519            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 520
 521       else
 522          if From > Source'Last then
 523             raise Index_Error;
 524          end if;
 525
 526          return Index
 527            (Source (Source'First .. From), Pattern, Backward, Mapping);
 528       end if;
 529    end Index;
 530
 531    function Index
 532      (Source  : Wide_Wide_String;
 533       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
 534       From    : Positive;
 535       Test    : Membership := Inside;
 536       Going   : Direction := Forward) return Natural
 537    is
 538    begin
 539       if Going = Forward then
 540          if From < Source'First then
 541             raise Index_Error;
 542          end if;
 543
 544          return
 545            Index (Source (From .. Source'Last), Set, Test, Forward);
 546
 547       else
 548          if From > Source'Last then
 549             raise Index_Error;
 550          end if;
 551
 552          return
 553            Index (Source (Source'First .. From), Set, Test, Backward);
 554       end if;
 555    end Index;
 556
 557    ---------------------
 558    -- Index_Non_Blank --
 559    ---------------------
 560
 561    function Index_Non_Blank
 562      (Source : Wide_Wide_String;
 563       Going  : Direction := Forward) return Natural
 564    is
 565    begin
 566       if Going = Forward then
 567          for J in Source'Range loop
 568             if Source (J) /= Wide_Wide_Space then
 569                return J;
 570             end if;
 571          end loop;
 572
 573       else -- Going = Backward
 574          for J in reverse Source'Range loop
 575             if Source (J) /= Wide_Wide_Space then
 576                return J;
 577             end if;
 578          end loop;
 579       end if;
 580
 581       --  Fall through if no match
 582
 583       return 0;
 584    end Index_Non_Blank;
 585
 586    function Index_Non_Blank
 587      (Source : Wide_Wide_String;
 588       From   : Positive;
 589       Going  : Direction := Forward) return Natural
 590    is
 591    begin
 592       if Going = Forward then
 593          if From < Source'First then
 594             raise Index_Error;
 595          end if;
 596
 597          return
 598            Index_Non_Blank (Source (From .. Source'Last), Forward);
 599
 600       else
 601          if From > Source'Last then
 602             raise Index_Error;
 603          end if;
 604
 605          return
 606            Index_Non_Blank (Source (Source'First .. From), Backward);
 607       end if;
 608    end Index_Non_Blank;
 609
 610 end Ada.Strings.Wide_Wide_Search;