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