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

Subversion Repositories openrisc

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

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 . W I D E _ W I D E _ S U P E R B O U N D E D    --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2003-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_Wide_Maps;   use Ada.Strings.Wide_Wide_Maps;
33
with Ada.Strings.Wide_Wide_Search;
34
 
35
package body Ada.Strings.Wide_Wide_Superbounded is
36
 
37
   ------------
38
   -- Concat --
39
   ------------
40
 
41
   function Concat
42
     (Left  : Super_String;
43
      Right : Super_String) return Super_String
44
   is
45
      Result : Super_String (Left.Max_Length);
46
      Llen   : constant Natural := Left.Current_Length;
47
      Rlen   : constant Natural := Right.Current_Length;
48
      Nlen   : constant Natural := Llen + Rlen;
49
 
50
   begin
51
      if Nlen > Left.Max_Length then
52
         raise Ada.Strings.Length_Error;
53
      else
54
         Result.Current_Length := Nlen;
55
         Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
56
         Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
57
      end if;
58
 
59
      return Result;
60
   end Concat;
61
 
62
   function Concat
63
     (Left  : Super_String;
64
      Right : Wide_Wide_String) return Super_String
65
   is
66
      Result : Super_String (Left.Max_Length);
67
      Llen   : constant Natural := Left.Current_Length;
68
 
69
      Nlen   : constant Natural := Llen + Right'Length;
70
 
71
   begin
72
      if Nlen > Left.Max_Length then
73
         raise Ada.Strings.Length_Error;
74
      else
75
         Result.Current_Length := Nlen;
76
         Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
77
         Result.Data (Llen + 1 .. Nlen) := Right;
78
      end if;
79
      return Result;
80
   end Concat;
81
 
82
   function Concat
83
     (Left  : Wide_Wide_String;
84
      Right : Super_String) return Super_String
85
   is
86
      Result : Super_String (Right.Max_Length);
87
      Llen   : constant Natural := Left'Length;
88
      Rlen   : constant Natural := Right.Current_Length;
89
      Nlen   : constant Natural := Llen + Rlen;
90
 
91
   begin
92
      if Nlen > Right.Max_Length then
93
         raise Ada.Strings.Length_Error;
94
      else
95
         Result.Current_Length := Nlen;
96
         Result.Data (1 .. Llen) := Left;
97
         Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
98
      end if;
99
 
100
      return Result;
101
   end Concat;
102
 
103
   function Concat
104
     (Left  : Super_String;
105
      Right : Wide_Wide_Character) return Super_String
106
   is
107
      Result : Super_String (Left.Max_Length);
108
      Llen   : constant Natural := Left.Current_Length;
109
 
110
   begin
111
      if Llen = Left.Max_Length then
112
         raise Ada.Strings.Length_Error;
113
      else
114
         Result.Current_Length := Llen + 1;
115
         Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
116
         Result.Data (Result.Current_Length) := Right;
117
      end if;
118
 
119
      return Result;
120
   end Concat;
121
 
122
   function Concat
123
     (Left  : Wide_Wide_Character;
124
      Right : Super_String) return Super_String
125
   is
126
      Result : Super_String (Right.Max_Length);
127
      Rlen   : constant Natural := Right.Current_Length;
128
 
129
   begin
130
      if Rlen = Right.Max_Length then
131
         raise Ada.Strings.Length_Error;
132
      else
133
         Result.Current_Length := Rlen + 1;
134
         Result.Data (1) := Left;
135
         Result.Data (2 .. Result.Current_Length) := Right.Data (1 .. Rlen);
136
      end if;
137
 
138
      return Result;
139
   end Concat;
140
 
141
   -----------
142
   -- Equal --
143
   -----------
144
 
145
   function "="
146
     (Left  : Super_String;
147
      Right : Super_String) return Boolean
148
   is
149
   begin
150
      return Left.Current_Length = Right.Current_Length
151
        and then Left.Data (1 .. Left.Current_Length) =
152
                   Right.Data (1 .. Right.Current_Length);
153
   end "=";
154
 
155
   function Equal
156
     (Left  : Super_String;
157
      Right : Wide_Wide_String) return Boolean
158
   is
159
   begin
160
      return Left.Current_Length = Right'Length
161
        and then Left.Data (1 .. Left.Current_Length) = Right;
162
   end Equal;
163
 
164
   function Equal
165
     (Left  : Wide_Wide_String;
166
      Right : Super_String) return Boolean
167
   is
168
   begin
169
      return Left'Length = Right.Current_Length
170
        and then Left = Right.Data (1 .. Right.Current_Length);
171
   end Equal;
172
 
173
   -------------
174
   -- Greater --
175
   -------------
176
 
177
   function Greater
178
     (Left  : Super_String;
179
      Right : Super_String) return Boolean
180
   is
181
   begin
182
      return Left.Data (1 .. Left.Current_Length) >
183
               Right.Data (1 .. Right.Current_Length);
184
   end Greater;
185
 
186
   function Greater
187
     (Left  : Super_String;
188
      Right : Wide_Wide_String) return Boolean
189
   is
190
   begin
191
      return Left.Data (1 .. Left.Current_Length) > Right;
192
   end Greater;
193
 
194
   function Greater
195
     (Left  : Wide_Wide_String;
196
      Right : Super_String) return Boolean
197
   is
198
   begin
199
      return Left > Right.Data (1 .. Right.Current_Length);
200
   end Greater;
201
 
202
   ----------------------
203
   -- Greater_Or_Equal --
204
   ----------------------
205
 
206
   function Greater_Or_Equal
207
     (Left  : Super_String;
208
      Right : Super_String) return Boolean
209
   is
210
   begin
211
      return Left.Data (1 .. Left.Current_Length) >=
212
               Right.Data (1 .. Right.Current_Length);
213
   end Greater_Or_Equal;
214
 
215
   function Greater_Or_Equal
216
     (Left  : Super_String;
217
      Right : Wide_Wide_String) return Boolean
218
   is
219
   begin
220
      return Left.Data (1 .. Left.Current_Length) >= Right;
221
   end Greater_Or_Equal;
222
 
223
   function Greater_Or_Equal
224
     (Left  : Wide_Wide_String;
225
      Right : Super_String) return Boolean
226
   is
227
   begin
228
      return Left >= Right.Data (1 .. Right.Current_Length);
229
   end Greater_Or_Equal;
230
 
231
   ----------
232
   -- Less --
233
   ----------
234
 
235
   function Less
236
     (Left  : Super_String;
237
      Right : Super_String) return Boolean
238
   is
239
   begin
240
      return Left.Data (1 .. Left.Current_Length) <
241
               Right.Data (1 .. Right.Current_Length);
242
   end Less;
243
 
244
   function Less
245
     (Left  : Super_String;
246
      Right : Wide_Wide_String) return Boolean
247
   is
248
   begin
249
      return Left.Data (1 .. Left.Current_Length) < Right;
250
   end Less;
251
 
252
   function Less
253
     (Left  : Wide_Wide_String;
254
      Right : Super_String) return Boolean
255
   is
256
   begin
257
      return Left < Right.Data (1 .. Right.Current_Length);
258
   end Less;
259
 
260
   -------------------
261
   -- Less_Or_Equal --
262
   -------------------
263
 
264
   function Less_Or_Equal
265
     (Left  : Super_String;
266
      Right : Super_String) return Boolean
267
   is
268
   begin
269
      return Left.Data (1 .. Left.Current_Length) <=
270
               Right.Data (1 .. Right.Current_Length);
271
   end Less_Or_Equal;
272
 
273
   function Less_Or_Equal
274
     (Left  : Super_String;
275
      Right : Wide_Wide_String) return Boolean
276
   is
277
   begin
278
      return Left.Data (1 .. Left.Current_Length) <= Right;
279
   end Less_Or_Equal;
280
 
281
   function Less_Or_Equal
282
     (Left  : Wide_Wide_String;
283
      Right : Super_String) return Boolean
284
   is
285
   begin
286
      return Left <= Right.Data (1 .. Right.Current_Length);
287
   end Less_Or_Equal;
288
 
289
   ----------------------
290
   -- Set_Super_String --
291
   ----------------------
292
 
293
   procedure Set_Super_String
294
     (Target : out Super_String;
295
      Source : Wide_Wide_String;
296
      Drop   : Truncation := Error)
297
   is
298
      Slen       : constant Natural := Source'Length;
299
      Max_Length : constant Positive := Target.Max_Length;
300
 
301
   begin
302
      if Slen <= Max_Length then
303
         Target.Current_Length := Slen;
304
         Target.Data (1 .. Slen) := Source;
305
 
306
      else
307
         case Drop is
308
            when Strings.Right =>
309
               Target.Current_Length := Max_Length;
310
               Target.Data (1 .. Max_Length) :=
311
                 Source (Source'First .. Source'First - 1 + Max_Length);
312
 
313
            when Strings.Left =>
314
               Target.Current_Length := Max_Length;
315
               Target.Data (1 .. Max_Length) :=
316
                 Source (Source'Last - (Max_Length - 1) .. Source'Last);
317
 
318
            when Strings.Error =>
319
               raise Ada.Strings.Length_Error;
320
         end case;
321
      end if;
322
   end Set_Super_String;
323
 
324
   ------------------
325
   -- Super_Append --
326
   ------------------
327
 
328
   --  Case of Super_String and Super_String
329
 
330
   function Super_Append
331
     (Left  : Super_String;
332
      Right : Super_String;
333
      Drop  : Strings.Truncation := Strings.Error) return Super_String
334
   is
335
      Max_Length : constant Positive := Left.Max_Length;
336
      Result : Super_String (Max_Length);
337
      Llen   : constant Natural := Left.Current_Length;
338
      Rlen   : constant Natural := Right.Current_Length;
339
      Nlen   : constant Natural := Llen + Rlen;
340
 
341
   begin
342
      if Nlen <= Max_Length then
343
         Result.Current_Length := Nlen;
344
         Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
345
         Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
346
 
347
      else
348
         Result.Current_Length := Max_Length;
349
 
350
         case Drop is
351
            when Strings.Right =>
352
               if Llen >= Max_Length then -- only case is Llen = Max_Length
353
                  Result.Data := Left.Data;
354
 
355
               else
356
                  Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
357
                  Result.Data (Llen + 1 .. Max_Length) :=
358
                    Right.Data (1 .. Max_Length - Llen);
359
               end if;
360
 
361
            when Strings.Left =>
362
               if Rlen >= Max_Length then -- only case is Rlen = Max_Length
363
                  Result.Data := Right.Data;
364
 
365
               else
366
                  Result.Data (1 .. Max_Length - Rlen) :=
367
                    Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
368
                  Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
369
                    Right.Data (1 .. Rlen);
370
               end if;
371
 
372
            when Strings.Error =>
373
               raise Ada.Strings.Length_Error;
374
         end case;
375
      end if;
376
 
377
      return Result;
378
   end Super_Append;
379
 
380
   procedure Super_Append
381
     (Source   : in out Super_String;
382
      New_Item : Super_String;
383
      Drop     : Truncation := Error)
384
   is
385
      Max_Length : constant Positive := Source.Max_Length;
386
      Llen       : constant Natural := Source.Current_Length;
387
      Rlen       : constant Natural := New_Item.Current_Length;
388
      Nlen       : constant Natural := Llen + Rlen;
389
 
390
   begin
391
      if Nlen <= Max_Length then
392
         Source.Current_Length := Nlen;
393
         Source.Data (Llen + 1 .. Nlen) := New_Item.Data (1 .. Rlen);
394
 
395
      else
396
         Source.Current_Length := Max_Length;
397
 
398
         case Drop is
399
            when Strings.Right =>
400
               if Llen < Max_Length then
401
                  Source.Data (Llen + 1 .. Max_Length) :=
402
                    New_Item.Data (1 .. Max_Length - Llen);
403
               end if;
404
 
405
            when Strings.Left =>
406
               if Rlen >= Max_Length then -- only case is Rlen = Max_Length
407
                  Source.Data := New_Item.Data;
408
 
409
               else
410
                  Source.Data (1 .. Max_Length - Rlen) :=
411
                    Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
412
                  Source.Data (Max_Length - Rlen + 1 .. Max_Length) :=
413
                    New_Item.Data (1 .. Rlen);
414
               end if;
415
 
416
            when Strings.Error =>
417
               raise Ada.Strings.Length_Error;
418
         end case;
419
      end if;
420
 
421
   end Super_Append;
422
 
423
   --  Case of Super_String and Wide_Wide_String
424
 
425
   function Super_Append
426
     (Left  : Super_String;
427
      Right : Wide_Wide_String;
428
      Drop  : Strings.Truncation := Strings.Error) return Super_String
429
   is
430
      Max_Length : constant Positive := Left.Max_Length;
431
      Result : Super_String (Max_Length);
432
      Llen   : constant Natural := Left.Current_Length;
433
      Rlen   : constant Natural := Right'Length;
434
      Nlen   : constant Natural := Llen + Rlen;
435
 
436
   begin
437
      if Nlen <= Max_Length then
438
         Result.Current_Length := Nlen;
439
         Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
440
         Result.Data (Llen + 1 .. Nlen) := Right;
441
 
442
      else
443
         Result.Current_Length := Max_Length;
444
 
445
         case Drop is
446
            when Strings.Right =>
447
               if Llen >= Max_Length then -- only case is Llen = Max_Length
448
                  Result.Data := Left.Data;
449
 
450
               else
451
                  Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
452
                  Result.Data (Llen + 1 .. Max_Length) :=
453
                    Right (Right'First .. Right'First - 1 +
454
                             Max_Length - Llen);
455
 
456
               end if;
457
 
458
            when Strings.Left =>
459
               if Rlen >= Max_Length then
460
                  Result.Data (1 .. Max_Length) :=
461
                    Right (Right'Last - (Max_Length - 1) .. Right'Last);
462
 
463
               else
464
                  Result.Data (1 .. Max_Length - Rlen) :=
465
                    Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
466
                  Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
467
                    Right;
468
               end if;
469
 
470
            when Strings.Error =>
471
               raise Ada.Strings.Length_Error;
472
         end case;
473
      end if;
474
 
475
      return Result;
476
   end Super_Append;
477
 
478
   procedure Super_Append
479
     (Source   : in out Super_String;
480
      New_Item : Wide_Wide_String;
481
      Drop     : Truncation := Error)
482
   is
483
      Max_Length : constant Positive := Source.Max_Length;
484
      Llen   : constant Natural := Source.Current_Length;
485
      Rlen   : constant Natural := New_Item'Length;
486
      Nlen   : constant Natural := Llen + Rlen;
487
 
488
   begin
489
      if Nlen <= Max_Length then
490
         Source.Current_Length := Nlen;
491
         Source.Data (Llen + 1 .. Nlen) := New_Item;
492
 
493
      else
494
         Source.Current_Length := Max_Length;
495
 
496
         case Drop is
497
            when Strings.Right =>
498
               if Llen < Max_Length then
499
                  Source.Data (Llen + 1 .. Max_Length) :=
500
                    New_Item (New_Item'First ..
501
                                New_Item'First - 1 + Max_Length - Llen);
502
               end if;
503
 
504
            when Strings.Left =>
505
               if Rlen >= Max_Length then
506
                  Source.Data (1 .. Max_Length) :=
507
                    New_Item (New_Item'Last - (Max_Length - 1) ..
508
                                New_Item'Last);
509
 
510
               else
511
                  Source.Data (1 .. Max_Length - Rlen) :=
512
                    Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
513
                  Source.Data (Max_Length - Rlen + 1 .. Max_Length) :=
514
                    New_Item;
515
               end if;
516
 
517
            when Strings.Error =>
518
               raise Ada.Strings.Length_Error;
519
         end case;
520
      end if;
521
 
522
   end Super_Append;
523
 
524
   --  Case of Wide_Wide_String and Super_String
525
 
526
   function Super_Append
527
     (Left  : Wide_Wide_String;
528
      Right : Super_String;
529
      Drop  : Strings.Truncation := Strings.Error) return Super_String
530
   is
531
      Max_Length : constant Positive := Right.Max_Length;
532
      Result     : Super_String (Max_Length);
533
      Llen       : constant Natural := Left'Length;
534
      Rlen       : constant Natural := Right.Current_Length;
535
      Nlen       : constant Natural := Llen + Rlen;
536
 
537
   begin
538
      if Nlen <= Max_Length then
539
         Result.Current_Length := Nlen;
540
         Result.Data (1 .. Llen) := Left;
541
         Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen);
542
 
543
      else
544
         Result.Current_Length := Max_Length;
545
 
546
         case Drop is
547
            when Strings.Right =>
548
               if Llen >= Max_Length then
549
                  Result.Data (1 .. Max_Length) :=
550
                    Left (Left'First .. Left'First + (Max_Length - 1));
551
 
552
               else
553
                  Result.Data (1 .. Llen) := Left;
554
                  Result.Data (Llen + 1 .. Max_Length) :=
555
                    Right.Data (1 .. Max_Length - Llen);
556
               end if;
557
 
558
            when Strings.Left =>
559
               if Rlen >= Max_Length then
560
                  Result.Data (1 .. Max_Length) :=
561
                    Right.Data (Rlen - (Max_Length - 1) .. Rlen);
562
 
563
               else
564
                  Result.Data (1 .. Max_Length - Rlen) :=
565
                    Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last);
566
                  Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
567
                    Right.Data (1 .. Rlen);
568
               end if;
569
 
570
            when Strings.Error =>
571
               raise Ada.Strings.Length_Error;
572
         end case;
573
      end if;
574
 
575
      return Result;
576
   end Super_Append;
577
 
578
   --  Case of Super_String and Wide_Wide_Character
579
 
580
   function Super_Append
581
     (Left  : Super_String;
582
      Right : Wide_Wide_Character;
583
      Drop  : Strings.Truncation := Strings.Error) return Super_String
584
   is
585
      Max_Length : constant Positive := Left.Max_Length;
586
      Result     : Super_String (Max_Length);
587
      Llen       : constant Natural := Left.Current_Length;
588
 
589
   begin
590
      if Llen  < Max_Length then
591
         Result.Current_Length := Llen + 1;
592
         Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
593
         Result.Data (Llen + 1) := Right;
594
         return Result;
595
 
596
      else
597
         case Drop is
598
            when Strings.Right =>
599
               return Left;
600
 
601
            when Strings.Left =>
602
               Result.Current_Length := Max_Length;
603
               Result.Data (1 .. Max_Length - 1) :=
604
                 Left.Data (2 .. Max_Length);
605
               Result.Data (Max_Length) := Right;
606
               return Result;
607
 
608
            when Strings.Error =>
609
               raise Ada.Strings.Length_Error;
610
         end case;
611
      end if;
612
   end Super_Append;
613
 
614
   procedure Super_Append
615
     (Source   : in out Super_String;
616
      New_Item : Wide_Wide_Character;
617
      Drop     : Truncation := Error)
618
   is
619
      Max_Length : constant Positive := Source.Max_Length;
620
      Llen       : constant Natural  := Source.Current_Length;
621
 
622
   begin
623
      if Llen  < Max_Length then
624
         Source.Current_Length := Llen + 1;
625
         Source.Data (Llen + 1) := New_Item;
626
 
627
      else
628
         Source.Current_Length := Max_Length;
629
 
630
         case Drop is
631
            when Strings.Right =>
632
               null;
633
 
634
            when Strings.Left =>
635
               Source.Data (1 .. Max_Length - 1) :=
636
                 Source.Data (2 .. Max_Length);
637
               Source.Data (Max_Length) := New_Item;
638
 
639
            when Strings.Error =>
640
               raise Ada.Strings.Length_Error;
641
         end case;
642
      end if;
643
 
644
   end Super_Append;
645
 
646
   --  Case of Wide_Wide_Character and Super_String
647
 
648
   function Super_Append
649
     (Left  : Wide_Wide_Character;
650
      Right : Super_String;
651
      Drop  : Strings.Truncation := Strings.Error) return Super_String
652
   is
653
      Max_Length : constant Positive := Right.Max_Length;
654
      Result : Super_String (Max_Length);
655
      Rlen   : constant Natural := Right.Current_Length;
656
 
657
   begin
658
      if Rlen < Max_Length then
659
         Result.Current_Length := Rlen + 1;
660
         Result.Data (1) := Left;
661
         Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen);
662
         return Result;
663
 
664
      else
665
         case Drop is
666
            when Strings.Right =>
667
               Result.Current_Length := Max_Length;
668
               Result.Data (1) := Left;
669
               Result.Data (2 .. Max_Length) :=
670
                 Right.Data (1 .. Max_Length - 1);
671
               return Result;
672
 
673
            when Strings.Left =>
674
               return Right;
675
 
676
            when Strings.Error =>
677
               raise Ada.Strings.Length_Error;
678
         end case;
679
      end if;
680
   end Super_Append;
681
 
682
   -----------------
683
   -- Super_Count --
684
   -----------------
685
 
686
   function Super_Count
687
     (Source  : Super_String;
688
      Pattern : Wide_Wide_String;
689
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
690
                  Wide_Wide_Maps.Identity)
691
      return Natural
692
   is
693
   begin
694
      return
695
        Wide_Wide_Search.Count
696
          (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
697
   end Super_Count;
698
 
699
   function Super_Count
700
     (Source  : Super_String;
701
      Pattern : Wide_Wide_String;
702
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
703
      return Natural
704
   is
705
   begin
706
      return
707
        Wide_Wide_Search.Count
708
          (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
709
   end Super_Count;
710
 
711
   function Super_Count
712
     (Source : Super_String;
713
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
714
   is
715
   begin
716
      return Wide_Wide_Search.Count
717
               (Source.Data (1 .. Source.Current_Length), Set);
718
   end Super_Count;
719
 
720
   ------------------
721
   -- Super_Delete --
722
   ------------------
723
 
724
   function Super_Delete
725
     (Source  : Super_String;
726
      From    : Positive;
727
      Through : Natural) return Super_String
728
   is
729
      Result     : Super_String (Source.Max_Length);
730
      Slen       : constant Natural := Source.Current_Length;
731
      Num_Delete : constant Integer := Through - From + 1;
732
 
733
   begin
734
      if Num_Delete <= 0 then
735
         return Source;
736
 
737
      elsif From > Slen + 1 then
738
         raise Ada.Strings.Index_Error;
739
 
740
      elsif Through >= Slen then
741
         Result.Current_Length := From - 1;
742
         Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
743
         return Result;
744
 
745
      else
746
         Result.Current_Length := Slen - Num_Delete;
747
         Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
748
         Result.Data (From .. Result.Current_Length) :=
749
           Source.Data (Through + 1 .. Slen);
750
         return Result;
751
      end if;
752
   end Super_Delete;
753
 
754
   procedure Super_Delete
755
     (Source  : in out Super_String;
756
      From    : Positive;
757
      Through : Natural)
758
   is
759
      Slen       : constant Natural := Source.Current_Length;
760
      Num_Delete : constant Integer := Through - From + 1;
761
 
762
   begin
763
      if Num_Delete <= 0 then
764
         return;
765
 
766
      elsif From > Slen + 1 then
767
         raise Ada.Strings.Index_Error;
768
 
769
      elsif Through >= Slen then
770
         Source.Current_Length := From - 1;
771
 
772
      else
773
         Source.Current_Length := Slen - Num_Delete;
774
         Source.Data (From .. Source.Current_Length) :=
775
           Source.Data (Through + 1 .. Slen);
776
      end if;
777
   end Super_Delete;
778
 
779
   -------------------
780
   -- Super_Element --
781
   -------------------
782
 
783
   function Super_Element
784
     (Source : Super_String;
785
      Index  : Positive) return Wide_Wide_Character
786
   is
787
   begin
788
      if Index <= Source.Current_Length then
789
         return Source.Data (Index);
790
      else
791
         raise Strings.Index_Error;
792
      end if;
793
   end Super_Element;
794
 
795
   ----------------------
796
   -- Super_Find_Token --
797
   ----------------------
798
 
799
   procedure Super_Find_Token
800
     (Source : Super_String;
801
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
802
      From   : Positive;
803
      Test   : Strings.Membership;
804
      First  : out Positive;
805
      Last   : out Natural)
806
   is
807
   begin
808
      Wide_Wide_Search.Find_Token
809
        (Source.Data (From .. Source.Current_Length), Set, Test, First, Last);
810
   end Super_Find_Token;
811
 
812
   procedure Super_Find_Token
813
     (Source : Super_String;
814
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
815
      Test   : Strings.Membership;
816
      First  : out Positive;
817
      Last   : out Natural)
818
   is
819
   begin
820
      Wide_Wide_Search.Find_Token
821
        (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last);
822
   end Super_Find_Token;
823
 
824
   ----------------
825
   -- Super_Head --
826
   ----------------
827
 
828
   function Super_Head
829
     (Source : Super_String;
830
      Count  : Natural;
831
      Pad    : Wide_Wide_Character := Wide_Wide_Space;
832
      Drop   : Strings.Truncation := Strings.Error) return Super_String
833
   is
834
      Max_Length : constant Positive := Source.Max_Length;
835
      Result     : Super_String (Max_Length);
836
      Slen       : constant Natural := Source.Current_Length;
837
      Npad       : constant Integer := Count - Slen;
838
 
839
   begin
840
      if Npad <= 0 then
841
         Result.Current_Length := Count;
842
         Result.Data (1 .. Count) := Source.Data (1 .. Count);
843
 
844
      elsif Count <= Max_Length then
845
         Result.Current_Length := Count;
846
         Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
847
         Result.Data (Slen + 1 .. Count) := (others => Pad);
848
 
849
      else
850
         Result.Current_Length := Max_Length;
851
 
852
         case Drop is
853
            when Strings.Right =>
854
               Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
855
               Result.Data (Slen + 1 .. Max_Length) := (others => Pad);
856
 
857
            when Strings.Left =>
858
               if Npad >= Max_Length then
859
                  Result.Data := (others => Pad);
860
 
861
               else
862
                  Result.Data (1 .. Max_Length - Npad) :=
863
                    Source.Data (Count - Max_Length + 1 .. Slen);
864
                  Result.Data (Max_Length - Npad + 1 .. Max_Length) :=
865
                    (others => Pad);
866
               end if;
867
 
868
            when Strings.Error =>
869
               raise Ada.Strings.Length_Error;
870
         end case;
871
      end if;
872
 
873
      return Result;
874
   end Super_Head;
875
 
876
   procedure Super_Head
877
     (Source : in out Super_String;
878
      Count  : Natural;
879
      Pad    : Wide_Wide_Character  := Wide_Wide_Space;
880
      Drop   : Truncation := Error)
881
   is
882
      Max_Length : constant Positive := Source.Max_Length;
883
      Slen       : constant Natural  := Source.Current_Length;
884
      Npad       : constant Integer  := Count - Slen;
885
      Temp       : Wide_Wide_String (1 .. Max_Length);
886
 
887
   begin
888
      if Npad <= 0 then
889
         Source.Current_Length := Count;
890
 
891
      elsif Count <= Max_Length then
892
         Source.Current_Length := Count;
893
         Source.Data (Slen + 1 .. Count) := (others => Pad);
894
 
895
      else
896
         Source.Current_Length := Max_Length;
897
 
898
         case Drop is
899
            when Strings.Right =>
900
               Source.Data (Slen + 1 .. Max_Length) := (others => Pad);
901
 
902
            when Strings.Left =>
903
               if Npad > Max_Length then
904
                  Source.Data := (others => Pad);
905
 
906
               else
907
                  Temp := Source.Data;
908
                  Source.Data (1 .. Max_Length - Npad) :=
909
                    Temp (Count - Max_Length + 1 .. Slen);
910
 
911
                  for J in Max_Length - Npad + 1 .. Max_Length loop
912
                     Source.Data (J) := Pad;
913
                  end loop;
914
               end if;
915
 
916
            when Strings.Error =>
917
               raise Ada.Strings.Length_Error;
918
         end case;
919
      end if;
920
   end Super_Head;
921
 
922
   -----------------
923
   -- Super_Index --
924
   -----------------
925
 
926
   function Super_Index
927
     (Source  : Super_String;
928
      Pattern : Wide_Wide_String;
929
      Going   : Strings.Direction := Strings.Forward;
930
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
931
                  Wide_Wide_Maps.Identity)
932
      return Natural
933
   is
934
   begin
935
      return Wide_Wide_Search.Index
936
        (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
937
   end Super_Index;
938
 
939
   function Super_Index
940
     (Source  : Super_String;
941
      Pattern : Wide_Wide_String;
942
      Going   : Direction := Forward;
943
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
944
      return Natural
945
   is
946
   begin
947
      return Wide_Wide_Search.Index
948
        (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
949
   end Super_Index;
950
 
951
   function Super_Index
952
     (Source : Super_String;
953
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
954
      Test   : Strings.Membership := Strings.Inside;
955
      Going  : Strings.Direction  := Strings.Forward) return Natural
956
   is
957
   begin
958
      return Wide_Wide_Search.Index
959
        (Source.Data (1 .. Source.Current_Length), Set, Test, Going);
960
   end Super_Index;
961
 
962
   function Super_Index
963
     (Source  : Super_String;
964
      Pattern : Wide_Wide_String;
965
      From    : Positive;
966
      Going   : Direction := Forward;
967
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
968
                  Wide_Wide_Maps.Identity)
969
      return Natural
970
   is
971
   begin
972
      return Wide_Wide_Search.Index
973
        (Source.Data (1 .. Source.Current_Length),
974
         Pattern, From, Going, Mapping);
975
   end Super_Index;
976
 
977
   function Super_Index
978
     (Source  : Super_String;
979
      Pattern : Wide_Wide_String;
980
      From    : Positive;
981
      Going   : Direction := Forward;
982
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
983
      return Natural
984
   is
985
   begin
986
      return Wide_Wide_Search.Index
987
        (Source.Data (1 .. Source.Current_Length),
988
         Pattern, From, Going, Mapping);
989
   end Super_Index;
990
 
991
   function Super_Index
992
     (Source : Super_String;
993
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
994
      From   : Positive;
995
      Test   : Membership := Inside;
996
      Going  : Direction := Forward) return Natural
997
   is
998
   begin
999
      return Wide_Wide_Search.Index
1000
        (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going);
1001
   end Super_Index;
1002
 
1003
   ---------------------------
1004
   -- Super_Index_Non_Blank --
1005
   ---------------------------
1006
 
1007
   function Super_Index_Non_Blank
1008
     (Source : Super_String;
1009
      Going  : Strings.Direction := Strings.Forward) return Natural
1010
   is
1011
   begin
1012
      return
1013
        Wide_Wide_Search.Index_Non_Blank
1014
          (Source.Data (1 .. Source.Current_Length), Going);
1015
   end Super_Index_Non_Blank;
1016
 
1017
   function Super_Index_Non_Blank
1018
     (Source : Super_String;
1019
      From   : Positive;
1020
      Going  : Direction := Forward) return Natural
1021
   is
1022
   begin
1023
      return
1024
        Wide_Wide_Search.Index_Non_Blank
1025
          (Source.Data (1 .. Source.Current_Length), From, Going);
1026
   end Super_Index_Non_Blank;
1027
 
1028
   ------------------
1029
   -- Super_Insert --
1030
   ------------------
1031
 
1032
   function Super_Insert
1033
     (Source   : Super_String;
1034
      Before   : Positive;
1035
      New_Item : Wide_Wide_String;
1036
      Drop     : Strings.Truncation := Strings.Error) return Super_String
1037
   is
1038
      Max_Length : constant Positive := Source.Max_Length;
1039
      Result     : Super_String (Max_Length);
1040
      Slen       : constant Natural := Source.Current_Length;
1041
      Nlen       : constant Natural := New_Item'Length;
1042
      Tlen       : constant Natural := Slen + Nlen;
1043
      Blen       : constant Natural := Before - 1;
1044
      Alen       : constant Integer := Slen - Blen;
1045
      Droplen    : constant Integer := Tlen - Max_Length;
1046
 
1047
      --  Tlen is the length of the total string before possible truncation.
1048
      --  Blen, Alen are the lengths of the before and after pieces of the
1049
      --  source string.
1050
 
1051
   begin
1052
      if Alen < 0 then
1053
         raise Ada.Strings.Index_Error;
1054
 
1055
      elsif Droplen <= 0 then
1056
         Result.Current_Length := Tlen;
1057
         Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1058
         Result.Data (Before .. Before + Nlen - 1) := New_Item;
1059
         Result.Data (Before + Nlen .. Tlen) :=
1060
           Source.Data (Before .. Slen);
1061
 
1062
      else
1063
         Result.Current_Length := Max_Length;
1064
 
1065
         case Drop is
1066
            when Strings.Right =>
1067
               Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1068
 
1069
               if Droplen > Alen then
1070
                  Result.Data (Before .. Max_Length) :=
1071
                    New_Item (New_Item'First
1072
                                .. New_Item'First + Max_Length - Before);
1073
               else
1074
                  Result.Data (Before .. Before + Nlen - 1) := New_Item;
1075
                  Result.Data (Before + Nlen .. Max_Length) :=
1076
                    Source.Data (Before .. Slen - Droplen);
1077
               end if;
1078
 
1079
            when Strings.Left =>
1080
               Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1081
                 Source.Data (Before .. Slen);
1082
 
1083
               if Droplen >= Blen then
1084
                  Result.Data (1 .. Max_Length - Alen) :=
1085
                    New_Item (New_Item'Last - (Max_Length - Alen) + 1
1086
                                .. New_Item'Last);
1087
               else
1088
                  Result.Data
1089
                    (Blen - Droplen + 1 .. Max_Length - Alen) :=
1090
                    New_Item;
1091
                  Result.Data (1 .. Blen - Droplen) :=
1092
                    Source.Data (Droplen + 1 .. Blen);
1093
               end if;
1094
 
1095
            when Strings.Error =>
1096
               raise Ada.Strings.Length_Error;
1097
         end case;
1098
      end if;
1099
 
1100
      return Result;
1101
   end Super_Insert;
1102
 
1103
   procedure Super_Insert
1104
     (Source   : in out Super_String;
1105
      Before   : Positive;
1106
      New_Item : Wide_Wide_String;
1107
      Drop     : Strings.Truncation := Strings.Error)
1108
   is
1109
   begin
1110
      --  We do a double copy here because this is one of the situations
1111
      --  in which we move data to the right, and at least at the moment,
1112
      --  GNAT is not handling such cases correctly ???
1113
 
1114
      Source := Super_Insert (Source, Before, New_Item, Drop);
1115
   end Super_Insert;
1116
 
1117
   ------------------
1118
   -- Super_Length --
1119
   ------------------
1120
 
1121
   function Super_Length (Source : Super_String) return Natural is
1122
   begin
1123
      return Source.Current_Length;
1124
   end Super_Length;
1125
 
1126
   ---------------------
1127
   -- Super_Overwrite --
1128
   ---------------------
1129
 
1130
   function Super_Overwrite
1131
     (Source   : Super_String;
1132
      Position : Positive;
1133
      New_Item : Wide_Wide_String;
1134
      Drop     : Strings.Truncation := Strings.Error) return Super_String
1135
   is
1136
      Max_Length : constant Positive := Source.Max_Length;
1137
      Result     : Super_String (Max_Length);
1138
      Endpos     : constant Natural  := Position + New_Item'Length - 1;
1139
      Slen       : constant Natural  := Source.Current_Length;
1140
      Droplen    : Natural;
1141
 
1142
   begin
1143
      if Position > Slen + 1 then
1144
         raise Ada.Strings.Index_Error;
1145
 
1146
      elsif New_Item'Length = 0 then
1147
         return Source;
1148
 
1149
      elsif Endpos <= Slen then
1150
         Result.Current_Length := Source.Current_Length;
1151
         Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
1152
         Result.Data (Position .. Endpos) := New_Item;
1153
         return Result;
1154
 
1155
      elsif Endpos <= Max_Length then
1156
         Result.Current_Length := Endpos;
1157
         Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1);
1158
         Result.Data (Position .. Endpos) := New_Item;
1159
         return Result;
1160
 
1161
      else
1162
         Result.Current_Length := Max_Length;
1163
         Droplen := Endpos - Max_Length;
1164
 
1165
         case Drop is
1166
            when Strings.Right =>
1167
               Result.Data (1 .. Position - 1) :=
1168
                 Source.Data (1 .. Position - 1);
1169
 
1170
               Result.Data (Position .. Max_Length) :=
1171
                 New_Item (New_Item'First .. New_Item'Last - Droplen);
1172
               return Result;
1173
 
1174
            when Strings.Left =>
1175
               if New_Item'Length >= Max_Length then
1176
                  Result.Data (1 .. Max_Length) :=
1177
                    New_Item (New_Item'Last - Max_Length + 1 ..
1178
                                New_Item'Last);
1179
                  return Result;
1180
 
1181
               else
1182
                  Result.Data (1 .. Max_Length - New_Item'Length) :=
1183
                    Source.Data (Droplen + 1 .. Position - 1);
1184
                  Result.Data
1185
                    (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1186
                    New_Item;
1187
                  return Result;
1188
               end if;
1189
 
1190
            when Strings.Error =>
1191
               raise Ada.Strings.Length_Error;
1192
         end case;
1193
      end if;
1194
   end Super_Overwrite;
1195
 
1196
   procedure Super_Overwrite
1197
     (Source    : in out Super_String;
1198
      Position  : Positive;
1199
      New_Item  : Wide_Wide_String;
1200
      Drop      : Strings.Truncation := Strings.Error)
1201
   is
1202
      Max_Length : constant Positive := Source.Max_Length;
1203
      Endpos     : constant Positive := Position + New_Item'Length - 1;
1204
      Slen       : constant Natural  := Source.Current_Length;
1205
      Droplen    : Natural;
1206
 
1207
   begin
1208
      if Position > Slen + 1 then
1209
         raise Ada.Strings.Index_Error;
1210
 
1211
      elsif Endpos <= Slen then
1212
         Source.Data (Position .. Endpos) := New_Item;
1213
 
1214
      elsif Endpos <= Max_Length then
1215
         Source.Data (Position .. Endpos) := New_Item;
1216
         Source.Current_Length := Endpos;
1217
 
1218
      else
1219
         Source.Current_Length := Max_Length;
1220
         Droplen := Endpos - Max_Length;
1221
 
1222
         case Drop is
1223
            when Strings.Right =>
1224
               Source.Data (Position .. Max_Length) :=
1225
                 New_Item (New_Item'First .. New_Item'Last - Droplen);
1226
 
1227
            when Strings.Left =>
1228
               if New_Item'Length > Max_Length then
1229
                  Source.Data (1 .. Max_Length) :=
1230
                    New_Item (New_Item'Last - Max_Length + 1 ..
1231
                                New_Item'Last);
1232
 
1233
               else
1234
                  Source.Data (1 .. Max_Length - New_Item'Length) :=
1235
                    Source.Data (Droplen + 1 .. Position - 1);
1236
 
1237
                  Source.Data
1238
                    (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1239
                    New_Item;
1240
               end if;
1241
 
1242
            when Strings.Error =>
1243
               raise Ada.Strings.Length_Error;
1244
         end case;
1245
      end if;
1246
   end Super_Overwrite;
1247
 
1248
   ---------------------------
1249
   -- Super_Replace_Element --
1250
   ---------------------------
1251
 
1252
   procedure Super_Replace_Element
1253
     (Source : in out Super_String;
1254
      Index  : Positive;
1255
      By     : Wide_Wide_Character)
1256
   is
1257
   begin
1258
      if Index <= Source.Current_Length then
1259
         Source.Data (Index) := By;
1260
      else
1261
         raise Ada.Strings.Index_Error;
1262
      end if;
1263
   end Super_Replace_Element;
1264
 
1265
   -------------------------
1266
   -- Super_Replace_Slice --
1267
   -------------------------
1268
 
1269
   function Super_Replace_Slice
1270
     (Source : Super_String;
1271
      Low    : Positive;
1272
      High   : Natural;
1273
      By     : Wide_Wide_String;
1274
      Drop   : Strings.Truncation := Strings.Error) return Super_String
1275
   is
1276
      Max_Length : constant Positive := Source.Max_Length;
1277
      Slen       : constant Natural  := Source.Current_Length;
1278
 
1279
   begin
1280
      if Low > Slen + 1 then
1281
         raise Strings.Index_Error;
1282
 
1283
      elsif High < Low then
1284
         return Super_Insert (Source, Low, By, Drop);
1285
 
1286
      else
1287
         declare
1288
            Blen    : constant Natural := Natural'Max (0, Low - 1);
1289
            Alen    : constant Natural := Natural'Max (0, Slen - High);
1290
            Tlen    : constant Natural := Blen + By'Length + Alen;
1291
            Droplen : constant Integer := Tlen - Max_Length;
1292
            Result  : Super_String (Max_Length);
1293
 
1294
            --  Tlen is the total length of the result string before any
1295
            --  truncation. Blen and Alen are the lengths of the pieces
1296
            --  of the original string that end up in the result string
1297
            --  before and after the replaced slice.
1298
 
1299
         begin
1300
            if Droplen <= 0 then
1301
               Result.Current_Length := Tlen;
1302
               Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1303
               Result.Data (Low .. Low + By'Length - 1) := By;
1304
               Result.Data (Low + By'Length .. Tlen) :=
1305
                 Source.Data (High + 1 .. Slen);
1306
 
1307
            else
1308
               Result.Current_Length := Max_Length;
1309
 
1310
               case Drop is
1311
                  when Strings.Right =>
1312
                     Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1313
 
1314
                     if Droplen > Alen then
1315
                        Result.Data (Low .. Max_Length) :=
1316
                          By (By'First .. By'First + Max_Length - Low);
1317
                     else
1318
                        Result.Data (Low .. Low + By'Length - 1) := By;
1319
                        Result.Data (Low + By'Length .. Max_Length) :=
1320
                          Source.Data (High + 1 .. Slen - Droplen);
1321
                     end if;
1322
 
1323
                  when Strings.Left =>
1324
                     Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1325
                       Source.Data (High + 1 .. Slen);
1326
 
1327
                     if Droplen >= Blen then
1328
                        Result.Data (1 .. Max_Length - Alen) :=
1329
                          By (By'Last - (Max_Length - Alen) + 1 .. By'Last);
1330
                     else
1331
                        Result.Data
1332
                          (Blen - Droplen + 1 .. Max_Length - Alen) := By;
1333
                        Result.Data (1 .. Blen - Droplen) :=
1334
                          Source.Data (Droplen + 1 .. Blen);
1335
                     end if;
1336
 
1337
                  when Strings.Error =>
1338
                     raise Ada.Strings.Length_Error;
1339
               end case;
1340
            end if;
1341
 
1342
            return Result;
1343
         end;
1344
      end if;
1345
   end Super_Replace_Slice;
1346
 
1347
   procedure Super_Replace_Slice
1348
     (Source   : in out Super_String;
1349
      Low      : Positive;
1350
      High     : Natural;
1351
      By       : Wide_Wide_String;
1352
      Drop     : Strings.Truncation := Strings.Error)
1353
   is
1354
   begin
1355
      --  We do a double copy here because this is one of the situations
1356
      --  in which we move data to the right, and at least at the moment,
1357
      --  GNAT is not handling such cases correctly ???
1358
 
1359
      Source := Super_Replace_Slice (Source, Low, High, By, Drop);
1360
   end Super_Replace_Slice;
1361
 
1362
   ---------------------
1363
   -- Super_Replicate --
1364
   ---------------------
1365
 
1366
   function Super_Replicate
1367
     (Count      : Natural;
1368
      Item       : Wide_Wide_Character;
1369
      Drop       : Truncation := Error;
1370
      Max_Length : Positive) return Super_String
1371
   is
1372
      Result : Super_String (Max_Length);
1373
 
1374
   begin
1375
      if Count <= Max_Length then
1376
         Result.Current_Length := Count;
1377
 
1378
      elsif Drop = Strings.Error then
1379
         raise Ada.Strings.Length_Error;
1380
 
1381
      else
1382
         Result.Current_Length := Max_Length;
1383
      end if;
1384
 
1385
      Result.Data (1 .. Result.Current_Length) := (others => Item);
1386
      return Result;
1387
   end Super_Replicate;
1388
 
1389
   function Super_Replicate
1390
     (Count      : Natural;
1391
      Item       : Wide_Wide_String;
1392
      Drop       : Truncation := Error;
1393
      Max_Length : Positive) return Super_String
1394
   is
1395
      Length : constant Integer := Count * Item'Length;
1396
      Result : Super_String (Max_Length);
1397
      Indx   : Positive;
1398
 
1399
   begin
1400
      if Length <= Max_Length then
1401
         Result.Current_Length := Length;
1402
 
1403
         if Length > 0 then
1404
            Indx := 1;
1405
 
1406
            for J in 1 .. Count loop
1407
               Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1408
               Indx := Indx + Item'Length;
1409
            end loop;
1410
         end if;
1411
 
1412
      else
1413
         Result.Current_Length := Max_Length;
1414
 
1415
         case Drop is
1416
            when Strings.Right =>
1417
               Indx := 1;
1418
 
1419
               while Indx + Item'Length <= Max_Length + 1 loop
1420
                  Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1421
                  Indx := Indx + Item'Length;
1422
               end loop;
1423
 
1424
               Result.Data (Indx .. Max_Length) :=
1425
                 Item (Item'First .. Item'First + Max_Length - Indx);
1426
 
1427
            when Strings.Left =>
1428
               Indx := Max_Length;
1429
 
1430
               while Indx - Item'Length >= 1 loop
1431
                  Result.Data (Indx - (Item'Length - 1) .. Indx) := Item;
1432
                  Indx := Indx - Item'Length;
1433
               end loop;
1434
 
1435
               Result.Data (1 .. Indx) :=
1436
                 Item (Item'Last - Indx + 1 .. Item'Last);
1437
 
1438
            when Strings.Error =>
1439
               raise Ada.Strings.Length_Error;
1440
         end case;
1441
      end if;
1442
 
1443
      return Result;
1444
   end Super_Replicate;
1445
 
1446
   function Super_Replicate
1447
     (Count : Natural;
1448
      Item  : Super_String;
1449
      Drop  : Strings.Truncation := Strings.Error) return Super_String
1450
   is
1451
   begin
1452
      return
1453
        Super_Replicate
1454
          (Count,
1455
           Item.Data (1 .. Item.Current_Length),
1456
           Drop,
1457
           Item.Max_Length);
1458
   end Super_Replicate;
1459
 
1460
   -----------------
1461
   -- Super_Slice --
1462
   -----------------
1463
 
1464
   function Super_Slice
1465
     (Source : Super_String;
1466
      Low    : Positive;
1467
      High   : Natural) return Wide_Wide_String
1468
   is
1469
   begin
1470
      --  Note: test of High > Length is in accordance with AI95-00128
1471
 
1472
      if Low > Source.Current_Length + 1
1473
        or else High > Source.Current_Length
1474
      then
1475
         raise Index_Error;
1476
      else
1477
         return Source.Data (Low .. High);
1478
      end if;
1479
   end Super_Slice;
1480
 
1481
   function Super_Slice
1482
     (Source : Super_String;
1483
      Low    : Positive;
1484
      High   : Natural) return Super_String
1485
   is
1486
      Result : Super_String (Source.Max_Length);
1487
 
1488
   begin
1489
      if Low > Source.Current_Length + 1
1490
        or else High > Source.Current_Length
1491
      then
1492
         raise Index_Error;
1493
      else
1494
         Result.Current_Length := High - Low + 1;
1495
         Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
1496
      end if;
1497
 
1498
      return Result;
1499
   end Super_Slice;
1500
 
1501
   procedure Super_Slice
1502
     (Source : Super_String;
1503
      Target : out Super_String;
1504
      Low    : Positive;
1505
      High   : Natural)
1506
   is
1507
   begin
1508
      if Low > Source.Current_Length + 1
1509
        or else High > Source.Current_Length
1510
      then
1511
         raise Index_Error;
1512
      else
1513
         Target.Current_Length := High - Low + 1;
1514
         Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High);
1515
      end if;
1516
   end Super_Slice;
1517
 
1518
   ----------------
1519
   -- Super_Tail --
1520
   ----------------
1521
 
1522
   function Super_Tail
1523
     (Source : Super_String;
1524
      Count  : Natural;
1525
      Pad    : Wide_Wide_Character := Wide_Wide_Space;
1526
      Drop   : Strings.Truncation := Strings.Error) return Super_String
1527
   is
1528
      Max_Length : constant Positive := Source.Max_Length;
1529
      Result     : Super_String (Max_Length);
1530
      Slen       : constant Natural := Source.Current_Length;
1531
      Npad       : constant Integer := Count - Slen;
1532
 
1533
   begin
1534
      if Npad <= 0 then
1535
         Result.Current_Length := Count;
1536
         Result.Data (1 .. Count) :=
1537
           Source.Data (Slen - (Count - 1) .. Slen);
1538
 
1539
      elsif Count <= Max_Length then
1540
         Result.Current_Length := Count;
1541
         Result.Data (1 .. Npad) := (others => Pad);
1542
         Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen);
1543
 
1544
      else
1545
         Result.Current_Length := Max_Length;
1546
 
1547
         case Drop is
1548
            when Strings.Right =>
1549
               if Npad >= Max_Length then
1550
                  Result.Data := (others => Pad);
1551
 
1552
               else
1553
                  Result.Data (1 .. Npad) := (others => Pad);
1554
                  Result.Data (Npad + 1 .. Max_Length) :=
1555
                    Source.Data (1 .. Max_Length - Npad);
1556
               end if;
1557
 
1558
            when Strings.Left =>
1559
               Result.Data (1 .. Max_Length - Slen) := (others => Pad);
1560
               Result.Data (Max_Length - Slen + 1 .. Max_Length) :=
1561
                 Source.Data (1 .. Slen);
1562
 
1563
            when Strings.Error =>
1564
               raise Ada.Strings.Length_Error;
1565
         end case;
1566
      end if;
1567
 
1568
      return Result;
1569
   end Super_Tail;
1570
 
1571
   procedure Super_Tail
1572
     (Source : in out Super_String;
1573
      Count  : Natural;
1574
      Pad    : Wide_Wide_Character := Wide_Wide_Space;
1575
      Drop   : Truncation := Error)
1576
   is
1577
      Max_Length : constant Positive := Source.Max_Length;
1578
      Slen       : constant Natural  := Source.Current_Length;
1579
      Npad       : constant Integer  := Count - Slen;
1580
 
1581
      Temp : constant Wide_Wide_String (1 .. Max_Length) := Source.Data;
1582
 
1583
   begin
1584
      if Npad <= 0 then
1585
         Source.Current_Length := Count;
1586
         Source.Data (1 .. Count) :=
1587
           Temp (Slen - (Count - 1) .. Slen);
1588
 
1589
      elsif Count <= Max_Length then
1590
         Source.Current_Length := Count;
1591
         Source.Data (1 .. Npad) := (others => Pad);
1592
         Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen);
1593
 
1594
      else
1595
         Source.Current_Length := Max_Length;
1596
 
1597
         case Drop is
1598
            when Strings.Right =>
1599
               if Npad >= Max_Length then
1600
                  Source.Data := (others => Pad);
1601
 
1602
               else
1603
                  Source.Data (1 .. Npad) := (others => Pad);
1604
                  Source.Data (Npad + 1 .. Max_Length) :=
1605
                    Temp (1 .. Max_Length - Npad);
1606
               end if;
1607
 
1608
            when Strings.Left =>
1609
               for J in 1 .. Max_Length - Slen loop
1610
                  Source.Data (J) := Pad;
1611
               end loop;
1612
 
1613
               Source.Data (Max_Length - Slen + 1 .. Max_Length) :=
1614
                 Temp (1 .. Slen);
1615
 
1616
            when Strings.Error =>
1617
               raise Ada.Strings.Length_Error;
1618
         end case;
1619
      end if;
1620
   end Super_Tail;
1621
 
1622
   ---------------------
1623
   -- Super_To_String --
1624
   ---------------------
1625
 
1626
   function Super_To_String
1627
     (Source : Super_String) return Wide_Wide_String
1628
   is
1629
   begin
1630
      return Source.Data (1 .. Source.Current_Length);
1631
   end Super_To_String;
1632
 
1633
   ---------------------
1634
   -- Super_Translate --
1635
   ---------------------
1636
 
1637
   function Super_Translate
1638
     (Source  : Super_String;
1639
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1640
      return Super_String
1641
   is
1642
      Result : Super_String (Source.Max_Length);
1643
 
1644
   begin
1645
      Result.Current_Length := Source.Current_Length;
1646
 
1647
      for J in 1 .. Source.Current_Length loop
1648
         Result.Data (J) := Value (Mapping, Source.Data (J));
1649
      end loop;
1650
 
1651
      return Result;
1652
   end Super_Translate;
1653
 
1654
   procedure Super_Translate
1655
     (Source  : in out Super_String;
1656
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1657
   is
1658
   begin
1659
      for J in 1 .. Source.Current_Length loop
1660
         Source.Data (J) := Value (Mapping, Source.Data (J));
1661
      end loop;
1662
   end Super_Translate;
1663
 
1664
   function Super_Translate
1665
     (Source  : Super_String;
1666
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1667
      return Super_String
1668
   is
1669
      Result : Super_String (Source.Max_Length);
1670
 
1671
   begin
1672
      Result.Current_Length := Source.Current_Length;
1673
 
1674
      for J in 1 .. Source.Current_Length loop
1675
         Result.Data (J) := Mapping.all (Source.Data (J));
1676
      end loop;
1677
 
1678
      return Result;
1679
   end Super_Translate;
1680
 
1681
   procedure Super_Translate
1682
     (Source  : in out Super_String;
1683
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1684
   is
1685
   begin
1686
      for J in 1 .. Source.Current_Length loop
1687
         Source.Data (J) := Mapping.all (Source.Data (J));
1688
      end loop;
1689
   end Super_Translate;
1690
 
1691
   ----------------
1692
   -- Super_Trim --
1693
   ----------------
1694
 
1695
   function Super_Trim
1696
     (Source : Super_String;
1697
      Side   : Trim_End) return Super_String
1698
   is
1699
      Result : Super_String (Source.Max_Length);
1700
      Last   : Natural := Source.Current_Length;
1701
      First  : Positive := 1;
1702
 
1703
   begin
1704
      if Side = Left or else Side = Both then
1705
         while First <= Last and then Source.Data (First) = ' ' loop
1706
            First := First + 1;
1707
         end loop;
1708
      end if;
1709
 
1710
      if Side = Right or else Side = Both then
1711
         while Last >= First and then Source.Data (Last) = ' ' loop
1712
            Last := Last - 1;
1713
         end loop;
1714
      end if;
1715
 
1716
      Result.Current_Length := Last - First + 1;
1717
      Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last);
1718
      return Result;
1719
   end Super_Trim;
1720
 
1721
   procedure Super_Trim
1722
     (Source : in out Super_String;
1723
      Side   : Trim_End)
1724
   is
1725
      Max_Length : constant Positive := Source.Max_Length;
1726
      Last       : Natural           := Source.Current_Length;
1727
      First      : Positive          := 1;
1728
      Temp       : Wide_Wide_String (1 .. Max_Length);
1729
 
1730
   begin
1731
      Temp (1 .. Last) := Source.Data (1 .. Last);
1732
 
1733
      if Side = Left or else Side = Both then
1734
         while First <= Last and then Temp (First) = ' ' loop
1735
            First := First + 1;
1736
         end loop;
1737
      end if;
1738
 
1739
      if Side = Right or else Side = Both then
1740
         while Last >= First and then Temp (Last) = ' ' loop
1741
            Last := Last - 1;
1742
         end loop;
1743
      end if;
1744
 
1745
      Source.Data := (others => Wide_Wide_NUL);
1746
      Source.Current_Length := Last - First + 1;
1747
      Source.Data (1 .. Source.Current_Length) := Temp (First .. Last);
1748
   end Super_Trim;
1749
 
1750
   function Super_Trim
1751
     (Source : Super_String;
1752
      Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1753
      Right  : Wide_Wide_Maps.Wide_Wide_Character_Set) return Super_String
1754
   is
1755
      Result : Super_String (Source.Max_Length);
1756
 
1757
   begin
1758
      for First in 1 .. Source.Current_Length loop
1759
         if not Is_In (Source.Data (First), Left) then
1760
            for Last in reverse First .. Source.Current_Length loop
1761
               if not Is_In (Source.Data (Last), Right) then
1762
                  Result.Current_Length := Last - First + 1;
1763
                  Result.Data (1 .. Result.Current_Length) :=
1764
                    Source.Data (First .. Last);
1765
                  return Result;
1766
               end if;
1767
            end loop;
1768
         end if;
1769
      end loop;
1770
 
1771
      Result.Current_Length := 0;
1772
      return Result;
1773
   end Super_Trim;
1774
 
1775
   procedure Super_Trim
1776
     (Source : in out Super_String;
1777
      Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1778
      Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1779
   is
1780
   begin
1781
      for First in 1 .. Source.Current_Length loop
1782
         if not Is_In (Source.Data (First), Left) then
1783
            for Last in reverse First .. Source.Current_Length loop
1784
               if not Is_In (Source.Data (Last), Right) then
1785
                  if First = 1 then
1786
                     Source.Current_Length := Last;
1787
                     return;
1788
                  else
1789
                     Source.Current_Length := Last - First + 1;
1790
                     Source.Data (1 .. Source.Current_Length) :=
1791
                       Source.Data (First .. Last);
1792
 
1793
                     for J in Source.Current_Length + 1 ..
1794
                                Source.Max_Length
1795
                     loop
1796
                        Source.Data (J) := Wide_Wide_NUL;
1797
                     end loop;
1798
 
1799
                     return;
1800
                  end if;
1801
               end if;
1802
            end loop;
1803
 
1804
            Source.Current_Length := 0;
1805
            return;
1806
         end if;
1807
      end loop;
1808
 
1809
      Source.Current_Length := 0;
1810
   end Super_Trim;
1811
 
1812
   -----------
1813
   -- Times --
1814
   -----------
1815
 
1816
   function Times
1817
     (Left       : Natural;
1818
      Right      : Wide_Wide_Character;
1819
      Max_Length : Positive) return Super_String
1820
   is
1821
      Result : Super_String (Max_Length);
1822
 
1823
   begin
1824
      if Left > Max_Length then
1825
         raise Ada.Strings.Length_Error;
1826
 
1827
      else
1828
         Result.Current_Length := Left;
1829
 
1830
         for J in 1 .. Left loop
1831
            Result.Data (J) := Right;
1832
         end loop;
1833
      end if;
1834
 
1835
      return Result;
1836
   end Times;
1837
 
1838
   function Times
1839
     (Left       : Natural;
1840
      Right      : Wide_Wide_String;
1841
      Max_Length : Positive) return Super_String
1842
   is
1843
      Result : Super_String (Max_Length);
1844
      Pos    : Positive         := 1;
1845
      Rlen   : constant Natural := Right'Length;
1846
      Nlen   : constant Natural := Left * Rlen;
1847
 
1848
   begin
1849
      if Nlen > Max_Length then
1850
         raise Ada.Strings.Index_Error;
1851
 
1852
      else
1853
         Result.Current_Length := Nlen;
1854
 
1855
         if Nlen > 0 then
1856
            for J in 1 .. Left loop
1857
               Result.Data (Pos .. Pos + Rlen - 1) := Right;
1858
               Pos := Pos + Rlen;
1859
            end loop;
1860
         end if;
1861
      end if;
1862
 
1863
      return Result;
1864
   end Times;
1865
 
1866
   function Times
1867
     (Left  : Natural;
1868
      Right : Super_String) return Super_String
1869
   is
1870
      Result : Super_String (Right.Max_Length);
1871
      Pos    : Positive := 1;
1872
      Rlen   : constant Natural := Right.Current_Length;
1873
      Nlen   : constant Natural := Left * Rlen;
1874
 
1875
   begin
1876
      if Nlen > Right.Max_Length then
1877
         raise Ada.Strings.Length_Error;
1878
 
1879
      else
1880
         Result.Current_Length := Nlen;
1881
 
1882
         if Nlen > 0 then
1883
            for J in 1 .. Left loop
1884
               Result.Data (Pos .. Pos + Rlen - 1) :=
1885
                 Right.Data (1 .. Rlen);
1886
               Pos := Pos + Rlen;
1887
            end loop;
1888
         end if;
1889
      end if;
1890
 
1891
      return Result;
1892
   end Times;
1893
 
1894
   ---------------------
1895
   -- To_Super_String --
1896
   ---------------------
1897
 
1898
   function To_Super_String
1899
     (Source     : Wide_Wide_String;
1900
      Max_Length : Natural;
1901
      Drop       : Truncation := Error) return Super_String
1902
   is
1903
      Result : Super_String (Max_Length);
1904
      Slen   : constant Natural := Source'Length;
1905
 
1906
   begin
1907
      if Slen <= Max_Length then
1908
         Result.Current_Length := Slen;
1909
         Result.Data (1 .. Slen) := Source;
1910
 
1911
      else
1912
         case Drop is
1913
            when Strings.Right =>
1914
               Result.Current_Length := Max_Length;
1915
               Result.Data (1 .. Max_Length) :=
1916
                 Source (Source'First .. Source'First - 1 + Max_Length);
1917
 
1918
            when Strings.Left =>
1919
               Result.Current_Length := Max_Length;
1920
               Result.Data (1 .. Max_Length) :=
1921
                 Source (Source'Last - (Max_Length - 1) .. Source'Last);
1922
 
1923
            when Strings.Error =>
1924
               raise Ada.Strings.Length_Error;
1925
         end case;
1926
      end if;
1927
 
1928
      return Result;
1929
   end To_Super_String;
1930
 
1931
end Ada.Strings.Wide_Wide_Superbounded;

powered by: WebSVN 2.1.0

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