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