1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . S E A R C H --
9 -- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
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. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- Note: This code is derived from the ADAR.CSH public domain Ada 83
35 -- versions of the Appendix C string handling packages (code extracted
36 -- from Ada.Strings.Fixed). A significant change is that we optimize the
37 -- case of identity mappings for Count and Index, and also Index_Non_Blank
38 -- is specialized (rather than using the general Index routine).
41 with Ada
.Strings
.Maps
; use Ada
.Strings
.Maps
;
43 package body Ada
.Strings
.Search
is
45 -----------------------
46 -- Local Subprograms --
47 -----------------------
51 Set
: Maps
.Character_Set
;
54 pragma Inline
(Belongs
);
55 -- Determines if the given element is in (Test = Inside) or not in
56 -- (Test = Outside) the given character set.
64 Set
: Maps
.Character_Set
;
70 return Is_In
(Element
, Set
);
72 return not Is_In
(Element
, Set
);
83 Mapping
: in Maps
.Character_Mapping
:= Maps
.Identity
)
89 Mapped_Source
: String (Source
'Range);
92 for J
in Source
'Range loop
93 Mapped_Source
(J
) := Value
(Mapping
, Source
(J
));
103 while J
<= Source
'Last - (Pattern
'Length - 1) loop
104 if Mapped_Source
(J
.. J
+ (Pattern
'Length - 1)) = Pattern
then
106 J
:= J
+ Pattern
'Length;
118 Mapping
: in Maps
.Character_Mapping_Function
)
121 Mapped_Source
: String (Source
'Range);
130 -- We make sure Access_Check is unsuppressed so that the Mapping.all
131 -- call will generate a friendly Constraint_Error if the value for
132 -- Mapping is uninitialized (and hence null).
135 pragma Unsuppress
(Access_Check
);
138 for J
in Source
'Range loop
139 Mapped_Source
(J
) := Mapping
.all (Source
(J
));
146 while J
<= Source
'Last - (Pattern
'Length - 1) loop
147 if Mapped_Source
(J
.. J
+ (Pattern
'Length - 1)) = Pattern
then
149 J
:= J
+ Pattern
'Length;
160 Set
: in Maps
.Character_Set
)
166 for J
in Source
'Range loop
167 if Is_In
(Source
(J
), Set
) then
181 Set
: in Maps
.Character_Set
;
182 Test
: in Membership
;
183 First
: out Positive;
187 for J
in Source
'Range loop
188 if Belongs
(Source
(J
), Set
, Test
) then
191 for K
in J
+ 1 .. Source
'Last loop
192 if not Belongs
(Source
(K
), Set
, Test
) then
198 -- Here if J indexes 1st char of token, and all chars
199 -- after J are in the token
206 -- Here if no token found
208 First
:= Source
'First;
219 Going
: in Direction
:= Forward
;
220 Mapping
: in Maps
.Character_Mapping
:= Maps
.Identity
)
224 Mapped_Source
: String (Source
'Range);
232 for J
in Source
'Range loop
233 Mapped_Source
(J
) := Value
(Mapping
, Source
(J
));
238 if Going
= Forward
then
239 for J
in 1 .. Source
'Length - Pattern
'Length + 1 loop
240 Cur_Index
:= Source
'First + J
- 1;
242 if Pattern
= Mapped_Source
243 (Cur_Index
.. Cur_Index
+ Pattern
'Length - 1)
252 for J
in reverse 1 .. Source
'Length - Pattern
'Length + 1 loop
253 Cur_Index
:= Source
'First + J
- 1;
255 if Pattern
= Mapped_Source
256 (Cur_Index
.. Cur_Index
+ Pattern
'Length - 1)
263 -- Fall through if no match found. Note that the loops are skipped
264 -- completely in the case of the pattern being longer than the source.
269 function Index
(Source
: in String;
271 Going
: in Direction
:= Forward
;
272 Mapping
: in Maps
.Character_Mapping_Function
)
275 Mapped_Source
: String (Source
'Range);
283 -- We make sure Access_Check is unsuppressed so that the Mapping.all
284 -- call will generate a friendly Constraint_Error if the value for
285 -- Mapping is uninitialized (and hence null).
288 pragma Unsuppress
(Access_Check
);
291 for J
in Source
'Range loop
292 Mapped_Source
(J
) := Mapping
.all (Source
(J
));
298 if Going
= Forward
then
299 for J
in 1 .. Source
'Length - Pattern
'Length + 1 loop
300 Cur_Index
:= Source
'First + J
- 1;
302 if Pattern
= Mapped_Source
303 (Cur_Index
.. Cur_Index
+ Pattern
'Length - 1)
312 for J
in reverse 1 .. Source
'Length - Pattern
'Length + 1 loop
313 Cur_Index
:= Source
'First + J
- 1;
315 if Pattern
= Mapped_Source
316 (Cur_Index
.. Cur_Index
+ Pattern
'Length - 1)
328 Set
: in Maps
.Character_Set
;
329 Test
: in Membership
:= Inside
;
330 Going
: in Direction
:= Forward
)
336 if Going
= Forward
then
337 for J
in Source
'Range loop
338 if Belongs
(Source
(J
), Set
, Test
) then
346 for J
in reverse Source
'Range loop
347 if Belongs
(Source
(J
), Set
, Test
) then
353 -- Fall through if no match
358 ---------------------
359 -- Index_Non_Blank --
360 ---------------------
362 function Index_Non_Blank
364 Going
: in Direction
:= Forward
)
368 if Going
= Forward
then
369 for J
in Source
'Range loop
370 if Source
(J
) /= ' ' then
375 else -- Going = Backward
376 for J
in reverse Source
'Range loop
377 if Source
(J
) /= ' ' then
383 -- Fall through if no match
389 end Ada
.Strings
.Search
;