File : a-stwise.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME 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 -- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
33 with System; use System;
34
35 package body Ada.Strings.Wide_Search is
36
37 -----------------------
38 -- Local Subprograms --
39 -----------------------
40
41 function Belongs
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.
48
49 -------------
50 -- Belongs --
51 -------------
52
53 function Belongs
54 (Element : Wide_Character;
55 Set : Wide_Maps.Wide_Character_Set;
56 Test : Membership) return Boolean
57 is
58 begin
59 if Test = Inside then
60 return Is_In (Element, Set);
61 else
62 return not Is_In (Element, Set);
63 end if;
64 end Belongs;
65
66 -----------
67 -- Count --
68 -----------
69
70 function Count
71 (Source : Wide_String;
72 Pattern : Wide_String;
73 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
74 return Natural
75 is
76 PL1 : constant Integer := Pattern'Length - 1;
77 Num : Natural;
78 Ind : Natural;
79 Cur : Natural;
80
81 begin
82 if Pattern = "" then
83 raise Pattern_Error;
84 end if;
85
86 Num := 0;
87 Ind := Source'First;
88
89 -- Unmapped case
90
91 if Mapping'Address = Wide_Maps.Identity'Address then
92 while Ind <= Source'Last - PL1 loop
93 if Pattern = Source (Ind .. Ind + PL1) then
94 Num := Num + 1;
95 Ind := Ind + Pattern'Length;
96 else
97 Ind := Ind + 1;
98 end if;
99 end loop;
100
101 -- Mapped case
102
103 else
104 while Ind <= Source'Last - PL1 loop
105 Cur := Ind;
106 for K in Pattern'Range loop
107 if Pattern (K) /= Value (Mapping, Source (Cur)) then
108 Ind := Ind + 1;
109 goto Cont;
110 else
111 Cur := Cur + 1;
112 end if;
113 end loop;
114
115 Num := Num + 1;
116 Ind := Ind + Pattern'Length;
117
118 <<Cont>>
119 null;
120 end loop;
121 end if;
122
123 -- Return result
124
125 return Num;
126 end Count;
127
128 function Count
129 (Source : Wide_String;
130 Pattern : Wide_String;
131 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
132 is
133 PL1 : constant Integer := Pattern'Length - 1;
134 Num : Natural;
135 Ind : Natural;
136 Cur : Natural;
137
138 begin
139 if Pattern = "" then
140 raise Pattern_Error;
141 end if;
142
143 -- Check for null pointer in case checks are off
144
145 if Mapping = null then
146 raise Constraint_Error;
147 end if;
148
149 Num := 0;
150 Ind := Source'First;
151 while Ind <= Source'Last - PL1 loop
152 Cur := Ind;
153 for K in Pattern'Range loop
154 if Pattern (K) /= Mapping (Source (Cur)) then
155 Ind := Ind + 1;
156 goto Cont;
157 else
158 Cur := Cur + 1;
159 end if;
160 end loop;
161
162 Num := Num + 1;
163 Ind := Ind + Pattern'Length;
164
165 <<Cont>>
166 null;
167 end loop;
168
169 return Num;
170 end Count;
171
172 function Count
173 (Source : Wide_String;
174 Set : Wide_Maps.Wide_Character_Set) return Natural
175 is
176 N : Natural := 0;
177
178 begin
179 for J in Source'Range loop
180 if Is_In (Source (J), Set) then
181 N := N + 1;
182 end if;
183 end loop;
184
185 return N;
186 end Count;
187
188 ----------------
189 -- Find_Token --
190 ----------------
191
192 procedure Find_Token
193 (Source : Wide_String;
194 Set : Wide_Maps.Wide_Character_Set;
195 From : Positive;
196 Test : Membership;
197 First : out Positive;
198 Last : out Natural)
199 is
200 begin
201 for J in From .. Source'Last loop
202 if Belongs (Source (J), Set, Test) then
203 First := J;
204
205 for K in J + 1 .. Source'Last loop
206 if not Belongs (Source (K), Set, Test) then
207 Last := K - 1;
208 return;
209 end if;
210 end loop;
211
212 -- Here if J indexes first char of token, and all chars after J
213 -- are in the token.
214
215 Last := Source'Last;
216 return;
217 end if;
218 end loop;
219
220 -- Here if no token found
221
222 First := From;
223 Last := 0;
224 end Find_Token;
225
226 procedure Find_Token
227 (Source : Wide_String;
228 Set : Wide_Maps.Wide_Character_Set;
229 Test : Membership;
230 First : out Positive;
231 Last : out Natural)
232 is
233 begin
234 for J in Source'Range loop
235 if Belongs (Source (J), Set, Test) then
236 First := J;
237
238 for K in J + 1 .. Source'Last loop
239 if not Belongs (Source (K), Set, Test) then
240 Last := K - 1;
241 return;
242 end if;
243 end loop;
244
245 -- Here if J indexes first char of token, and all chars after J
246 -- are in the token.
247
248 Last := Source'Last;
249 return;
250 end if;
251 end loop;
252
253 -- Here if no token found
254
255 -- RM 2005 A.4.3 (68/1) specifies that an exception must be raised if
256 -- Source'First is not positive and is assigned to First. Formulation
257 -- is slightly different in RM 2012, but the intent seems similar, so
258 -- we check explicitly for that condition.
259
260 if Source'First not in Positive then
261 raise Constraint_Error;
262
263 else
264 First := Source'First;
265 Last := 0;
266 end if;
267 end Find_Token;
268
269 -----------
270 -- Index --
271 -----------
272
273 function Index
274 (Source : Wide_String;
275 Pattern : Wide_String;
276 Going : Direction := Forward;
277 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
278 return Natural
279 is
280 PL1 : constant Integer := Pattern'Length - 1;
281 Cur : Natural;
282
283 Ind : Integer;
284 -- Index for start of match check. This can be negative if the pattern
285 -- length is greater than the string length, which is why this variable
286 -- is Integer instead of Natural. In this case, the search loops do not
287 -- execute at all, so this Ind value is never used.
288
289 begin
290 if Pattern = "" then
291 raise Pattern_Error;
292 end if;
293
294 -- Forwards case
295
296 if Going = Forward then
297 Ind := Source'First;
298
299 -- Unmapped forward case
300
301 if Mapping'Address = Wide_Maps.Identity'Address then
302 for J in 1 .. Source'Length - PL1 loop
303 if Pattern = Source (Ind .. Ind + PL1) then
304 return Ind;
305 else
306 Ind := Ind + 1;
307 end if;
308 end loop;
309
310 -- Mapped forward case
311
312 else
313 for J in 1 .. Source'Length - PL1 loop
314 Cur := Ind;
315
316 for K in Pattern'Range loop
317 if Pattern (K) /= Value (Mapping, Source (Cur)) then
318 goto Cont1;
319 else
320 Cur := Cur + 1;
321 end if;
322 end loop;
323
324 return Ind;
325
326 <<Cont1>>
327 Ind := Ind + 1;
328 end loop;
329 end if;
330
331 -- Backwards case
332
333 else
334 -- Unmapped backward case
335
336 Ind := Source'Last - PL1;
337
338 if Mapping'Address = Wide_Maps.Identity'Address then
339 for J in reverse 1 .. Source'Length - PL1 loop
340 if Pattern = Source (Ind .. Ind + PL1) then
341 return Ind;
342 else
343 Ind := Ind - 1;
344 end if;
345 end loop;
346
347 -- Mapped backward case
348
349 else
350 for J in reverse 1 .. Source'Length - PL1 loop
351 Cur := Ind;
352
353 for K in Pattern'Range loop
354 if Pattern (K) /= Value (Mapping, Source (Cur)) then
355 goto Cont2;
356 else
357 Cur := Cur + 1;
358 end if;
359 end loop;
360
361 return Ind;
362
363 <<Cont2>>
364 Ind := Ind - 1;
365 end loop;
366 end if;
367 end if;
368
369 -- Fall through if no match found. Note that the loops are skipped
370 -- completely in the case of the pattern being longer than the source.
371
372 return 0;
373 end Index;
374
375 function Index
376 (Source : Wide_String;
377 Pattern : Wide_String;
378 Going : Direction := Forward;
379 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
380 is
381 PL1 : constant Integer := Pattern'Length - 1;
382 Ind : Natural;
383 Cur : Natural;
384
385 begin
386 if Pattern = "" then
387 raise Pattern_Error;
388 end if;
389
390 -- Check for null pointer in case checks are off
391
392 if Mapping = null then
393 raise Constraint_Error;
394 end if;
395
396 -- If Pattern longer than Source it can't be found
397
398 if Pattern'Length > Source'Length then
399 return 0;
400 end if;
401
402 -- Forwards case
403
404 if Going = Forward then
405 Ind := Source'First;
406 for J in 1 .. Source'Length - PL1 loop
407 Cur := Ind;
408
409 for K in Pattern'Range loop
410 if Pattern (K) /= Mapping.all (Source (Cur)) then
411 goto Cont1;
412 else
413 Cur := Cur + 1;
414 end if;
415 end loop;
416
417 return Ind;
418
419 <<Cont1>>
420 Ind := Ind + 1;
421 end loop;
422
423 -- Backwards case
424
425 else
426 Ind := Source'Last - PL1;
427 for J in reverse 1 .. Source'Length - PL1 loop
428 Cur := Ind;
429
430 for K in Pattern'Range loop
431 if Pattern (K) /= Mapping.all (Source (Cur)) then
432 goto Cont2;
433 else
434 Cur := Cur + 1;
435 end if;
436 end loop;
437
438 return Ind;
439
440 <<Cont2>>
441 Ind := Ind - 1;
442 end loop;
443 end if;
444
445 -- Fall through if no match found. Note that the loops are skipped
446 -- completely in the case of the pattern being longer than the source.
447
448 return 0;
449 end Index;
450
451 function Index
452 (Source : Wide_String;
453 Set : Wide_Maps.Wide_Character_Set;
454 Test : Membership := Inside;
455 Going : Direction := Forward) return Natural
456 is
457 begin
458 -- Forwards case
459
460 if Going = Forward then
461 for J in Source'Range loop
462 if Belongs (Source (J), Set, Test) then
463 return J;
464 end if;
465 end loop;
466
467 -- Backwards case
468
469 else
470 for J in reverse Source'Range loop
471 if Belongs (Source (J), Set, Test) then
472 return J;
473 end if;
474 end loop;
475 end if;
476
477 -- Fall through if no match
478
479 return 0;
480 end Index;
481
482 function Index
483 (Source : Wide_String;
484 Pattern : Wide_String;
485 From : Positive;
486 Going : Direction := Forward;
487 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
488 return Natural
489 is
490 begin
491 if Going = Forward then
492 if From < Source'First then
493 raise Index_Error;
494 end if;
495
496 return
497 Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
498
499 else
500 if From > Source'Last then
501 raise Index_Error;
502 end if;
503
504 return
505 Index (Source (Source'First .. From), Pattern, Backward, Mapping);
506 end if;
507 end Index;
508
509 function Index
510 (Source : Wide_String;
511 Pattern : Wide_String;
512 From : Positive;
513 Going : Direction := Forward;
514 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
515 is
516 begin
517 if Going = Forward then
518 if From < Source'First then
519 raise Index_Error;
520 end if;
521
522 return Index
523 (Source (From .. Source'Last), Pattern, Forward, Mapping);
524
525 else
526 if From > Source'Last then
527 raise Index_Error;
528 end if;
529
530 return Index
531 (Source (Source'First .. From), Pattern, Backward, Mapping);
532 end if;
533 end Index;
534
535 function Index
536 (Source : Wide_String;
537 Set : Wide_Maps.Wide_Character_Set;
538 From : Positive;
539 Test : Membership := Inside;
540 Going : Direction := Forward) return Natural
541 is
542 begin
543 if Going = Forward then
544 if From < Source'First then
545 raise Index_Error;
546 end if;
547
548 return
549 Index (Source (From .. Source'Last), Set, Test, Forward);
550
551 else
552 if From > Source'Last then
553 raise Index_Error;
554 end if;
555
556 return
557 Index (Source (Source'First .. From), Set, Test, Backward);
558 end if;
559 end Index;
560
561 ---------------------
562 -- Index_Non_Blank --
563 ---------------------
564
565 function Index_Non_Blank
566 (Source : Wide_String;
567 Going : Direction := Forward) return Natural
568 is
569 begin
570 if Going = Forward then
571 for J in Source'Range loop
572 if Source (J) /= Wide_Space then
573 return J;
574 end if;
575 end loop;
576
577 else -- Going = Backward
578 for J in reverse Source'Range loop
579 if Source (J) /= Wide_Space then
580 return J;
581 end if;
582 end loop;
583 end if;
584
585 -- Fall through if no match
586
587 return 0;
588 end Index_Non_Blank;
589
590 function Index_Non_Blank
591 (Source : Wide_String;
592 From : Positive;
593 Going : Direction := Forward) return Natural
594 is
595 begin
596 if Going = Forward then
597 if From < Source'First then
598 raise Index_Error;
599 end if;
600
601 return
602 Index_Non_Blank (Source (From .. Source'Last), Forward);
603
604 else
605 if From > Source'Last then
606 raise Index_Error;
607 end if;
608
609 return
610 Index_Non_Blank (Source (Source'First .. From), Backward);
611 end if;
612 end Index_Non_Blank;
613
614 end Ada.Strings.Wide_Search;