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
  34 package body Ada.Strings.Wide_Wide_Search is
  35
  36    -----------------------
  37    -- Local Subprograms --
  38    -----------------------
  39
  40    function Belongs
  41      (Element : Wide_Wide_Character;
  42       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
  43       Test    : Membership) return Boolean;
  44    pragma Inline (Belongs);
  45    --  Determines if the given element is in (Test = Inside) or not in
  46    --  (Test = Outside) the given character set.
  47
  48    -------------
  49    -- Belongs --
  50    -------------
  51
  52    function Belongs
  53      (Element : Wide_Wide_Character;
  54       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
  55       Test    : Membership) return Boolean
  56    is
  57    begin
  58       if Test = Inside then
  59          return Is_In (Element, Set);
  60       else
  61          return not Is_In (Element, Set);
  62       end if;
  63    end Belongs;
  64
  65    -----------
  66    -- Count --
  67    -----------
  68
  69    function Count
  70      (Source  : Wide_Wide_String;
  71       Pattern : Wide_Wide_String;
  72       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
  73                   Wide_Wide_Maps.Identity)
  74       return Natural
  75    is
  76       N : Natural;
  77       J : Natural;
  78
  79    begin
  80       if Pattern = "" then
  81          raise Pattern_Error;
  82       end if;
  83
  84       --  Handle the case of non-identity mappings by creating a mapped
  85       --  string and making a recursive call using the identity mapping
  86       --  on this mapped string.
  87
  88       if Mapping /= Wide_Wide_Maps.Identity then
  89          declare
  90             Mapped_Source : Wide_Wide_String (Source'Range);
  91
  92          begin
  93             for J in Source'Range loop
  94                Mapped_Source (J) := Value (Mapping, Source (J));
  95             end loop;
  96
  97             return Count (Mapped_Source, Pattern);
  98          end;
  99       end if;
 100
 101       N := 0;
 102       J := Source'First;
 103
 104       while J <= Source'Last - (Pattern'Length - 1) loop
 105          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
 106             N := N + 1;
 107             J := J + Pattern'Length;
 108          else
 109             J := J + 1;
 110          end if;
 111       end loop;
 112
 113       return N;
 114    end Count;
 115
 116    function Count
 117      (Source  : Wide_Wide_String;
 118       Pattern : Wide_Wide_String;
 119       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 120       return Natural
 121    is
 122       Mapped_Source : Wide_Wide_String (Source'Range);
 123
 124    begin
 125       for J in Source'Range loop
 126          Mapped_Source (J) := Mapping (Source (J));
 127       end loop;
 128
 129       return Count (Mapped_Source, Pattern);
 130    end Count;
 131
 132    function Count
 133      (Source : Wide_Wide_String;
 134       Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
 135    is
 136       N : Natural := 0;
 137
 138    begin
 139       for J in Source'Range loop
 140          if Is_In (Source (J), Set) then
 141             N := N + 1;
 142          end if;
 143       end loop;
 144
 145       return N;
 146    end Count;
 147
 148    ----------------
 149    -- Find_Token --
 150    ----------------
 151
 152    procedure Find_Token
 153      (Source : Wide_Wide_String;
 154       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 155       Test   : Membership;
 156       First  : out Positive;
 157       Last   : out Natural)
 158    is
 159    begin
 160       for J in Source'Range loop
 161          if Belongs (Source (J), Set, Test) then
 162             First := J;
 163
 164             for K in J + 1 .. Source'Last loop
 165                if not Belongs (Source (K), Set, Test) then
 166                   Last := K - 1;
 167                   return;
 168                end if;
 169             end loop;
 170
 171             --  Here if J indexes 1st char of token, and all chars
 172             --  after J are in the token
 173
 174             Last := Source'Last;
 175             return;
 176          end if;
 177       end loop;
 178
 179       --  Here if no token found
 180
 181       First := Source'First;
 182       Last  := 0;
 183    end Find_Token;
 184
 185    -----------
 186    -- Index --
 187    -----------
 188
 189    function Index
 190      (Source  : Wide_Wide_String;
 191       Pattern : Wide_Wide_String;
 192       Going   : Direction := Forward;
 193       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 194                   Wide_Wide_Maps.Identity)
 195       return Natural
 196    is
 197    begin
 198       if Pattern = "" then
 199          raise Pattern_Error;
 200       end if;
 201
 202       --  Handle the case of non-identity mappings by creating a mapped
 203       --  string and making a recursive call using the identity mapping
 204       --  on this mapped string.
 205
 206       if Mapping /= Identity then
 207          declare
 208             Mapped_Source : Wide_Wide_String (Source'Range);
 209
 210          begin
 211             for J in Source'Range loop
 212                Mapped_Source (J) := Value (Mapping, Source (J));
 213             end loop;
 214
 215             return Index (Mapped_Source, Pattern, Going);
 216          end;
 217       end if;
 218
 219       if Going = Forward then
 220          for J in Source'First .. Source'Last - Pattern'Length + 1 loop
 221             if Pattern = Source (J .. J + Pattern'Length - 1) then
 222                return J;
 223             end if;
 224          end loop;
 225
 226       else -- Going = Backward
 227          for J in reverse Source'First .. Source'Last - Pattern'Length + 1 loop
 228             if Pattern = Source (J .. J + Pattern'Length - 1) then
 229                return J;
 230             end if;
 231          end loop;
 232       end if;
 233
 234       --  Fall through if no match found. Note that the loops are skipped
 235       --  completely in the case of the pattern being longer than the source.
 236
 237       return 0;
 238    end Index;
 239
 240    function Index
 241      (Source  : Wide_Wide_String;
 242       Pattern : Wide_Wide_String;
 243       Going   : Direction := Forward;
 244       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 245       return Natural
 246    is
 247       Mapped_Source : Wide_Wide_String (Source'Range);
 248
 249    begin
 250       for J in Source'Range loop
 251          Mapped_Source (J) := Mapping (Source (J));
 252       end loop;
 253
 254       return Index (Mapped_Source, Pattern, Going);
 255    end Index;
 256
 257    function Index
 258      (Source : Wide_Wide_String;
 259       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 260       Test   : Membership := Inside;
 261       Going  : Direction  := Forward) return Natural
 262    is
 263    begin
 264       if Going = Forward then
 265          for J in Source'Range loop
 266             if Belongs (Source (J), Set, Test) then
 267                return J;
 268             end if;
 269          end loop;
 270
 271       else -- Going = Backward
 272          for J in reverse Source'Range loop
 273             if Belongs (Source (J), Set, Test) then
 274                return J;
 275             end if;
 276          end loop;
 277       end if;
 278
 279       --  Fall through if no match
 280
 281       return 0;
 282    end Index;
 283
 284    function Index
 285      (Source  : Wide_Wide_String;
 286       Pattern : Wide_Wide_String;
 287       From    : Positive;
 288       Going   : Direction := Forward;
 289       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 290                   Wide_Wide_Maps.Identity)
 291       return Natural
 292    is
 293    begin
 294       if Going = Forward then
 295          if From < Source'First then
 296             raise Index_Error;
 297          end if;
 298
 299          return
 300            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 301
 302       else
 303          if From > Source'Last then
 304             raise Index_Error;
 305          end if;
 306
 307          return
 308            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 309       end if;
 310    end Index;
 311
 312    function Index
 313      (Source  : Wide_Wide_String;
 314       Pattern : Wide_Wide_String;
 315       From    : Positive;
 316       Going   : Direction := Forward;
 317       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 318       return Natural
 319    is
 320    begin
 321       if Going = Forward then
 322          if From < Source'First then
 323             raise Index_Error;
 324          end if;
 325
 326          return Index
 327            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 328
 329       else
 330          if From > Source'Last then
 331             raise Index_Error;
 332          end if;
 333
 334          return Index
 335            (Source (Source'First .. From), Pattern, Backward, Mapping);
 336       end if;
 337    end Index;
 338
 339    function Index
 340      (Source  : Wide_Wide_String;
 341       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
 342       From    : Positive;
 343       Test    : Membership := Inside;
 344       Going   : Direction := Forward) return Natural
 345    is
 346    begin
 347       if Going = Forward then
 348          if From < Source'First then
 349             raise Index_Error;
 350          end if;
 351
 352          return
 353            Index (Source (From .. Source'Last), Set, Test, Forward);
 354
 355       else
 356          if From > Source'Last then
 357             raise Index_Error;
 358          end if;
 359
 360          return
 361            Index (Source (Source'First .. From), Set, Test, Backward);
 362       end if;
 363    end Index;
 364
 365    ---------------------
 366    -- Index_Non_Blank --
 367    ---------------------
 368
 369    function Index_Non_Blank
 370      (Source : Wide_Wide_String;
 371       Going  : Direction := Forward) return Natural
 372    is
 373    begin
 374       if Going = Forward then
 375          for J in Source'Range loop
 376             if Source (J) /= Wide_Wide_Space then
 377                return J;
 378             end if;
 379          end loop;
 380
 381       else -- Going = Backward
 382          for J in reverse Source'Range loop
 383             if Source (J) /= Wide_Wide_Space then
 384                return J;
 385             end if;
 386          end loop;
 387       end if;
 388
 389       --  Fall through if no match
 390
 391       return 0;
 392    end Index_Non_Blank;
 393
 394    function Index_Non_Blank
 395      (Source : Wide_Wide_String;
 396       From   : Positive;
 397       Going  : Direction := Forward) return Natural
 398    is
 399    begin
 400       if Going = Forward then
 401          if From < Source'First then
 402             raise Index_Error;
 403          end if;
 404
 405          return
 406            Index_Non_Blank (Source (From .. Source'Last), Forward);
 407
 408       else
 409          if From > Source'Last then
 410             raise Index_Error;
 411          end if;
 412
 413          return
 414            Index_Non_Blank (Source (Source'First .. From), Backward);
 415       end if;
 416    end Index_Non_Blank;
 417
 418 end Ada.Strings.Wide_Wide_Search;