gcc/ada/a-stwise.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUNTIME 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 --                                                                          --
  10 --        Copyright (C) 1992,1993,1994 Free Software Foundation, Inc.       --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- As a special exception,  if other files  instantiate  generics from this --
  24 -- unit, or you link  this unit with other files  to produce an executable, --
  25 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  26 -- covered  by the  GNU  General  Public  License.  This exception does not --
  27 -- however invalidate  any other reasons why  the executable file  might be --
  28 -- covered by the  GNU Public License.                                      --
  29 --                                                                          --
  30 -- GNAT was originally developed  by the GNAT team at  New York University. --
  31 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  32 --                                                                          --
  33 ------------------------------------------------------------------------------
  34
  35 with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
  36
  37 package body Ada.Strings.Wide_Search is
  38
  39    -----------------------
  40    -- Local Subprograms --
  41    -----------------------
  42
  43    function Belongs
  44      (Element : Wide_Character;
  45       Set     : Wide_Maps.Wide_Character_Set;
  46       Test    : Membership)
  47       return    Boolean;
  48    pragma Inline (Belongs);
  49    --  Determines if the given element is in (Test = Inside) or not in
  50    --  (Test = Outside) the given character set.
  51
  52    -------------
  53    -- Belongs --
  54    -------------
  55
  56    function Belongs
  57      (Element : Wide_Character;
  58       Set     : Wide_Maps.Wide_Character_Set;
  59       Test    : Membership)
  60       return    Boolean is
  61
  62    begin
  63       if Test = Inside then
  64          return Is_In (Element, Set);
  65       else
  66          return not Is_In (Element, Set);
  67       end if;
  68    end Belongs;
  69
  70    -----------
  71    -- Count --
  72    -----------
  73
  74    function Count
  75      (Source   : in Wide_String;
  76       Pattern  : in Wide_String;
  77       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  78       return     Natural
  79    is
  80       N : Natural;
  81       J : Natural;
  82
  83    begin
  84       if Pattern = "" then
  85          raise Pattern_Error;
  86       end if;
  87
  88       --  Handle the case of non-identity mappings by creating a mapped
  89       --  string and making a recursive call using the identity mapping
  90       --  on this mapped string.
  91
  92       if Mapping /= Wide_Maps.Identity then
  93          declare
  94             Mapped_Source : Wide_String (Source'Range);
  95
  96          begin
  97             for J in Source'Range loop
  98                Mapped_Source (J) := Value (Mapping, Source (J));
  99             end loop;
 100
 101             return Count (Mapped_Source, Pattern);
 102          end;
 103       end if;
 104
 105       N := 0;
 106       J := Source'First;
 107
 108       while J <= Source'Last - (Pattern'Length - 1) loop
 109          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
 110             N := N + 1;
 111             J := J + Pattern'Length;
 112          else
 113             J := J + 1;
 114          end if;
 115       end loop;
 116
 117       return N;
 118    end Count;
 119
 120    function Count
 121      (Source   : in Wide_String;
 122       Pattern  : in Wide_String;
 123       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
 124       return     Natural
 125    is
 126       Mapped_Source : Wide_String (Source'Range);
 127
 128    begin
 129       for J in Source'Range loop
 130          Mapped_Source (J) := Mapping (Source (J));
 131       end loop;
 132
 133       return Count (Mapped_Source, Pattern);
 134    end Count;
 135
 136    function Count (Source : in Wide_String;
 137                    Set    : in Wide_Maps.Wide_Character_Set)
 138      return Natural
 139    is
 140       N : Natural := 0;
 141
 142    begin
 143       for J in Source'Range loop
 144          if Is_In (Source (J), Set) then
 145             N := N + 1;
 146          end if;
 147       end loop;
 148
 149       return N;
 150    end Count;
 151
 152    ----------------
 153    -- Find_Token --
 154    ----------------
 155
 156    procedure Find_Token
 157      (Source : in Wide_String;
 158       Set    : in Wide_Maps.Wide_Character_Set;
 159       Test   : in Membership;
 160       First  : out Positive;
 161       Last   : out Natural)
 162    is
 163    begin
 164       for J in Source'Range loop
 165          if Belongs (Source (J), Set, Test) then
 166             First := J;
 167
 168             for K in J + 1 .. Source'Last loop
 169                if not Belongs (Source (K), Set, Test) then
 170                   Last := K - 1;
 171                   return;
 172                end if;
 173             end loop;
 174
 175             --  Here if J indexes 1st char of token, and all chars
 176             --  after J are in the token
 177
 178             Last := Source'Last;
 179             return;
 180          end if;
 181       end loop;
 182
 183       --  Here if no token found
 184
 185       First := Source'First;
 186       Last  := 0;
 187    end Find_Token;
 188
 189    -----------
 190    -- Index --
 191    -----------
 192
 193    function Index
 194      (Source   : in Wide_String;
 195       Pattern  : in Wide_String;
 196       Going    : in Direction := Forward;
 197       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
 198       return     Natural
 199    is
 200    begin
 201       if Pattern = "" then
 202          raise Pattern_Error;
 203       end if;
 204
 205       --  Handle the case of non-identity mappings by creating a mapped
 206       --  string and making a recursive call using the identity mapping
 207       --  on this mapped string.
 208
 209       if Mapping /= Identity then
 210          declare
 211             Mapped_Source : Wide_String (Source'Range);
 212
 213          begin
 214             for J in Source'Range loop
 215                Mapped_Source (J) := Value (Mapping, Source (J));
 216             end loop;
 217
 218             return Index (Mapped_Source, Pattern, Going);
 219          end;
 220       end if;
 221
 222       if Going = Forward then
 223          for J in Source'First .. Source'Last - Pattern'Length + 1 loop
 224             if Pattern = Source (J .. J + Pattern'Length - 1) then
 225                return J;
 226             end if;
 227          end loop;
 228
 229       else -- Going = Backward
 230          for J in reverse Source'First .. Source'Last - Pattern'Length + 1 loop
 231             if Pattern = Source (J .. J + Pattern'Length - 1) then
 232                return J;
 233             end if;
 234          end loop;
 235       end if;
 236
 237       --  Fall through if no match found. Note that the loops are skipped
 238       --  completely in the case of the pattern being longer than the source.
 239
 240       return 0;
 241    end Index;
 242
 243    -----------
 244    -- Index --
 245    -----------
 246
 247    function Index
 248      (Source   : in Wide_String;
 249       Pattern  : in Wide_String;
 250       Going    : in Direction := Forward;
 251       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
 252       return     Natural
 253    is
 254       Mapped_Source : Wide_String (Source'Range);
 255
 256    begin
 257       for J in Source'Range loop
 258          Mapped_Source (J) := Mapping (Source (J));
 259       end loop;
 260
 261       return Index (Mapped_Source, Pattern, Going);
 262    end Index;
 263
 264    function Index
 265      (Source : in Wide_String;
 266       Set    : in Wide_Maps.Wide_Character_Set;
 267       Test   : in Membership := Inside;
 268       Going  : in Direction  := Forward)
 269       return   Natural
 270    is
 271    begin
 272       if Going = Forward then
 273          for J in Source'Range loop
 274             if Belongs (Source (J), Set, Test) then
 275                return J;
 276             end if;
 277          end loop;
 278
 279       else -- Going = Backward
 280          for J in reverse Source'Range loop
 281             if Belongs (Source (J), Set, Test) then
 282                return J;
 283             end if;
 284          end loop;
 285       end if;
 286
 287       --  Fall through if no match
 288
 289       return 0;
 290    end Index;
 291
 292    ---------------------
 293    -- Index_Non_Blank --
 294    ---------------------
 295
 296    function Index_Non_Blank
 297      (Source : in Wide_String;
 298       Going  : in Direction := Forward)
 299       return   Natural
 300    is
 301    begin
 302       if Going = Forward then
 303          for J in Source'Range loop
 304             if Source (J) /= Wide_Space then
 305                return J;
 306             end if;
 307          end loop;
 308
 309       else -- Going = Backward
 310          for J in reverse Source'Range loop
 311             if Source (J) /= Wide_Space then
 312                return J;
 313             end if;
 314          end loop;
 315       end if;
 316
 317       --  Fall through if no match
 318
 319       return 0;
 320
 321    end Index_Non_Blank;
 322
 323 end Ada.Strings.Wide_Search;