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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--             A D A . S T R I N G S . 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.Maps;   use Ada.Strings.Maps;
33
with Ada.Strings.Search;
34
 
35
package body Ada.Strings.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 : 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  : 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 : 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  : 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 : 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  : 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 : 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  : 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 : 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  : 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 : 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  : 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 : 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  : 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 : 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  : Truncation := 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 String
424
 
425
   function Super_Append
426
     (Left  : Super_String;
427
      Right : 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 : 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 String and Super_String
525
 
526
   function Super_Append
527
     (Left  : 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 Character
579
 
580
   function Super_Append
581
     (Left  : Super_String;
582
      Right : 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 : 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 Character and Super_String
647
 
648
   function Super_Append
649
     (Left  : 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 : String;
689
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
690
   is
691
   begin
692
      return
693
        Search.Count
694
          (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
695
   end Super_Count;
696
 
697
   function Super_Count
698
     (Source  : Super_String;
699
      Pattern : String;
700
      Mapping : Maps.Character_Mapping_Function) return Natural
701
   is
702
   begin
703
      return
704
        Search.Count
705
          (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
706
   end Super_Count;
707
 
708
   function Super_Count
709
     (Source : Super_String;
710
      Set    : Maps.Character_Set) return Natural
711
   is
712
   begin
713
      return Search.Count (Source.Data (1 .. Source.Current_Length), Set);
714
   end Super_Count;
715
 
716
   ------------------
717
   -- Super_Delete --
718
   ------------------
719
 
720
   function Super_Delete
721
     (Source  : Super_String;
722
      From    : Positive;
723
      Through : Natural) return Super_String
724
   is
725
      Result     : Super_String (Source.Max_Length);
726
      Slen       : constant Natural := Source.Current_Length;
727
      Num_Delete : constant Integer := Through - From + 1;
728
 
729
   begin
730
      if Num_Delete <= 0 then
731
         return Source;
732
 
733
      elsif From > Slen + 1 then
734
         raise Ada.Strings.Index_Error;
735
 
736
      elsif Through >= Slen then
737
         Result.Current_Length := From - 1;
738
         Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
739
         return Result;
740
 
741
      else
742
         Result.Current_Length := Slen - Num_Delete;
743
         Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
744
         Result.Data (From .. Result.Current_Length) :=
745
           Source.Data (Through + 1 .. Slen);
746
         return Result;
747
      end if;
748
   end Super_Delete;
749
 
750
   procedure Super_Delete
751
     (Source  : in out Super_String;
752
      From    : Positive;
753
      Through : Natural)
754
   is
755
      Slen       : constant Natural := Source.Current_Length;
756
      Num_Delete : constant Integer := Through - From + 1;
757
 
758
   begin
759
      if Num_Delete <= 0 then
760
         return;
761
 
762
      elsif From > Slen + 1 then
763
         raise Ada.Strings.Index_Error;
764
 
765
      elsif Through >= Slen then
766
         Source.Current_Length := From - 1;
767
 
768
      else
769
         Source.Current_Length := Slen - Num_Delete;
770
         Source.Data (From .. Source.Current_Length) :=
771
           Source.Data (Through + 1 .. Slen);
772
      end if;
773
   end Super_Delete;
774
 
775
   -------------------
776
   -- Super_Element --
777
   -------------------
778
 
779
   function Super_Element
780
     (Source : Super_String;
781
      Index  : Positive) return Character
782
   is
783
   begin
784
      if Index <= Source.Current_Length then
785
         return Source.Data (Index);
786
      else
787
         raise Strings.Index_Error;
788
      end if;
789
   end Super_Element;
790
 
791
   ----------------------
792
   -- Super_Find_Token --
793
   ----------------------
794
 
795
   procedure Super_Find_Token
796
     (Source : Super_String;
797
      Set    : Maps.Character_Set;
798
      From   : Positive;
799
      Test   : Strings.Membership;
800
      First  : out Positive;
801
      Last   : out Natural)
802
   is
803
   begin
804
      Search.Find_Token
805
        (Source.Data (From .. Source.Current_Length), Set, Test, First, Last);
806
   end Super_Find_Token;
807
 
808
   procedure Super_Find_Token
809
     (Source : Super_String;
810
      Set    : Maps.Character_Set;
811
      Test   : Strings.Membership;
812
      First  : out Positive;
813
      Last   : out Natural)
814
   is
815
   begin
816
      Search.Find_Token
817
        (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last);
818
   end Super_Find_Token;
819
 
820
   ----------------
821
   -- Super_Head --
822
   ----------------
823
 
824
   function Super_Head
825
     (Source : Super_String;
826
      Count  : Natural;
827
      Pad    : Character := Space;
828
      Drop   : Strings.Truncation := Strings.Error) return Super_String
829
   is
830
      Max_Length : constant Positive := Source.Max_Length;
831
      Result     : Super_String (Max_Length);
832
      Slen       : constant Natural := Source.Current_Length;
833
      Npad       : constant Integer := Count - Slen;
834
 
835
   begin
836
      if Npad <= 0 then
837
         Result.Current_Length := Count;
838
         Result.Data (1 .. Count) := Source.Data (1 .. Count);
839
 
840
      elsif Count <= Max_Length then
841
         Result.Current_Length := Count;
842
         Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
843
         Result.Data (Slen + 1 .. Count) := (others => Pad);
844
 
845
      else
846
         Result.Current_Length := Max_Length;
847
 
848
         case Drop is
849
            when Strings.Right =>
850
               Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
851
               Result.Data (Slen + 1 .. Max_Length) := (others => Pad);
852
 
853
            when Strings.Left =>
854
               if Npad >= Max_Length then
855
                  Result.Data := (others => Pad);
856
 
857
               else
858
                  Result.Data (1 .. Max_Length - Npad) :=
859
                    Source.Data (Count - Max_Length + 1 .. Slen);
860
                  Result.Data (Max_Length - Npad + 1 .. Max_Length) :=
861
                    (others => Pad);
862
               end if;
863
 
864
            when Strings.Error =>
865
               raise Ada.Strings.Length_Error;
866
         end case;
867
      end if;
868
 
869
      return Result;
870
   end Super_Head;
871
 
872
   procedure Super_Head
873
     (Source : in out Super_String;
874
      Count  : Natural;
875
      Pad    : Character := Space;
876
      Drop   : Truncation := Error)
877
   is
878
      Max_Length : constant Positive := Source.Max_Length;
879
      Slen       : constant Natural  := Source.Current_Length;
880
      Npad       : constant Integer  := Count - Slen;
881
      Temp       : String (1 .. Max_Length);
882
 
883
   begin
884
      if Npad <= 0 then
885
         Source.Current_Length := Count;
886
 
887
      elsif Count <= Max_Length then
888
         Source.Current_Length := Count;
889
         Source.Data (Slen + 1 .. Count) := (others => Pad);
890
 
891
      else
892
         Source.Current_Length := Max_Length;
893
 
894
         case Drop is
895
            when Strings.Right =>
896
               Source.Data (Slen + 1 .. Max_Length) := (others => Pad);
897
 
898
            when Strings.Left =>
899
               if Npad > Max_Length then
900
                  Source.Data := (others => Pad);
901
 
902
               else
903
                  Temp := Source.Data;
904
                  Source.Data (1 .. Max_Length - Npad) :=
905
                    Temp (Count - Max_Length + 1 .. Slen);
906
 
907
                  for J in Max_Length - Npad + 1 .. Max_Length loop
908
                     Source.Data (J) := Pad;
909
                  end loop;
910
               end if;
911
 
912
            when Strings.Error =>
913
               raise Ada.Strings.Length_Error;
914
         end case;
915
      end if;
916
   end Super_Head;
917
 
918
   -----------------
919
   -- Super_Index --
920
   -----------------
921
 
922
   function Super_Index
923
     (Source  : Super_String;
924
      Pattern : String;
925
      Going   : Strings.Direction := Strings.Forward;
926
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
927
   is
928
   begin
929
      return Search.Index
930
        (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
931
   end Super_Index;
932
 
933
   function Super_Index
934
     (Source  : Super_String;
935
      Pattern : String;
936
      Going   : Direction := Forward;
937
      Mapping : Maps.Character_Mapping_Function) return Natural
938
   is
939
   begin
940
      return Search.Index
941
        (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
942
   end Super_Index;
943
 
944
   function Super_Index
945
     (Source : Super_String;
946
      Set    : Maps.Character_Set;
947
      Test   : Strings.Membership := Strings.Inside;
948
      Going  : Strings.Direction  := Strings.Forward) return Natural
949
   is
950
   begin
951
      return Search.Index
952
        (Source.Data (1 .. Source.Current_Length), Set, Test, Going);
953
   end Super_Index;
954
 
955
   function Super_Index
956
     (Source  : Super_String;
957
      Pattern : String;
958
      From    : Positive;
959
      Going   : Direction := Forward;
960
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
961
   is
962
   begin
963
      return Search.Index
964
        (Source.Data (1 .. Source.Current_Length),
965
         Pattern, From, Going, Mapping);
966
   end Super_Index;
967
 
968
   function Super_Index
969
     (Source  : Super_String;
970
      Pattern : String;
971
      From    : Positive;
972
      Going   : Direction := Forward;
973
      Mapping : Maps.Character_Mapping_Function) return Natural
974
   is
975
   begin
976
      return Search.Index
977
        (Source.Data (1 .. Source.Current_Length),
978
         Pattern, From, Going, Mapping);
979
   end Super_Index;
980
 
981
   function Super_Index
982
     (Source : Super_String;
983
      Set    : Maps.Character_Set;
984
      From   : Positive;
985
      Test   : Membership := Inside;
986
      Going  : Direction := Forward) return Natural
987
   is
988
   begin
989
      return Search.Index
990
        (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going);
991
   end Super_Index;
992
 
993
   ---------------------------
994
   -- Super_Index_Non_Blank --
995
   ---------------------------
996
 
997
   function Super_Index_Non_Blank
998
     (Source : Super_String;
999
      Going  : Strings.Direction := Strings.Forward) return Natural
1000
   is
1001
   begin
1002
      return
1003
        Search.Index_Non_Blank
1004
          (Source.Data (1 .. Source.Current_Length), Going);
1005
   end Super_Index_Non_Blank;
1006
 
1007
   function Super_Index_Non_Blank
1008
     (Source : Super_String;
1009
      From   : Positive;
1010
      Going  : Direction := Forward) return Natural
1011
   is
1012
   begin
1013
      return
1014
        Search.Index_Non_Blank
1015
          (Source.Data (1 .. Source.Current_Length), From, Going);
1016
   end Super_Index_Non_Blank;
1017
 
1018
   ------------------
1019
   -- Super_Insert --
1020
   ------------------
1021
 
1022
   function Super_Insert
1023
     (Source   : Super_String;
1024
      Before   : Positive;
1025
      New_Item : String;
1026
      Drop     : Strings.Truncation := Strings.Error) return Super_String
1027
   is
1028
      Max_Length : constant Positive := Source.Max_Length;
1029
      Result     : Super_String (Max_Length);
1030
      Slen       : constant Natural := Source.Current_Length;
1031
      Nlen       : constant Natural := New_Item'Length;
1032
      Tlen       : constant Natural := Slen + Nlen;
1033
      Blen       : constant Natural := Before - 1;
1034
      Alen       : constant Integer := Slen - Blen;
1035
      Droplen    : constant Integer := Tlen - Max_Length;
1036
 
1037
      --  Tlen is the length of the total string before possible truncation.
1038
      --  Blen, Alen are the lengths of the before and after pieces of the
1039
      --  source string.
1040
 
1041
   begin
1042
      if Alen < 0 then
1043
         raise Ada.Strings.Index_Error;
1044
 
1045
      elsif Droplen <= 0 then
1046
         Result.Current_Length := Tlen;
1047
         Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1048
         Result.Data (Before .. Before + Nlen - 1) := New_Item;
1049
         Result.Data (Before + Nlen .. Tlen) :=
1050
           Source.Data (Before .. Slen);
1051
 
1052
      else
1053
         Result.Current_Length := Max_Length;
1054
 
1055
         case Drop is
1056
            when Strings.Right =>
1057
               Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1058
 
1059
               if Droplen > Alen then
1060
                  Result.Data (Before .. Max_Length) :=
1061
                    New_Item (New_Item'First
1062
                                .. New_Item'First + Max_Length - Before);
1063
               else
1064
                  Result.Data (Before .. Before + Nlen - 1) := New_Item;
1065
                  Result.Data (Before + Nlen .. Max_Length) :=
1066
                    Source.Data (Before .. Slen - Droplen);
1067
               end if;
1068
 
1069
            when Strings.Left =>
1070
               Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1071
                 Source.Data (Before .. Slen);
1072
 
1073
               if Droplen >= Blen then
1074
                  Result.Data (1 .. Max_Length - Alen) :=
1075
                    New_Item (New_Item'Last - (Max_Length - Alen) + 1
1076
                                .. New_Item'Last);
1077
               else
1078
                  Result.Data
1079
                    (Blen - Droplen + 1 .. Max_Length - Alen) :=
1080
                    New_Item;
1081
                  Result.Data (1 .. Blen - Droplen) :=
1082
                    Source.Data (Droplen + 1 .. Blen);
1083
               end if;
1084
 
1085
            when Strings.Error =>
1086
               raise Ada.Strings.Length_Error;
1087
         end case;
1088
      end if;
1089
 
1090
      return Result;
1091
   end Super_Insert;
1092
 
1093
   procedure Super_Insert
1094
     (Source   : in out Super_String;
1095
      Before   : Positive;
1096
      New_Item : String;
1097
      Drop     : Strings.Truncation := Strings.Error)
1098
   is
1099
   begin
1100
      --  We do a double copy here because this is one of the situations
1101
      --  in which we move data to the right, and at least at the moment,
1102
      --  GNAT is not handling such cases correctly ???
1103
 
1104
      Source := Super_Insert (Source, Before, New_Item, Drop);
1105
   end Super_Insert;
1106
 
1107
   ------------------
1108
   -- Super_Length --
1109
   ------------------
1110
 
1111
   function Super_Length (Source : Super_String) return Natural is
1112
   begin
1113
      return Source.Current_Length;
1114
   end Super_Length;
1115
 
1116
   ---------------------
1117
   -- Super_Overwrite --
1118
   ---------------------
1119
 
1120
   function Super_Overwrite
1121
     (Source   : Super_String;
1122
      Position : Positive;
1123
      New_Item : String;
1124
      Drop     : Strings.Truncation := Strings.Error) return Super_String
1125
   is
1126
      Max_Length : constant Positive := Source.Max_Length;
1127
      Result     : Super_String (Max_Length);
1128
      Endpos     : constant Natural  := Position + New_Item'Length - 1;
1129
      Slen       : constant Natural  := Source.Current_Length;
1130
      Droplen    : Natural;
1131
 
1132
   begin
1133
      if Position > Slen + 1 then
1134
         raise Ada.Strings.Index_Error;
1135
 
1136
      elsif New_Item'Length = 0 then
1137
         return Source;
1138
 
1139
      elsif Endpos <= Slen then
1140
         Result.Current_Length := Source.Current_Length;
1141
         Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
1142
         Result.Data (Position .. Endpos) := New_Item;
1143
         return Result;
1144
 
1145
      elsif Endpos <= Max_Length then
1146
         Result.Current_Length := Endpos;
1147
         Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1);
1148
         Result.Data (Position .. Endpos) := New_Item;
1149
         return Result;
1150
 
1151
      else
1152
         Result.Current_Length := Max_Length;
1153
         Droplen := Endpos - Max_Length;
1154
 
1155
         case Drop is
1156
            when Strings.Right =>
1157
               Result.Data (1 .. Position - 1) :=
1158
                 Source.Data (1 .. Position - 1);
1159
 
1160
               Result.Data (Position .. Max_Length) :=
1161
                 New_Item (New_Item'First .. New_Item'Last - Droplen);
1162
               return Result;
1163
 
1164
            when Strings.Left =>
1165
               if New_Item'Length >= Max_Length then
1166
                  Result.Data (1 .. Max_Length) :=
1167
                    New_Item (New_Item'Last - Max_Length + 1 ..
1168
                                New_Item'Last);
1169
                  return Result;
1170
 
1171
               else
1172
                  Result.Data (1 .. Max_Length - New_Item'Length) :=
1173
                    Source.Data (Droplen + 1 .. Position - 1);
1174
                  Result.Data
1175
                    (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1176
                    New_Item;
1177
                  return Result;
1178
               end if;
1179
 
1180
            when Strings.Error =>
1181
               raise Ada.Strings.Length_Error;
1182
         end case;
1183
      end if;
1184
   end Super_Overwrite;
1185
 
1186
   procedure Super_Overwrite
1187
     (Source    : in out Super_String;
1188
      Position  : Positive;
1189
      New_Item  : String;
1190
      Drop      : Strings.Truncation := Strings.Error)
1191
   is
1192
      Max_Length : constant Positive := Source.Max_Length;
1193
      Endpos     : constant Positive := Position + New_Item'Length - 1;
1194
      Slen       : constant Natural  := Source.Current_Length;
1195
      Droplen    : Natural;
1196
 
1197
   begin
1198
      if Position > Slen + 1 then
1199
         raise Ada.Strings.Index_Error;
1200
 
1201
      elsif Endpos <= Slen then
1202
         Source.Data (Position .. Endpos) := New_Item;
1203
 
1204
      elsif Endpos <= Max_Length then
1205
         Source.Data (Position .. Endpos) := New_Item;
1206
         Source.Current_Length := Endpos;
1207
 
1208
      else
1209
         Source.Current_Length := Max_Length;
1210
         Droplen := Endpos - Max_Length;
1211
 
1212
         case Drop is
1213
            when Strings.Right =>
1214
               Source.Data (Position .. Max_Length) :=
1215
                 New_Item (New_Item'First .. New_Item'Last - Droplen);
1216
 
1217
            when Strings.Left =>
1218
               if New_Item'Length > Max_Length then
1219
                  Source.Data (1 .. Max_Length) :=
1220
                    New_Item (New_Item'Last - Max_Length + 1 ..
1221
                                New_Item'Last);
1222
 
1223
               else
1224
                  Source.Data (1 .. Max_Length - New_Item'Length) :=
1225
                    Source.Data (Droplen + 1 .. Position - 1);
1226
 
1227
                  Source.Data
1228
                    (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1229
                    New_Item;
1230
               end if;
1231
 
1232
            when Strings.Error =>
1233
               raise Ada.Strings.Length_Error;
1234
         end case;
1235
      end if;
1236
   end Super_Overwrite;
1237
 
1238
   ---------------------------
1239
   -- Super_Replace_Element --
1240
   ---------------------------
1241
 
1242
   procedure Super_Replace_Element
1243
     (Source : in out Super_String;
1244
      Index  : Positive;
1245
      By     : Character)
1246
   is
1247
   begin
1248
      if Index <= Source.Current_Length then
1249
         Source.Data (Index) := By;
1250
      else
1251
         raise Ada.Strings.Index_Error;
1252
      end if;
1253
   end Super_Replace_Element;
1254
 
1255
   -------------------------
1256
   -- Super_Replace_Slice --
1257
   -------------------------
1258
 
1259
   function Super_Replace_Slice
1260
     (Source : Super_String;
1261
      Low    : Positive;
1262
      High   : Natural;
1263
      By     : String;
1264
      Drop   : Strings.Truncation := Strings.Error) return Super_String
1265
   is
1266
      Max_Length : constant Positive := Source.Max_Length;
1267
      Slen       : constant Natural  := Source.Current_Length;
1268
 
1269
   begin
1270
      if Low > Slen + 1 then
1271
         raise Strings.Index_Error;
1272
 
1273
      elsif High < Low then
1274
         return Super_Insert (Source, Low, By, Drop);
1275
 
1276
      else
1277
         declare
1278
            Blen    : constant Natural := Natural'Max (0, Low - 1);
1279
            Alen    : constant Natural := Natural'Max (0, Slen - High);
1280
            Tlen    : constant Natural := Blen + By'Length + Alen;
1281
            Droplen : constant Integer := Tlen - Max_Length;
1282
            Result  : Super_String (Max_Length);
1283
 
1284
            --  Tlen is the total length of the result string before any
1285
            --  truncation. Blen and Alen are the lengths of the pieces
1286
            --  of the original string that end up in the result string
1287
            --  before and after the replaced slice.
1288
 
1289
         begin
1290
            if Droplen <= 0 then
1291
               Result.Current_Length := Tlen;
1292
               Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1293
               Result.Data (Low .. Low + By'Length - 1) := By;
1294
               Result.Data (Low + By'Length .. Tlen) :=
1295
                 Source.Data (High + 1 .. Slen);
1296
 
1297
            else
1298
               Result.Current_Length := Max_Length;
1299
 
1300
               case Drop is
1301
                  when Strings.Right =>
1302
                     Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1303
 
1304
                     if Droplen > Alen then
1305
                        Result.Data (Low .. Max_Length) :=
1306
                          By (By'First .. By'First + Max_Length - Low);
1307
                     else
1308
                        Result.Data (Low .. Low + By'Length - 1) := By;
1309
                        Result.Data (Low + By'Length .. Max_Length) :=
1310
                          Source.Data (High + 1 .. Slen - Droplen);
1311
                     end if;
1312
 
1313
                  when Strings.Left =>
1314
                     Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1315
                       Source.Data (High + 1 .. Slen);
1316
 
1317
                     if Droplen >= Blen then
1318
                        Result.Data (1 .. Max_Length - Alen) :=
1319
                          By (By'Last - (Max_Length - Alen) + 1 .. By'Last);
1320
                     else
1321
                        Result.Data
1322
                          (Blen - Droplen + 1 .. Max_Length - Alen) := By;
1323
                        Result.Data (1 .. Blen - Droplen) :=
1324
                          Source.Data (Droplen + 1 .. Blen);
1325
                     end if;
1326
 
1327
                  when Strings.Error =>
1328
                     raise Ada.Strings.Length_Error;
1329
               end case;
1330
            end if;
1331
 
1332
            return Result;
1333
         end;
1334
      end if;
1335
   end Super_Replace_Slice;
1336
 
1337
   procedure Super_Replace_Slice
1338
     (Source   : in out Super_String;
1339
      Low      : Positive;
1340
      High     : Natural;
1341
      By       : String;
1342
      Drop     : Strings.Truncation := Strings.Error)
1343
   is
1344
   begin
1345
      --  We do a double copy here because this is one of the situations
1346
      --  in which we move data to the right, and at least at the moment,
1347
      --  GNAT is not handling such cases correctly ???
1348
 
1349
      Source := Super_Replace_Slice (Source, Low, High, By, Drop);
1350
   end Super_Replace_Slice;
1351
 
1352
   ---------------------
1353
   -- Super_Replicate --
1354
   ---------------------
1355
 
1356
   function Super_Replicate
1357
     (Count      : Natural;
1358
      Item       : Character;
1359
      Drop       : Truncation := Error;
1360
      Max_Length : Positive) return Super_String
1361
   is
1362
      Result : Super_String (Max_Length);
1363
 
1364
   begin
1365
      if Count <= Max_Length then
1366
         Result.Current_Length := Count;
1367
 
1368
      elsif Drop = Strings.Error then
1369
         raise Ada.Strings.Length_Error;
1370
 
1371
      else
1372
         Result.Current_Length := Max_Length;
1373
      end if;
1374
 
1375
      Result.Data (1 .. Result.Current_Length) := (others => Item);
1376
      return Result;
1377
   end Super_Replicate;
1378
 
1379
   function Super_Replicate
1380
     (Count      : Natural;
1381
      Item       : String;
1382
      Drop       : Truncation := Error;
1383
      Max_Length : Positive) return Super_String
1384
   is
1385
      Length : constant Integer := Count * Item'Length;
1386
      Result : Super_String (Max_Length);
1387
      Indx   : Positive;
1388
 
1389
   begin
1390
      if Length <= Max_Length then
1391
         Result.Current_Length := Length;
1392
 
1393
         if Length > 0 then
1394
            Indx := 1;
1395
 
1396
            for J in 1 .. Count loop
1397
               Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1398
               Indx := Indx + Item'Length;
1399
            end loop;
1400
         end if;
1401
 
1402
      else
1403
         Result.Current_Length := Max_Length;
1404
 
1405
         case Drop is
1406
            when Strings.Right =>
1407
               Indx := 1;
1408
 
1409
               while Indx + Item'Length <= Max_Length + 1 loop
1410
                  Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1411
                  Indx := Indx + Item'Length;
1412
               end loop;
1413
 
1414
               Result.Data (Indx .. Max_Length) :=
1415
                 Item (Item'First .. Item'First + Max_Length - Indx);
1416
 
1417
            when Strings.Left =>
1418
               Indx := Max_Length;
1419
 
1420
               while Indx - Item'Length >= 1 loop
1421
                  Result.Data (Indx - (Item'Length - 1) .. Indx) := Item;
1422
                  Indx := Indx - Item'Length;
1423
               end loop;
1424
 
1425
               Result.Data (1 .. Indx) :=
1426
                 Item (Item'Last - Indx + 1 .. Item'Last);
1427
 
1428
            when Strings.Error =>
1429
               raise Ada.Strings.Length_Error;
1430
         end case;
1431
      end if;
1432
 
1433
      return Result;
1434
   end Super_Replicate;
1435
 
1436
   function Super_Replicate
1437
     (Count : Natural;
1438
      Item  : Super_String;
1439
      Drop  : Strings.Truncation := Strings.Error) return Super_String
1440
   is
1441
   begin
1442
      return
1443
        Super_Replicate
1444
          (Count,
1445
           Item.Data (1 .. Item.Current_Length),
1446
           Drop,
1447
           Item.Max_Length);
1448
   end Super_Replicate;
1449
 
1450
   -----------------
1451
   -- Super_Slice --
1452
   -----------------
1453
 
1454
   function Super_Slice
1455
     (Source : Super_String;
1456
      Low    : Positive;
1457
      High   : Natural) return String
1458
   is
1459
   begin
1460
      --  Note: test of High > Length is in accordance with AI95-00128
1461
 
1462
      if Low > Source.Current_Length + 1
1463
        or else High > Source.Current_Length
1464
      then
1465
         raise Index_Error;
1466
      else
1467
         return Source.Data (Low .. High);
1468
      end if;
1469
   end Super_Slice;
1470
 
1471
   function Super_Slice
1472
     (Source : Super_String;
1473
      Low    : Positive;
1474
      High   : Natural) return Super_String
1475
   is
1476
      Result : Super_String (Source.Max_Length);
1477
 
1478
   begin
1479
      if Low > Source.Current_Length + 1
1480
        or else High > Source.Current_Length
1481
      then
1482
         raise Index_Error;
1483
      else
1484
         Result.Current_Length := High - Low + 1;
1485
         Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
1486
      end if;
1487
 
1488
      return Result;
1489
   end Super_Slice;
1490
 
1491
   procedure Super_Slice
1492
     (Source : Super_String;
1493
      Target : out Super_String;
1494
      Low    : Positive;
1495
      High   : Natural)
1496
   is
1497
   begin
1498
      if Low > Source.Current_Length + 1
1499
        or else High > Source.Current_Length
1500
      then
1501
         raise Index_Error;
1502
      else
1503
         Target.Current_Length := High - Low + 1;
1504
         Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High);
1505
      end if;
1506
   end Super_Slice;
1507
 
1508
   ----------------
1509
   -- Super_Tail --
1510
   ----------------
1511
 
1512
   function Super_Tail
1513
     (Source : Super_String;
1514
      Count  : Natural;
1515
      Pad    : Character := Space;
1516
      Drop   : Strings.Truncation := Strings.Error) return Super_String
1517
   is
1518
      Max_Length : constant Positive := Source.Max_Length;
1519
      Result     : Super_String (Max_Length);
1520
      Slen       : constant Natural := Source.Current_Length;
1521
      Npad       : constant Integer := Count - Slen;
1522
 
1523
   begin
1524
      if Npad <= 0 then
1525
         Result.Current_Length := Count;
1526
         Result.Data (1 .. Count) :=
1527
           Source.Data (Slen - (Count - 1) .. Slen);
1528
 
1529
      elsif Count <= Max_Length then
1530
         Result.Current_Length := Count;
1531
         Result.Data (1 .. Npad) := (others => Pad);
1532
         Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen);
1533
 
1534
      else
1535
         Result.Current_Length := Max_Length;
1536
 
1537
         case Drop is
1538
            when Strings.Right =>
1539
               if Npad >= Max_Length then
1540
                  Result.Data := (others => Pad);
1541
 
1542
               else
1543
                  Result.Data (1 .. Npad) := (others => Pad);
1544
                  Result.Data (Npad + 1 .. Max_Length) :=
1545
                    Source.Data (1 .. Max_Length - Npad);
1546
               end if;
1547
 
1548
            when Strings.Left =>
1549
               Result.Data (1 .. Max_Length - Slen) := (others => Pad);
1550
               Result.Data (Max_Length - Slen + 1 .. Max_Length) :=
1551
                 Source.Data (1 .. Slen);
1552
 
1553
            when Strings.Error =>
1554
               raise Ada.Strings.Length_Error;
1555
         end case;
1556
      end if;
1557
 
1558
      return Result;
1559
   end Super_Tail;
1560
 
1561
   procedure Super_Tail
1562
     (Source : in out Super_String;
1563
      Count  : Natural;
1564
      Pad    : Character := Space;
1565
      Drop   : Truncation := Error)
1566
   is
1567
      Max_Length : constant Positive := Source.Max_Length;
1568
      Slen       : constant Natural  := Source.Current_Length;
1569
      Npad       : constant Integer  := Count - Slen;
1570
 
1571
      Temp : constant String (1 .. Max_Length) := Source.Data;
1572
 
1573
   begin
1574
      if Npad <= 0 then
1575
         Source.Current_Length := Count;
1576
         Source.Data (1 .. Count) :=
1577
           Temp (Slen - (Count - 1) .. Slen);
1578
 
1579
      elsif Count <= Max_Length then
1580
         Source.Current_Length := Count;
1581
         Source.Data (1 .. Npad) := (others => Pad);
1582
         Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen);
1583
 
1584
      else
1585
         Source.Current_Length := Max_Length;
1586
 
1587
         case Drop is
1588
            when Strings.Right =>
1589
               if Npad >= Max_Length then
1590
                  Source.Data := (others => Pad);
1591
 
1592
               else
1593
                  Source.Data (1 .. Npad) := (others => Pad);
1594
                  Source.Data (Npad + 1 .. Max_Length) :=
1595
                    Temp (1 .. Max_Length - Npad);
1596
               end if;
1597
 
1598
            when Strings.Left =>
1599
               for J in 1 .. Max_Length - Slen loop
1600
                  Source.Data (J) := Pad;
1601
               end loop;
1602
 
1603
               Source.Data (Max_Length - Slen + 1 .. Max_Length) :=
1604
                 Temp (1 .. Slen);
1605
 
1606
            when Strings.Error =>
1607
               raise Ada.Strings.Length_Error;
1608
         end case;
1609
      end if;
1610
   end Super_Tail;
1611
 
1612
   ---------------------
1613
   -- Super_To_String --
1614
   ---------------------
1615
 
1616
   function Super_To_String (Source : Super_String) return String is
1617
   begin
1618
      return Source.Data (1 .. Source.Current_Length);
1619
   end Super_To_String;
1620
 
1621
   ---------------------
1622
   -- Super_Translate --
1623
   ---------------------
1624
 
1625
   function Super_Translate
1626
     (Source  : Super_String;
1627
      Mapping : Maps.Character_Mapping) return Super_String
1628
   is
1629
      Result : Super_String (Source.Max_Length);
1630
 
1631
   begin
1632
      Result.Current_Length := Source.Current_Length;
1633
 
1634
      for J in 1 .. Source.Current_Length loop
1635
         Result.Data (J) := Value (Mapping, Source.Data (J));
1636
      end loop;
1637
 
1638
      return Result;
1639
   end Super_Translate;
1640
 
1641
   procedure Super_Translate
1642
     (Source  : in out Super_String;
1643
      Mapping : Maps.Character_Mapping)
1644
   is
1645
   begin
1646
      for J in 1 .. Source.Current_Length loop
1647
         Source.Data (J) := Value (Mapping, Source.Data (J));
1648
      end loop;
1649
   end Super_Translate;
1650
 
1651
   function Super_Translate
1652
     (Source  : Super_String;
1653
      Mapping : Maps.Character_Mapping_Function) return Super_String
1654
   is
1655
      Result : Super_String (Source.Max_Length);
1656
 
1657
   begin
1658
      Result.Current_Length := Source.Current_Length;
1659
 
1660
      for J in 1 .. Source.Current_Length loop
1661
         Result.Data (J) := Mapping.all (Source.Data (J));
1662
      end loop;
1663
 
1664
      return Result;
1665
   end Super_Translate;
1666
 
1667
   procedure Super_Translate
1668
     (Source  : in out Super_String;
1669
      Mapping : Maps.Character_Mapping_Function)
1670
   is
1671
   begin
1672
      for J in 1 .. Source.Current_Length loop
1673
         Source.Data (J) := Mapping.all (Source.Data (J));
1674
      end loop;
1675
   end Super_Translate;
1676
 
1677
   ----------------
1678
   -- Super_Trim --
1679
   ----------------
1680
 
1681
   function Super_Trim
1682
     (Source : Super_String;
1683
      Side   : Trim_End) return Super_String
1684
   is
1685
      Result : Super_String (Source.Max_Length);
1686
      Last   : Natural := Source.Current_Length;
1687
      First  : Positive := 1;
1688
 
1689
   begin
1690
      if Side = Left or else Side = Both then
1691
         while First <= Last and then Source.Data (First) = ' ' loop
1692
            First := First + 1;
1693
         end loop;
1694
      end if;
1695
 
1696
      if Side = Right or else Side = Both then
1697
         while Last >= First and then Source.Data (Last) = ' ' loop
1698
            Last := Last - 1;
1699
         end loop;
1700
      end if;
1701
 
1702
      Result.Current_Length := Last - First + 1;
1703
      Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last);
1704
      return Result;
1705
   end Super_Trim;
1706
 
1707
   procedure Super_Trim
1708
     (Source : in out Super_String;
1709
      Side   : Trim_End)
1710
   is
1711
      Max_Length : constant Positive := Source.Max_Length;
1712
      Last       : Natural           := Source.Current_Length;
1713
      First      : Positive          := 1;
1714
      Temp       : String (1 .. Max_Length);
1715
 
1716
   begin
1717
      Temp (1 .. Last) := Source.Data (1 .. Last);
1718
 
1719
      if Side = Left or else Side = Both then
1720
         while First <= Last and then Temp (First) = ' ' loop
1721
            First := First + 1;
1722
         end loop;
1723
      end if;
1724
 
1725
      if Side = Right or else Side = Both then
1726
         while Last >= First and then Temp (Last) = ' ' loop
1727
            Last := Last - 1;
1728
         end loop;
1729
      end if;
1730
 
1731
      Source.Data := (others => ASCII.NUL);
1732
      Source.Current_Length := Last - First + 1;
1733
      Source.Data (1 .. Source.Current_Length) := Temp (First .. Last);
1734
   end Super_Trim;
1735
 
1736
   function Super_Trim
1737
     (Source : Super_String;
1738
      Left   : Maps.Character_Set;
1739
      Right  : Maps.Character_Set) return Super_String
1740
   is
1741
      Result : Super_String (Source.Max_Length);
1742
 
1743
   begin
1744
      for First in 1 .. Source.Current_Length loop
1745
         if not Is_In (Source.Data (First), Left) then
1746
            for Last in reverse First .. Source.Current_Length loop
1747
               if not Is_In (Source.Data (Last), Right) then
1748
                  Result.Current_Length := Last - First + 1;
1749
                  Result.Data (1 .. Result.Current_Length) :=
1750
                    Source.Data (First .. Last);
1751
                  return Result;
1752
               end if;
1753
            end loop;
1754
         end if;
1755
      end loop;
1756
 
1757
      Result.Current_Length := 0;
1758
      return Result;
1759
   end Super_Trim;
1760
 
1761
   procedure Super_Trim
1762
     (Source : in out Super_String;
1763
      Left   : Maps.Character_Set;
1764
      Right  : Maps.Character_Set)
1765
   is
1766
   begin
1767
      for First in 1 .. Source.Current_Length loop
1768
         if not Is_In (Source.Data (First), Left) then
1769
            for Last in reverse First .. Source.Current_Length loop
1770
               if not Is_In (Source.Data (Last), Right) then
1771
                  if First = 1 then
1772
                     Source.Current_Length := Last;
1773
                     return;
1774
                  else
1775
                     Source.Current_Length := Last - First + 1;
1776
                     Source.Data (1 .. Source.Current_Length) :=
1777
                       Source.Data (First .. Last);
1778
 
1779
                     for J in Source.Current_Length + 1 ..
1780
                                Source.Max_Length
1781
                     loop
1782
                        Source.Data (J) := ASCII.NUL;
1783
                     end loop;
1784
 
1785
                     return;
1786
                  end if;
1787
               end if;
1788
            end loop;
1789
 
1790
            Source.Current_Length := 0;
1791
            return;
1792
         end if;
1793
      end loop;
1794
 
1795
      Source.Current_Length := 0;
1796
   end Super_Trim;
1797
 
1798
   -----------
1799
   -- Times --
1800
   -----------
1801
 
1802
   function Times
1803
     (Left       : Natural;
1804
      Right      : Character;
1805
      Max_Length : Positive) return Super_String
1806
   is
1807
      Result : Super_String (Max_Length);
1808
 
1809
   begin
1810
      if Left > Max_Length then
1811
         raise Ada.Strings.Length_Error;
1812
 
1813
      else
1814
         Result.Current_Length := Left;
1815
 
1816
         for J in 1 .. Left loop
1817
            Result.Data (J) := Right;
1818
         end loop;
1819
      end if;
1820
 
1821
      return Result;
1822
   end Times;
1823
 
1824
   function Times
1825
     (Left       : Natural;
1826
      Right      : String;
1827
      Max_Length : Positive) return Super_String
1828
   is
1829
      Result : Super_String (Max_Length);
1830
      Pos    : Positive         := 1;
1831
      Rlen   : constant Natural := Right'Length;
1832
      Nlen   : constant Natural := Left * Rlen;
1833
 
1834
   begin
1835
      if Nlen > Max_Length then
1836
         raise Ada.Strings.Index_Error;
1837
 
1838
      else
1839
         Result.Current_Length := Nlen;
1840
 
1841
         if Nlen > 0 then
1842
            for J in 1 .. Left loop
1843
               Result.Data (Pos .. Pos + Rlen - 1) := Right;
1844
               Pos := Pos + Rlen;
1845
            end loop;
1846
         end if;
1847
      end if;
1848
 
1849
      return Result;
1850
   end Times;
1851
 
1852
   function Times
1853
     (Left  : Natural;
1854
      Right : Super_String) return Super_String
1855
   is
1856
      Result : Super_String (Right.Max_Length);
1857
      Pos    : Positive := 1;
1858
      Rlen   : constant Natural := Right.Current_Length;
1859
      Nlen   : constant Natural := Left * Rlen;
1860
 
1861
   begin
1862
      if Nlen > Right.Max_Length then
1863
         raise Ada.Strings.Length_Error;
1864
 
1865
      else
1866
         Result.Current_Length := Nlen;
1867
 
1868
         if Nlen > 0 then
1869
            for J in 1 .. Left loop
1870
               Result.Data (Pos .. Pos + Rlen - 1) :=
1871
                 Right.Data (1 .. Rlen);
1872
               Pos := Pos + Rlen;
1873
            end loop;
1874
         end if;
1875
      end if;
1876
 
1877
      return Result;
1878
   end Times;
1879
 
1880
   ---------------------
1881
   -- To_Super_String --
1882
   ---------------------
1883
 
1884
   function To_Super_String
1885
     (Source     : String;
1886
      Max_Length : Natural;
1887
      Drop       : Truncation := Error) return Super_String
1888
   is
1889
      Result : Super_String (Max_Length);
1890
      Slen   : constant Natural := Source'Length;
1891
 
1892
   begin
1893
      if Slen <= Max_Length then
1894
         Result.Current_Length := Slen;
1895
         Result.Data (1 .. Slen) := Source;
1896
 
1897
      else
1898
         case Drop is
1899
            when Strings.Right =>
1900
               Result.Current_Length := Max_Length;
1901
               Result.Data (1 .. Max_Length) :=
1902
                 Source (Source'First .. Source'First - 1 + Max_Length);
1903
 
1904
            when Strings.Left =>
1905
               Result.Current_Length := Max_Length;
1906
               Result.Data (1 .. Max_Length) :=
1907
                 Source (Source'Last - (Max_Length - 1) .. Source'Last);
1908
 
1909
            when Strings.Error =>
1910
               raise Ada.Strings.Length_Error;
1911
         end case;
1912
      end if;
1913
 
1914
      return Result;
1915
   end To_Super_String;
1916
 
1917
end Ada.Strings.Superbounded;

powered by: WebSVN 2.1.0

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