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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-stwise.adb] - Blame information for rev 320

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

Line No. Rev Author Line
1 281 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-2009, 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
      Test   : Membership;
196
      First  : out Positive;
197
      Last   : out Natural)
198
   is
199
   begin
200
      for J in Source'Range loop
201
         if Belongs (Source (J), Set, Test) then
202
            First := J;
203
 
204
            for K in J + 1 .. Source'Last loop
205
               if not Belongs (Source (K), Set, Test) then
206
                  Last := K - 1;
207
                  return;
208
               end if;
209
            end loop;
210
 
211
            --  Here if J indexes first char of token, and all chars after J
212
            --  are in the token.
213
 
214
            Last := Source'Last;
215
            return;
216
         end if;
217
      end loop;
218
 
219
      --  Here if no token found
220
 
221
      First := Source'First;
222
      Last  := 0;
223
   end Find_Token;
224
 
225
   -----------
226
   -- Index --
227
   -----------
228
 
229
   function Index
230
     (Source  : Wide_String;
231
      Pattern : Wide_String;
232
      Going   : Direction := Forward;
233
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
234
      return Natural
235
   is
236
      PL1 : constant Integer := Pattern'Length - 1;
237
      Cur : Natural;
238
 
239
      Ind : Integer;
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.
244
 
245
   begin
246
      if Pattern = "" then
247
         raise Pattern_Error;
248
      end if;
249
 
250
      --  Forwards case
251
 
252
      if Going = Forward then
253
         Ind := Source'First;
254
 
255
         --  Unmapped forward case
256
 
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
260
                  return Ind;
261
               else
262
                  Ind := Ind + 1;
263
               end if;
264
            end loop;
265
 
266
         --  Mapped forward case
267
 
268
         else
269
            for J in 1 .. Source'Length - PL1 loop
270
               Cur := Ind;
271
 
272
               for K in Pattern'Range loop
273
                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
274
                     goto Cont1;
275
                  else
276
                     Cur := Cur + 1;
277
                  end if;
278
               end loop;
279
 
280
               return Ind;
281
 
282
            <<Cont1>>
283
               Ind := Ind + 1;
284
            end loop;
285
         end if;
286
 
287
      --  Backwards case
288
 
289
      else
290
         --  Unmapped backward case
291
 
292
         Ind := Source'Last - PL1;
293
 
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
297
                  return Ind;
298
               else
299
                  Ind := Ind - 1;
300
               end if;
301
            end loop;
302
 
303
         --  Mapped backward case
304
 
305
         else
306
            for J in reverse 1 .. Source'Length - PL1 loop
307
               Cur := Ind;
308
 
309
               for K in Pattern'Range loop
310
                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
311
                     goto Cont2;
312
                  else
313
                     Cur := Cur + 1;
314
                  end if;
315
               end loop;
316
 
317
               return Ind;
318
 
319
            <<Cont2>>
320
               Ind := Ind - 1;
321
            end loop;
322
         end if;
323
      end if;
324
 
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.
327
 
328
      return 0;
329
   end Index;
330
 
331
   function Index
332
     (Source  : Wide_String;
333
      Pattern : Wide_String;
334
      Going   : Direction := Forward;
335
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
336
   is
337
      PL1 : constant Integer := Pattern'Length - 1;
338
      Ind : Natural;
339
      Cur : Natural;
340
 
341
   begin
342
      if Pattern = "" then
343
         raise Pattern_Error;
344
      end if;
345
 
346
      --  Check for null pointer in case checks are off
347
 
348
      if Mapping = null then
349
         raise Constraint_Error;
350
      end if;
351
 
352
      --  If Pattern longer than Source it can't be found
353
 
354
      if Pattern'Length > Source'Length then
355
         return 0;
356
      end if;
357
 
358
      --  Forwards case
359
 
360
      if Going = Forward then
361
         Ind := Source'First;
362
         for J in 1 .. Source'Length - PL1 loop
363
            Cur := Ind;
364
 
365
            for K in Pattern'Range loop
366
               if Pattern (K) /= Mapping.all (Source (Cur)) then
367
                  goto Cont1;
368
               else
369
                  Cur := Cur + 1;
370
               end if;
371
            end loop;
372
 
373
            return Ind;
374
 
375
         <<Cont1>>
376
            Ind := Ind + 1;
377
         end loop;
378
 
379
      --  Backwards case
380
 
381
      else
382
         Ind := Source'Last - PL1;
383
         for J in reverse 1 .. Source'Length - PL1 loop
384
            Cur := Ind;
385
 
386
            for K in Pattern'Range loop
387
               if Pattern (K) /= Mapping.all (Source (Cur)) then
388
                  goto Cont2;
389
               else
390
                  Cur := Cur + 1;
391
               end if;
392
            end loop;
393
 
394
            return Ind;
395
 
396
         <<Cont2>>
397
            Ind := Ind - 1;
398
         end loop;
399
      end if;
400
 
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.
403
 
404
      return 0;
405
   end Index;
406
 
407
   function Index
408
     (Source : Wide_String;
409
      Set    : Wide_Maps.Wide_Character_Set;
410
      Test   : Membership := Inside;
411
      Going  : Direction  := Forward) return Natural
412
   is
413
   begin
414
      --  Forwards case
415
 
416
      if Going = Forward then
417
         for J in Source'Range loop
418
            if Belongs (Source (J), Set, Test) then
419
               return J;
420
            end if;
421
         end loop;
422
 
423
      --  Backwards case
424
 
425
      else
426
         for J in reverse Source'Range loop
427
            if Belongs (Source (J), Set, Test) then
428
               return J;
429
            end if;
430
         end loop;
431
      end if;
432
 
433
      --  Fall through if no match
434
 
435
      return 0;
436
   end Index;
437
 
438
   function Index
439
     (Source  : Wide_String;
440
      Pattern : Wide_String;
441
      From    : Positive;
442
      Going   : Direction := Forward;
443
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
444
      return Natural
445
   is
446
   begin
447
      if Going = Forward then
448
         if From < Source'First then
449
            raise Index_Error;
450
         end if;
451
 
452
         return
453
           Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
454
 
455
      else
456
         if From > Source'Last then
457
            raise Index_Error;
458
         end if;
459
 
460
         return
461
           Index (Source (Source'First .. From), Pattern, Backward, Mapping);
462
      end if;
463
   end Index;
464
 
465
   function Index
466
     (Source  : Wide_String;
467
      Pattern : Wide_String;
468
      From    : Positive;
469
      Going   : Direction := Forward;
470
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
471
   is
472
   begin
473
      if Going = Forward then
474
         if From < Source'First then
475
            raise Index_Error;
476
         end if;
477
 
478
         return Index
479
           (Source (From .. Source'Last), Pattern, Forward, Mapping);
480
 
481
      else
482
         if From > Source'Last then
483
            raise Index_Error;
484
         end if;
485
 
486
         return Index
487
           (Source (Source'First .. From), Pattern, Backward, Mapping);
488
      end if;
489
   end Index;
490
 
491
   function Index
492
     (Source  : Wide_String;
493
      Set     : Wide_Maps.Wide_Character_Set;
494
      From    : Positive;
495
      Test    : Membership := Inside;
496
      Going   : Direction := Forward) return Natural
497
   is
498
   begin
499
      if Going = Forward then
500
         if From < Source'First then
501
            raise Index_Error;
502
         end if;
503
 
504
         return
505
           Index (Source (From .. Source'Last), Set, Test, Forward);
506
 
507
      else
508
         if From > Source'Last then
509
            raise Index_Error;
510
         end if;
511
 
512
         return
513
           Index (Source (Source'First .. From), Set, Test, Backward);
514
      end if;
515
   end Index;
516
 
517
   ---------------------
518
   -- Index_Non_Blank --
519
   ---------------------
520
 
521
   function Index_Non_Blank
522
     (Source : Wide_String;
523
      Going  : Direction := Forward) return Natural
524
   is
525
   begin
526
      if Going = Forward then
527
         for J in Source'Range loop
528
            if Source (J) /= Wide_Space then
529
               return J;
530
            end if;
531
         end loop;
532
 
533
      else -- Going = Backward
534
         for J in reverse Source'Range loop
535
            if Source (J) /= Wide_Space then
536
               return J;
537
            end if;
538
         end loop;
539
      end if;
540
 
541
      --  Fall through if no match
542
 
543
      return 0;
544
   end Index_Non_Blank;
545
 
546
   function Index_Non_Blank
547
     (Source : Wide_String;
548
      From   : Positive;
549
      Going  : Direction := Forward) return Natural
550
   is
551
   begin
552
      if Going = Forward then
553
         if From < Source'First then
554
            raise Index_Error;
555
         end if;
556
 
557
         return
558
           Index_Non_Blank (Source (From .. Source'Last), Forward);
559
 
560
      else
561
         if From > Source'Last then
562
            raise Index_Error;
563
         end if;
564
 
565
         return
566
           Index_Non_Blank (Source (Source'First .. From), Backward);
567
      end if;
568
   end Index_Non_Blank;
569
 
570
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.