1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . S T R I N G S . W I D E _ S E A R C H --
9 -- Copyright (C) 1992-2009, 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 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Strings
.Wide_Maps
; use Ada
.Strings
.Wide_Maps
;
33 with System
; use System
;
35 package body Ada
.Strings
.Wide_Search
is
37 -----------------------
38 -- Local Subprograms --
39 -----------------------
42 (Element
: Wide_Character;
43 Set
: Wide_Maps
.Wide_Character_Set
;
44 Test
: Membership
) return Boolean;
45 pragma Inline
(Belongs
);
46 -- Determines if the given element is in (Test = Inside) or not in
47 -- (Test = Outside) the given character set.
54 (Element
: Wide_Character;
55 Set
: Wide_Maps
.Wide_Character_Set
;
56 Test
: Membership
) return Boolean
60 return Is_In
(Element
, Set
);
62 return not Is_In
(Element
, Set
);
71 (Source
: Wide_String;
72 Pattern
: Wide_String;
73 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
76 PL1
: constant Integer := Pattern
'Length - 1;
91 if Mapping
'Address = Wide_Maps
.Identity
'Address then
92 while Ind
<= Source
'Last - PL1
loop
93 if Pattern
= Source
(Ind
.. Ind
+ PL1
) then
95 Ind
:= Ind
+ Pattern
'Length;
104 while Ind
<= Source
'Last - PL1
loop
106 for K
in Pattern
'Range loop
107 if Pattern
(K
) /= Value
(Mapping
, Source
(Cur
)) then
116 Ind
:= Ind
+ Pattern
'Length;
129 (Source
: Wide_String;
130 Pattern
: Wide_String;
131 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
133 PL1
: constant Integer := Pattern
'Length - 1;
143 -- Check for null pointer in case checks are off
145 if Mapping
= null then
146 raise Constraint_Error
;
151 while Ind
<= Source
'Last - PL1
loop
153 for K
in Pattern
'Range loop
154 if Pattern
(K
) /= Mapping
(Source
(Cur
)) then
163 Ind
:= Ind
+ Pattern
'Length;
173 (Source
: Wide_String;
174 Set
: Wide_Maps
.Wide_Character_Set
) return Natural
179 for J
in Source
'Range loop
180 if Is_In
(Source
(J
), Set
) then
193 (Source
: Wide_String;
194 Set
: Wide_Maps
.Wide_Character_Set
;
196 First
: out Positive;
200 for J
in Source
'Range loop
201 if Belongs
(Source
(J
), Set
, Test
) then
204 for K
in J
+ 1 .. Source
'Last loop
205 if not Belongs
(Source
(K
), Set
, Test
) then
211 -- Here if J indexes first char of token, and all chars after J
219 -- Here if no token found
221 First
:= Source
'First;
230 (Source
: Wide_String;
231 Pattern
: Wide_String;
232 Going
: Direction
:= Forward
;
233 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
236 PL1
: constant Integer := Pattern
'Length - 1;
240 -- Index for start of match check. This can be negative if the pattern
241 -- length is greater than the string length, which is why this variable
242 -- is Integer instead of Natural. In this case, the search loops do not
243 -- execute at all, so this Ind value is never used.
252 if Going
= Forward
then
255 -- Unmapped forward case
257 if Mapping
'Address = Wide_Maps
.Identity
'Address then
258 for J
in 1 .. Source
'Length - PL1
loop
259 if Pattern
= Source
(Ind
.. Ind
+ PL1
) then
266 -- Mapped forward case
269 for J
in 1 .. Source
'Length - PL1
loop
272 for K
in Pattern
'Range loop
273 if Pattern
(K
) /= Value
(Mapping
, Source
(Cur
)) then
290 -- Unmapped backward case
292 Ind
:= Source
'Last - PL1
;
294 if Mapping
'Address = Wide_Maps
.Identity
'Address then
295 for J
in reverse 1 .. Source
'Length - PL1
loop
296 if Pattern
= Source
(Ind
.. Ind
+ PL1
) then
303 -- Mapped backward case
306 for J
in reverse 1 .. Source
'Length - PL1
loop
309 for K
in Pattern
'Range loop
310 if Pattern
(K
) /= Value
(Mapping
, Source
(Cur
)) then
325 -- Fall through if no match found. Note that the loops are skipped
326 -- completely in the case of the pattern being longer than the source.
332 (Source
: Wide_String;
333 Pattern
: Wide_String;
334 Going
: Direction
:= Forward
;
335 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
337 PL1
: constant Integer := Pattern
'Length - 1;
346 -- Check for null pointer in case checks are off
348 if Mapping
= null then
349 raise Constraint_Error
;
352 -- If Pattern longer than Source it can't be found
354 if Pattern
'Length > Source
'Length then
360 if Going
= Forward
then
362 for J
in 1 .. Source
'Length - PL1
loop
365 for K
in Pattern
'Range loop
366 if Pattern
(K
) /= Mapping
.all (Source
(Cur
)) then
382 Ind
:= Source
'Last - PL1
;
383 for J
in reverse 1 .. Source
'Length - PL1
loop
386 for K
in Pattern
'Range loop
387 if Pattern
(K
) /= Mapping
.all (Source
(Cur
)) then
401 -- Fall through if no match found. Note that the loops are skipped
402 -- completely in the case of the pattern being longer than the source.
408 (Source
: Wide_String;
409 Set
: Wide_Maps
.Wide_Character_Set
;
410 Test
: Membership
:= Inside
;
411 Going
: Direction
:= Forward
) return Natural
416 if Going
= Forward
then
417 for J
in Source
'Range loop
418 if Belongs
(Source
(J
), Set
, Test
) then
426 for J
in reverse Source
'Range loop
427 if Belongs
(Source
(J
), Set
, Test
) then
433 -- Fall through if no match
439 (Source
: Wide_String;
440 Pattern
: Wide_String;
442 Going
: Direction
:= Forward
;
443 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
447 if Going
= Forward
then
448 if From
< Source
'First then
453 Index
(Source
(From
.. Source
'Last), Pattern
, Forward
, Mapping
);
456 if From
> Source
'Last then
461 Index
(Source
(Source
'First .. From
), Pattern
, Backward
, Mapping
);
466 (Source
: Wide_String;
467 Pattern
: Wide_String;
469 Going
: Direction
:= Forward
;
470 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
473 if Going
= Forward
then
474 if From
< Source
'First then
479 (Source
(From
.. Source
'Last), Pattern
, Forward
, Mapping
);
482 if From
> Source
'Last then
487 (Source
(Source
'First .. From
), Pattern
, Backward
, Mapping
);
492 (Source
: Wide_String;
493 Set
: Wide_Maps
.Wide_Character_Set
;
495 Test
: Membership
:= Inside
;
496 Going
: Direction
:= Forward
) return Natural
499 if Going
= Forward
then
500 if From
< Source
'First then
505 Index
(Source
(From
.. Source
'Last), Set
, Test
, Forward
);
508 if From
> Source
'Last then
513 Index
(Source
(Source
'First .. From
), Set
, Test
, Backward
);
517 ---------------------
518 -- Index_Non_Blank --
519 ---------------------
521 function Index_Non_Blank
522 (Source
: Wide_String;
523 Going
: Direction
:= Forward
) return Natural
526 if Going
= Forward
then
527 for J
in Source
'Range loop
528 if Source
(J
) /= Wide_Space
then
533 else -- Going = Backward
534 for J
in reverse Source
'Range loop
535 if Source
(J
) /= Wide_Space
then
541 -- Fall through if no match
546 function Index_Non_Blank
547 (Source
: Wide_String;
549 Going
: Direction
:= Forward
) return Natural
552 if Going
= Forward
then
553 if From
< Source
'First then
558 Index_Non_Blank
(Source
(From
.. Source
'Last), Forward
);
561 if From
> Source
'Last then
566 Index_Non_Blank
(Source
(Source
'First .. From
), Backward
);
570 end Ada
.Strings
.Wide_Search
;