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