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-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_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       Test   : Membership;
 198       First  : out Positive;
 199       Last   : out Natural)
 200    is
 201    begin
 202       for J in Source'Range loop
 203          if Belongs (Source (J), Set, Test) then
 204             First := J;
 205
 206             for K in J + 1 .. Source'Last loop
 207                if not Belongs (Source (K), Set, Test) then
 208                   Last := K - 1;
 209                   return;
 210                end if;
 211             end loop;
 212
 213             --  Here if J indexes first char of token, and all chars after J
 214             --  are in the token.
 215
 216             Last := Source'Last;
 217             return;
 218          end if;
 219       end loop;
 220
 221       --  Here if no token found
 222
 223       First := Source'First;
 224       Last  := 0;
 225    end Find_Token;
 226
 227    -----------
 228    -- Index --
 229    -----------
 230
 231    function Index
 232      (Source  : Wide_Wide_String;
 233       Pattern : Wide_Wide_String;
 234       Going   : Direction := Forward;
 235       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 236                   Wide_Wide_Maps.Identity)
 237       return Natural
 238    is
 239       PL1 : constant Integer := Pattern'Length - 1;
 240       Cur : Natural;
 241
 242       Ind : Integer;
 243       --  Index for start of match check. This can be negative if the pattern
 244       --  length is greater than the string length, which is why this variable
 245       --  is Integer instead of Natural. In this case, the search loops do not
 246       --  execute at all, so this Ind value is never used.
 247
 248    begin
 249       if Pattern = "" then
 250          raise Pattern_Error;
 251       end if;
 252
 253       --  Forwards case
 254
 255       if Going = Forward then
 256          Ind := Source'First;
 257
 258          --  Unmapped forward case
 259
 260          if Mapping'Address = Wide_Wide_Maps.Identity'Address then
 261             for J in 1 .. Source'Length - PL1 loop
 262                if Pattern = Source (Ind .. Ind + PL1) then
 263                   return Ind;
 264                else
 265                   Ind := Ind + 1;
 266                end if;
 267             end loop;
 268
 269          --  Mapped forward case
 270
 271          else
 272             for J in 1 .. Source'Length - PL1 loop
 273                Cur := Ind;
 274
 275                for K in Pattern'Range loop
 276                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 277                      goto Cont1;
 278                   else
 279                      Cur := Cur + 1;
 280                   end if;
 281                end loop;
 282
 283                return Ind;
 284
 285             <<Cont1>>
 286                Ind := Ind + 1;
 287             end loop;
 288          end if;
 289
 290       --  Backwards case
 291
 292       else
 293          --  Unmapped backward case
 294
 295          Ind := Source'Last - PL1;
 296
 297          if Mapping'Address = Wide_Wide_Maps.Identity'Address then
 298             for J in reverse 1 .. Source'Length - PL1 loop
 299                if Pattern = Source (Ind .. Ind + PL1) then
 300                   return Ind;
 301                else
 302                   Ind := Ind - 1;
 303                end if;
 304             end loop;
 305
 306          --  Mapped backward case
 307
 308          else
 309             for J in reverse 1 .. Source'Length - PL1 loop
 310                Cur := Ind;
 311
 312                for K in Pattern'Range loop
 313                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 314                      goto Cont2;
 315                   else
 316                      Cur := Cur + 1;
 317                   end if;
 318                end loop;
 319
 320                return Ind;
 321
 322             <<Cont2>>
 323                Ind := Ind - 1;
 324             end loop;
 325          end if;
 326       end if;
 327
 328       --  Fall through if no match found. Note that the loops are skipped
 329       --  completely in the case of the pattern being longer than the source.
 330
 331       return 0;
 332    end Index;
 333
 334    function Index
 335      (Source  : Wide_Wide_String;
 336       Pattern : Wide_Wide_String;
 337       Going   : Direction := Forward;
 338       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 339       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 : Wide_Wide_String;
 413       Set    : Wide_Wide_Maps.Wide_Wide_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  : Wide_Wide_String;
 444       Pattern : Wide_Wide_String;
 445       From    : Positive;
 446       Going   : Direction := Forward;
 447       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 448                   Wide_Wide_Maps.Identity)
 449       return Natural
 450    is
 451    begin
 452       if Going = Forward then
 453          if From < Source'First then
 454             raise Index_Error;
 455          end if;
 456
 457          return
 458            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 459
 460       else
 461          if From > Source'Last then
 462             raise Index_Error;
 463          end if;
 464
 465          return
 466            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 467       end if;
 468    end Index;
 469
 470    function Index
 471      (Source  : Wide_Wide_String;
 472       Pattern : Wide_Wide_String;
 473       From    : Positive;
 474       Going   : Direction := Forward;
 475       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 476       return Natural
 477    is
 478    begin
 479       if Going = Forward then
 480          if From < Source'First then
 481             raise Index_Error;
 482          end if;
 483
 484          return Index
 485            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 486
 487       else
 488          if From > Source'Last then
 489             raise Index_Error;
 490          end if;
 491
 492          return Index
 493            (Source (Source'First .. From), Pattern, Backward, Mapping);
 494       end if;
 495    end Index;
 496
 497    function Index
 498      (Source  : Wide_Wide_String;
 499       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
 500       From    : Positive;
 501       Test    : Membership := Inside;
 502       Going   : Direction := Forward) return Natural
 503    is
 504    begin
 505       if Going = Forward then
 506          if From < Source'First then
 507             raise Index_Error;
 508          end if;
 509
 510          return
 511            Index (Source (From .. Source'Last), Set, Test, Forward);
 512
 513       else
 514          if From > Source'Last then
 515             raise Index_Error;
 516          end if;
 517
 518          return
 519            Index (Source (Source'First .. From), Set, Test, Backward);
 520       end if;
 521    end Index;
 522
 523    ---------------------
 524    -- Index_Non_Blank --
 525    ---------------------
 526
 527    function Index_Non_Blank
 528      (Source : Wide_Wide_String;
 529       Going  : Direction := Forward) return Natural
 530    is
 531    begin
 532       if Going = Forward then
 533          for J in Source'Range loop
 534             if Source (J) /= Wide_Wide_Space then
 535                return J;
 536             end if;
 537          end loop;
 538
 539       else -- Going = Backward
 540          for J in reverse Source'Range loop
 541             if Source (J) /= Wide_Wide_Space then
 542                return J;
 543             end if;
 544          end loop;
 545       end if;
 546
 547       --  Fall through if no match
 548
 549       return 0;
 550    end Index_Non_Blank;
 551
 552    function Index_Non_Blank
 553      (Source : Wide_Wide_String;
 554       From   : Positive;
 555       Going  : Direction := Forward) return Natural
 556    is
 557    begin
 558       if Going = Forward then
 559          if From < Source'First then
 560             raise Index_Error;
 561          end if;
 562
 563          return
 564            Index_Non_Blank (Source (From .. Source'Last), Forward);
 565
 566       else
 567          if From > Source'Last then
 568             raise Index_Error;
 569          end if;
 570
 571          return
 572            Index_Non_Blank (Source (Source'First .. From), Backward);
 573       end if;
 574    end Index_Non_Blank;
 575
 576 end Ada.Strings.Wide_Wide_Search;