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

Subversion Repositories openrisc

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

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

powered by: WebSVN 2.1.0

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