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-2006, 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_Maps; use Ada.Strings.Wide_Maps;
  35
  36 package body Ada.Strings.Wide_Search is
  37
  38    -----------------------
  39    -- Local Subprograms --
  40    -----------------------
  41
  42    function Belongs
  43      (Element : Wide_Character;
  44       Set     : Wide_Maps.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_Character;
  56       Set     : Wide_Maps.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_String;
  73       Pattern : Wide_String;
  74       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  75       return Natural
  76    is
  77       N : Natural;
  78       J : Natural;
  79
  80    begin
  81       if Pattern = "" then
  82          raise Pattern_Error;
  83       end if;
  84
  85       --  Handle the case of non-identity mappings by creating a mapped
  86       --  string and making a recursive call using the identity mapping
  87       --  on this mapped string.
  88
  89       if Mapping /= Wide_Maps.Identity then
  90          declare
  91             Mapped_Source : Wide_String (Source'Range);
  92
  93          begin
  94             for J in Source'Range loop
  95                Mapped_Source (J) := Value (Mapping, Source (J));
  96             end loop;
  97
  98             return Count (Mapped_Source, Pattern);
  99          end;
 100       end if;
 101
 102       N := 0;
 103       J := Source'First;
 104
 105       while J <= Source'Last - (Pattern'Length - 1) loop
 106          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
 107             N := N + 1;
 108             J := J + Pattern'Length;
 109          else
 110             J := J + 1;
 111          end if;
 112       end loop;
 113
 114       return N;
 115    end Count;
 116
 117    function Count
 118      (Source  : Wide_String;
 119       Pattern : Wide_String;
 120       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
 121    is
 122       Mapped_Source : 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_String;
 134       Set    : Wide_Maps.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_String;
 154       Set    : Wide_Maps.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_String;
 191       Pattern : Wide_String;
 192       Going   : Direction := Forward;
 193       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
 194       return Natural
 195    is
 196    begin
 197       if Pattern = "" then
 198          raise Pattern_Error;
 199       end if;
 200
 201       --  Handle the case of non-identity mappings by creating a mapped
 202       --  string and making a recursive call using the identity mapping
 203       --  on this mapped string.
 204
 205       if Mapping /= Identity then
 206          declare
 207             Mapped_Source : Wide_String (Source'Range);
 208
 209          begin
 210             for J in Source'Range loop
 211                Mapped_Source (J) := Value (Mapping, Source (J));
 212             end loop;
 213
 214             return Index (Mapped_Source, Pattern, Going);
 215          end;
 216       end if;
 217
 218       if Going = Forward then
 219          for J in Source'First .. Source'Last - Pattern'Length + 1 loop
 220             if Pattern = Source (J .. J + Pattern'Length - 1) then
 221                return J;
 222             end if;
 223          end loop;
 224
 225       else -- Going = Backward
 226          for J in reverse Source'First .. Source'Last - Pattern'Length + 1 loop
 227             if Pattern = Source (J .. J + Pattern'Length - 1) then
 228                return J;
 229             end if;
 230          end loop;
 231       end if;
 232
 233       --  Fall through if no match found. Note that the loops are skipped
 234       --  completely in the case of the pattern being longer than the source.
 235
 236       return 0;
 237    end Index;
 238
 239    function Index
 240      (Source  : Wide_String;
 241       Pattern : Wide_String;
 242       Going   : Direction := Forward;
 243       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
 244    is
 245       Mapped_Source : Wide_String (Source'Range);
 246
 247    begin
 248       for J in Source'Range loop
 249          Mapped_Source (J) := Mapping (Source (J));
 250       end loop;
 251
 252       return Index (Mapped_Source, Pattern, Going);
 253    end Index;
 254
 255    function Index
 256      (Source : Wide_String;
 257       Set    : Wide_Maps.Wide_Character_Set;
 258       Test   : Membership := Inside;
 259       Going  : Direction  := Forward) return Natural
 260    is
 261    begin
 262       if Going = Forward then
 263          for J in Source'Range loop
 264             if Belongs (Source (J), Set, Test) then
 265                return J;
 266             end if;
 267          end loop;
 268
 269       else -- Going = Backward
 270          for J in reverse Source'Range loop
 271             if Belongs (Source (J), Set, Test) then
 272                return J;
 273             end if;
 274          end loop;
 275       end if;
 276
 277       --  Fall through if no match
 278
 279       return 0;
 280    end Index;
 281
 282    function Index
 283      (Source  : Wide_String;
 284       Pattern : Wide_String;
 285       From    : Positive;
 286       Going   : Direction := Forward;
 287       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
 288       return Natural
 289    is
 290    begin
 291       if Going = Forward then
 292          if From < Source'First then
 293             raise Index_Error;
 294          end if;
 295
 296          return
 297            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 298
 299       else
 300          if From > Source'Last then
 301             raise Index_Error;
 302          end if;
 303
 304          return
 305            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 306       end if;
 307    end Index;
 308
 309    function Index
 310      (Source  : Wide_String;
 311       Pattern : Wide_String;
 312       From    : Positive;
 313       Going   : Direction := Forward;
 314       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
 315    is
 316    begin
 317       if Going = Forward then
 318          if From < Source'First then
 319             raise Index_Error;
 320          end if;
 321
 322          return Index
 323            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 324
 325       else
 326          if From > Source'Last then
 327             raise Index_Error;
 328          end if;
 329
 330          return Index
 331            (Source (Source'First .. From), Pattern, Backward, Mapping);
 332       end if;
 333    end Index;
 334
 335    function Index
 336      (Source  : Wide_String;
 337       Set     : Wide_Maps.Wide_Character_Set;
 338       From    : Positive;
 339       Test    : Membership := Inside;
 340       Going   : Direction := Forward) return Natural
 341    is
 342    begin
 343       if Going = Forward then
 344          if From < Source'First then
 345             raise Index_Error;
 346          end if;
 347
 348          return
 349            Index (Source (From .. Source'Last), Set, Test, Forward);
 350
 351       else
 352          if From > Source'Last then
 353             raise Index_Error;
 354          end if;
 355
 356          return
 357            Index (Source (Source'First .. From), Set, Test, Backward);
 358       end if;
 359    end Index;
 360
 361    ---------------------
 362    -- Index_Non_Blank --
 363    ---------------------
 364
 365    function Index_Non_Blank
 366      (Source : Wide_String;
 367       Going  : Direction := Forward) return Natural
 368    is
 369    begin
 370       if Going = Forward then
 371          for J in Source'Range loop
 372             if Source (J) /= Wide_Space then
 373                return J;
 374             end if;
 375          end loop;
 376
 377       else -- Going = Backward
 378          for J in reverse Source'Range loop
 379             if Source (J) /= Wide_Space then
 380                return J;
 381             end if;
 382          end loop;
 383       end if;
 384
 385       --  Fall through if no match
 386
 387       return 0;
 388    end Index_Non_Blank;
 389
 390    function Index_Non_Blank
 391      (Source : Wide_String;
 392       From   : Positive;
 393       Going  : Direction := Forward) return Natural
 394    is
 395    begin
 396       if Going = Forward then
 397          if From < Source'First then
 398             raise Index_Error;
 399          end if;
 400
 401          return
 402            Index_Non_Blank (Source (From .. Source'Last), Forward);
 403
 404       else
 405          if From > Source'Last then
 406             raise Index_Error;
 407          end if;
 408
 409          return
 410            Index_Non_Blank (Source (Source'First .. From), Backward);
 411       end if;
 412    end Index_Non_Blank;
 413
 414 end Ada.Strings.Wide_Search;