1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . S E A R C H --
10 -- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. --
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. --
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. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 -- Note: This code is derived from the ADAR.CSH public domain Ada 83
36 -- versions of the Appendix C string handling packages (code extracted
37 -- from Ada.Strings.Fixed). A significant change is that we optimize the
38 -- case of identity mappings for Count and Index, and also Index_Non_Blank
39 -- is specialized (rather than using the general Index routine).
42 with Ada.Strings.Maps; use Ada.Strings.Maps;
44 package body Ada.Strings.Search is
46 -----------------------
47 -- Local Subprograms --
48 -----------------------
52 Set : Maps.Character_Set;
55 pragma Inline (Belongs);
56 -- Determines if the given element is in (Test = Inside) or not in
57 -- (Test = Outside) the given character set.
65 Set : Maps.Character_Set;
71 return Is_In (Element, Set);
73 return not Is_In (Element, Set);
84 Mapping : in Maps.Character_Mapping := Maps.Identity)
90 Mapped_Source : String (Source'Range);
93 for J in Source'Range loop
94 Mapped_Source (J) := Value (Mapping, Source (J));
104 while J <= Source'Last - (Pattern'Length - 1) loop
105 if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
107 J := J + Pattern'Length;
119 Mapping : in Maps.Character_Mapping_Function)
122 Mapped_Source : String (Source'Range);
131 -- We make sure Access_Check is unsuppressed so that the Mapping.all
132 -- call will generate a friendly Constraint_Error if the value for
133 -- Mapping is uninitialized (and hence null).
136 pragma Unsuppress (Access_Check);
139 for J in Source'Range loop
140 Mapped_Source (J) := Mapping.all (Source (J));
147 while J <= Source'Last - (Pattern'Length - 1) loop
148 if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
150 J := J + Pattern'Length;
161 Set : in Maps.Character_Set)
167 for J in Source'Range loop
168 if Is_In (Source (J), Set) then
182 Set : in Maps.Character_Set;
183 Test : in Membership;
184 First : out Positive;
188 for J in Source'Range loop
189 if Belongs (Source (J), Set, Test) then
192 for K in J + 1 .. Source'Last loop
193 if not Belongs (Source (K), Set, Test) then
199 -- Here if J indexes 1st char of token, and all chars
200 -- after J are in the token
207 -- Here if no token found
209 First := Source'First;
220 Going : in Direction := Forward;
221 Mapping : in Maps.Character_Mapping := Maps.Identity)
225 Mapped_Source : String (Source'Range);
233 for J in Source'Range loop
234 Mapped_Source (J) := Value (Mapping, Source (J));
239 if Going = Forward then
240 for J in 1 .. Source'Length - Pattern'Length + 1 loop
241 Cur_Index := Source'First + J - 1;
243 if Pattern = Mapped_Source
244 (Cur_Index .. Cur_Index + Pattern'Length - 1)
253 for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
254 Cur_Index := Source'First + J - 1;
256 if Pattern = Mapped_Source
257 (Cur_Index .. Cur_Index + Pattern'Length - 1)
264 -- Fall through if no match found. Note that the loops are skipped
265 -- completely in the case of the pattern being longer than the source.
270 function Index (Source : in String;
272 Going : in Direction := Forward;
273 Mapping : in Maps.Character_Mapping_Function)
276 Mapped_Source : String (Source'Range);
284 -- We make sure Access_Check is unsuppressed so that the Mapping.all
285 -- call will generate a friendly Constraint_Error if the value for
286 -- Mapping is uninitialized (and hence null).
289 pragma Unsuppress (Access_Check);
292 for J in Source'Range loop
293 Mapped_Source (J) := Mapping.all (Source (J));
299 if Going = Forward then
300 for J in 1 .. Source'Length - Pattern'Length + 1 loop
301 Cur_Index := Source'First + J - 1;
303 if Pattern = Mapped_Source
304 (Cur_Index .. Cur_Index + Pattern'Length - 1)
313 for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
314 Cur_Index := Source'First + J - 1;
316 if Pattern = Mapped_Source
317 (Cur_Index .. Cur_Index + Pattern'Length - 1)
329 Set : in Maps.Character_Set;
330 Test : in Membership := Inside;
331 Going : in Direction := Forward)
337 if Going = Forward then
338 for J in Source'Range loop
339 if Belongs (Source (J), Set, Test) then
347 for J in reverse Source'Range loop
348 if Belongs (Source (J), Set, Test) then
354 -- Fall through if no match
359 ---------------------
360 -- Index_Non_Blank --
361 ---------------------
363 function Index_Non_Blank
365 Going : in Direction := Forward)
369 if Going = Forward then
370 for J in Source'Range loop
371 if Source (J) /= ' ' then
376 else -- Going = Backward
377 for J in reverse Source'Range loop
378 if Source (J) /= ' ' then
384 -- Fall through if no match
390 end Ada.Strings.Search;