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