OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-strsea.adb] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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-2010, 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
 
38
with Ada.Strings.Maps; use Ada.Strings.Maps;
39
with System;           use System;
40
 
41
package 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
      for J in From .. Source'Last loop
207
         if Belongs (Source (J), Set, Test) then
208
            First := J;
209
 
210
            for K in J + 1 .. Source'Last loop
211
               if not Belongs (Source (K), Set, Test) then
212
                  Last := K - 1;
213
                  return;
214
               end if;
215
            end loop;
216
 
217
            --  Here if J indexes first char of token, and all chars after J
218
            --  are in the token.
219
 
220
            Last := Source'Last;
221
            return;
222
         end if;
223
      end loop;
224
 
225
      --  Here if no token found
226
 
227
      First := From;
228
      Last  := 0;
229
   end Find_Token;
230
 
231
   procedure Find_Token
232
     (Source : String;
233
      Set    : Maps.Character_Set;
234
      Test   : Membership;
235
      First  : out Positive;
236
      Last   : out Natural)
237
   is
238
   begin
239
      for J in Source'Range loop
240
         if Belongs (Source (J), Set, Test) then
241
            First := J;
242
 
243
            for K in J + 1 .. Source'Last loop
244
               if not Belongs (Source (K), Set, Test) then
245
                  Last := K - 1;
246
                  return;
247
               end if;
248
            end loop;
249
 
250
            --  Here if J indexes first char of token, and all chars after J
251
            --  are in the token.
252
 
253
            Last := Source'Last;
254
            return;
255
         end if;
256
      end loop;
257
 
258
      --  Here if no token found
259
 
260
      First := Source'First;
261
      Last  := 0;
262
   end Find_Token;
263
 
264
   -----------
265
   -- Index --
266
   -----------
267
 
268
   function Index
269
     (Source  : String;
270
      Pattern : String;
271
      Going   : Direction := Forward;
272
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
273
   is
274
      PL1 : constant Integer := Pattern'Length - 1;
275
      Cur : Natural;
276
 
277
      Ind : Integer;
278
      --  Index for start of match check. This can be negative if the pattern
279
      --  length is greater than the string length, which is why this variable
280
      --  is Integer instead of Natural. In this case, the search loops do not
281
      --  execute at all, so this Ind value is never used.
282
 
283
   begin
284
      if Pattern = "" then
285
         raise Pattern_Error;
286
      end if;
287
 
288
      --  Forwards case
289
 
290
      if Going = Forward then
291
         Ind := Source'First;
292
 
293
         --  Unmapped forward case
294
 
295
         if Mapping'Address = Maps.Identity'Address then
296
            for J in 1 .. Source'Length - PL1 loop
297
               if Pattern = Source (Ind .. Ind + PL1) then
298
                  return Ind;
299
               else
300
                  Ind := Ind + 1;
301
               end if;
302
            end loop;
303
 
304
         --  Mapped forward case
305
 
306
         else
307
            for J in 1 .. Source'Length - PL1 loop
308
               Cur := Ind;
309
 
310
               for K in Pattern'Range loop
311
                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
312
                     goto Cont1;
313
                  else
314
                     Cur := Cur + 1;
315
                  end if;
316
               end loop;
317
 
318
               return Ind;
319
 
320
            <<Cont1>>
321
               Ind := Ind + 1;
322
            end loop;
323
         end if;
324
 
325
      --  Backwards case
326
 
327
      else
328
         --  Unmapped backward case
329
 
330
         Ind := Source'Last - PL1;
331
 
332
         if Mapping'Address = Maps.Identity'Address then
333
            for J in reverse 1 .. Source'Length - PL1 loop
334
               if Pattern = Source (Ind .. Ind + PL1) then
335
                  return Ind;
336
               else
337
                  Ind := Ind - 1;
338
               end if;
339
            end loop;
340
 
341
         --  Mapped backward case
342
 
343
         else
344
            for J in reverse 1 .. Source'Length - PL1 loop
345
               Cur := Ind;
346
 
347
               for K in Pattern'Range loop
348
                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
349
                     goto Cont2;
350
                  else
351
                     Cur := Cur + 1;
352
                  end if;
353
               end loop;
354
 
355
               return Ind;
356
 
357
            <<Cont2>>
358
               Ind := Ind - 1;
359
            end loop;
360
         end if;
361
      end if;
362
 
363
      --  Fall through if no match found. Note that the loops are skipped
364
      --  completely in the case of the pattern being longer than the source.
365
 
366
      return 0;
367
   end Index;
368
 
369
   function Index
370
     (Source  : String;
371
      Pattern : String;
372
      Going   : Direction := Forward;
373
      Mapping : Maps.Character_Mapping_Function) return Natural
374
   is
375
      PL1 : constant Integer := Pattern'Length - 1;
376
      Ind : Natural;
377
      Cur : Natural;
378
 
379
   begin
380
      if Pattern = "" then
381
         raise Pattern_Error;
382
      end if;
383
 
384
      --  Check for null pointer in case checks are off
385
 
386
      if Mapping = null then
387
         raise Constraint_Error;
388
      end if;
389
 
390
      --  If Pattern longer than Source it can't be found
391
 
392
      if Pattern'Length > Source'Length then
393
         return 0;
394
      end if;
395
 
396
      --  Forwards case
397
 
398
      if Going = Forward then
399
         Ind := Source'First;
400
         for J in 1 .. Source'Length - PL1 loop
401
            Cur := Ind;
402
 
403
            for K in Pattern'Range loop
404
               if Pattern (K) /= Mapping.all (Source (Cur)) then
405
                  goto Cont1;
406
               else
407
                  Cur := Cur + 1;
408
               end if;
409
            end loop;
410
 
411
            return Ind;
412
 
413
         <<Cont1>>
414
            Ind := Ind + 1;
415
         end loop;
416
 
417
      --  Backwards case
418
 
419
      else
420
         Ind := Source'Last - PL1;
421
         for J in reverse 1 .. Source'Length - PL1 loop
422
            Cur := Ind;
423
 
424
            for K in Pattern'Range loop
425
               if Pattern (K) /= Mapping.all (Source (Cur)) then
426
                  goto Cont2;
427
               else
428
                  Cur := Cur + 1;
429
               end if;
430
            end loop;
431
 
432
            return Ind;
433
 
434
         <<Cont2>>
435
            Ind := Ind - 1;
436
         end loop;
437
      end if;
438
 
439
      --  Fall through if no match found. Note that the loops are skipped
440
      --  completely in the case of the pattern being longer than the source.
441
 
442
      return 0;
443
   end Index;
444
 
445
   function Index
446
     (Source : String;
447
      Set    : Maps.Character_Set;
448
      Test   : Membership := Inside;
449
      Going  : Direction  := Forward) return Natural
450
   is
451
   begin
452
      --  Forwards case
453
 
454
      if Going = Forward then
455
         for J in Source'Range loop
456
            if Belongs (Source (J), Set, Test) then
457
               return J;
458
            end if;
459
         end loop;
460
 
461
      --  Backwards case
462
 
463
      else
464
         for J in reverse Source'Range loop
465
            if Belongs (Source (J), Set, Test) then
466
               return J;
467
            end if;
468
         end loop;
469
      end if;
470
 
471
      --  Fall through if no match
472
 
473
      return 0;
474
   end Index;
475
 
476
   function Index
477
     (Source  : String;
478
      Pattern : String;
479
      From    : Positive;
480
      Going   : Direction := Forward;
481
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
482
   is
483
   begin
484
      if Going = Forward then
485
         if From < Source'First then
486
            raise Index_Error;
487
         end if;
488
 
489
         return
490
           Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
491
 
492
      else
493
         if From > Source'Last then
494
            raise Index_Error;
495
         end if;
496
 
497
         return
498
           Index (Source (Source'First .. From), Pattern, Backward, Mapping);
499
      end if;
500
   end Index;
501
 
502
   function Index
503
     (Source  : String;
504
      Pattern : String;
505
      From    : Positive;
506
      Going   : Direction := Forward;
507
      Mapping : Maps.Character_Mapping_Function) return Natural
508
   is
509
   begin
510
      if Going = Forward then
511
         if From < Source'First then
512
            raise Index_Error;
513
         end if;
514
 
515
         return Index
516
           (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 Index
524
           (Source (Source'First .. From), Pattern, Backward, Mapping);
525
      end if;
526
   end Index;
527
 
528
   function Index
529
     (Source  : String;
530
      Set     : Maps.Character_Set;
531
      From    : Positive;
532
      Test    : Membership := Inside;
533
      Going   : Direction := Forward) return Natural
534
   is
535
   begin
536
      if Going = Forward then
537
         if From < Source'First then
538
            raise Index_Error;
539
         end if;
540
 
541
         return
542
           Index (Source (From .. Source'Last), Set, Test, Forward);
543
 
544
      else
545
         if From > Source'Last then
546
            raise Index_Error;
547
         end if;
548
 
549
         return
550
           Index (Source (Source'First .. From), Set, Test, Backward);
551
      end if;
552
   end Index;
553
 
554
   ---------------------
555
   -- Index_Non_Blank --
556
   ---------------------
557
 
558
   function Index_Non_Blank
559
     (Source : String;
560
      Going  : Direction := Forward) return Natural
561
   is
562
   begin
563
      if Going = Forward then
564
         for J in Source'Range loop
565
            if Source (J) /= ' ' then
566
               return J;
567
            end if;
568
         end loop;
569
 
570
      else -- Going = Backward
571
         for J in reverse Source'Range loop
572
            if Source (J) /= ' ' then
573
               return J;
574
            end if;
575
         end loop;
576
      end if;
577
 
578
      --  Fall through if no match
579
 
580
      return 0;
581
   end Index_Non_Blank;
582
 
583
   function Index_Non_Blank
584
     (Source : String;
585
      From   : Positive;
586
      Going  : Direction := Forward) return Natural
587
   is
588
   begin
589
      if Going = Forward then
590
         if From < Source'First then
591
            raise Index_Error;
592
         end if;
593
 
594
         return
595
           Index_Non_Blank (Source (From .. Source'Last), Forward);
596
 
597
      else
598
         if From > Source'Last then
599
            raise Index_Error;
600
         end if;
601
 
602
         return
603
           Index_Non_Blank (Source (Source'First .. From), Backward);
604
      end if;
605
   end Index_Non_Blank;
606
 
607
end Ada.Strings.Search;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.