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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [a-stzsea.adb] - Blame information for rev 816

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

powered by: WebSVN 2.1.0

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