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

Subversion Repositories openrisc_me

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

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

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--                 A D A . S T R I N G S . U N B O U N D E D                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
with Ada.Strings.Fixed;
33
with Ada.Strings.Search;
34
with Ada.Unchecked_Deallocation;
35
 
36
package body Ada.Strings.Unbounded is
37
 
38
   use Ada.Finalization;
39
 
40
   ---------
41
   -- "&" --
42
   ---------
43
 
44
   function "&"
45
     (Left  : Unbounded_String;
46
      Right : Unbounded_String) return Unbounded_String
47
   is
48
      L_Length : constant Natural := Left.Last;
49
      R_Length : constant Natural := Right.Last;
50
      Result   : Unbounded_String;
51
 
52
   begin
53
      Result.Last := L_Length + R_Length;
54
 
55
      Result.Reference := new String (1 .. Result.Last);
56
 
57
      Result.Reference (1 .. L_Length) :=
58
        Left.Reference (1 .. Left.Last);
59
      Result.Reference (L_Length + 1 .. Result.Last) :=
60
        Right.Reference (1 .. Right.Last);
61
 
62
      return Result;
63
   end "&";
64
 
65
   function "&"
66
     (Left  : Unbounded_String;
67
      Right : String) return Unbounded_String
68
   is
69
      L_Length : constant Natural := Left.Last;
70
      Result   : Unbounded_String;
71
 
72
   begin
73
      Result.Last := L_Length + Right'Length;
74
 
75
      Result.Reference := new String (1 .. Result.Last);
76
 
77
      Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
78
      Result.Reference (L_Length + 1 .. Result.Last) := Right;
79
 
80
      return Result;
81
   end "&";
82
 
83
   function "&"
84
     (Left  : String;
85
      Right : Unbounded_String) return Unbounded_String
86
   is
87
      R_Length : constant Natural := Right.Last;
88
      Result   : Unbounded_String;
89
 
90
   begin
91
      Result.Last := Left'Length + R_Length;
92
 
93
      Result.Reference := new String (1 .. Result.Last);
94
 
95
      Result.Reference (1 .. Left'Length) := Left;
96
      Result.Reference (Left'Length + 1 .. Result.Last) :=
97
        Right.Reference (1 .. Right.Last);
98
 
99
      return Result;
100
   end "&";
101
 
102
   function "&"
103
     (Left  : Unbounded_String;
104
      Right : Character) return Unbounded_String
105
   is
106
      Result : Unbounded_String;
107
 
108
   begin
109
      Result.Last := Left.Last + 1;
110
 
111
      Result.Reference := new String (1 .. Result.Last);
112
 
113
      Result.Reference (1 .. Result.Last - 1) :=
114
        Left.Reference (1 .. Left.Last);
115
      Result.Reference (Result.Last) := Right;
116
 
117
      return Result;
118
   end "&";
119
 
120
   function "&"
121
     (Left  : Character;
122
      Right : Unbounded_String) return Unbounded_String
123
   is
124
      Result : Unbounded_String;
125
 
126
   begin
127
      Result.Last := Right.Last + 1;
128
 
129
      Result.Reference := new String (1 .. Result.Last);
130
      Result.Reference (1) := Left;
131
      Result.Reference (2 .. Result.Last) :=
132
        Right.Reference (1 .. Right.Last);
133
      return Result;
134
   end "&";
135
 
136
   ---------
137
   -- "*" --
138
   ---------
139
 
140
   function "*"
141
     (Left  : Natural;
142
      Right : Character) return Unbounded_String
143
   is
144
      Result : Unbounded_String;
145
 
146
   begin
147
      Result.Last   := Left;
148
 
149
      Result.Reference := new String (1 .. Left);
150
      for J in Result.Reference'Range loop
151
         Result.Reference (J) := Right;
152
      end loop;
153
 
154
      return Result;
155
   end "*";
156
 
157
   function "*"
158
     (Left  : Natural;
159
      Right : String) return Unbounded_String
160
   is
161
      Len    : constant Natural := Right'Length;
162
      K      : Positive;
163
      Result : Unbounded_String;
164
 
165
   begin
166
      Result.Last := Left * Len;
167
 
168
      Result.Reference := new String (1 .. Result.Last);
169
 
170
      K := 1;
171
      for J in 1 .. Left loop
172
         Result.Reference (K .. K + Len - 1) := Right;
173
         K := K + Len;
174
      end loop;
175
 
176
      return Result;
177
   end "*";
178
 
179
   function "*"
180
     (Left  : Natural;
181
      Right : Unbounded_String) return Unbounded_String
182
   is
183
      Len    : constant Natural := Right.Last;
184
      K      : Positive;
185
      Result : Unbounded_String;
186
 
187
   begin
188
      Result.Last := Left * Len;
189
 
190
      Result.Reference := new String (1 .. Result.Last);
191
 
192
      K := 1;
193
      for J in 1 .. Left loop
194
         Result.Reference (K .. K + Len - 1) :=
195
           Right.Reference (1 .. Right.Last);
196
         K := K + Len;
197
      end loop;
198
 
199
      return Result;
200
   end "*";
201
 
202
   ---------
203
   -- "<" --
204
   ---------
205
 
206
   function "<"
207
     (Left  : Unbounded_String;
208
      Right : Unbounded_String) return Boolean
209
   is
210
   begin
211
      return
212
        Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
213
   end "<";
214
 
215
   function "<"
216
     (Left  : Unbounded_String;
217
      Right : String) return Boolean
218
   is
219
   begin
220
      return Left.Reference (1 .. Left.Last) < Right;
221
   end "<";
222
 
223
   function "<"
224
     (Left  : String;
225
      Right : Unbounded_String) return Boolean
226
   is
227
   begin
228
      return Left < Right.Reference (1 .. Right.Last);
229
   end "<";
230
 
231
   ----------
232
   -- "<=" --
233
   ----------
234
 
235
   function "<="
236
     (Left  : Unbounded_String;
237
      Right : Unbounded_String) return Boolean
238
   is
239
   begin
240
      return
241
        Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
242
   end "<=";
243
 
244
   function "<="
245
     (Left  : Unbounded_String;
246
      Right : String) return Boolean
247
   is
248
   begin
249
      return Left.Reference (1 .. Left.Last) <= Right;
250
   end "<=";
251
 
252
   function "<="
253
     (Left  : String;
254
      Right : Unbounded_String) return Boolean
255
   is
256
   begin
257
      return Left <= Right.Reference (1 .. Right.Last);
258
   end "<=";
259
 
260
   ---------
261
   -- "=" --
262
   ---------
263
 
264
   function "="
265
     (Left  : Unbounded_String;
266
      Right : Unbounded_String) return Boolean
267
   is
268
   begin
269
      return
270
        Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
271
   end "=";
272
 
273
   function "="
274
     (Left  : Unbounded_String;
275
      Right : String) return Boolean
276
   is
277
   begin
278
      return Left.Reference (1 .. Left.Last) = Right;
279
   end "=";
280
 
281
   function "="
282
     (Left  : String;
283
      Right : Unbounded_String) return Boolean
284
   is
285
   begin
286
      return Left = Right.Reference (1 .. Right.Last);
287
   end "=";
288
 
289
   ---------
290
   -- ">" --
291
   ---------
292
 
293
   function ">"
294
     (Left  : Unbounded_String;
295
      Right : Unbounded_String) return Boolean
296
   is
297
   begin
298
      return
299
        Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
300
   end ">";
301
 
302
   function ">"
303
     (Left  : Unbounded_String;
304
      Right : String) return Boolean
305
   is
306
   begin
307
      return Left.Reference (1 .. Left.Last) > Right;
308
   end ">";
309
 
310
   function ">"
311
     (Left  : String;
312
      Right : Unbounded_String) return Boolean
313
   is
314
   begin
315
      return Left > Right.Reference (1 .. Right.Last);
316
   end ">";
317
 
318
   ----------
319
   -- ">=" --
320
   ----------
321
 
322
   function ">="
323
     (Left  : Unbounded_String;
324
      Right : Unbounded_String) return Boolean
325
   is
326
   begin
327
      return
328
        Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
329
   end ">=";
330
 
331
   function ">="
332
     (Left  : Unbounded_String;
333
      Right : String) return Boolean
334
   is
335
   begin
336
      return Left.Reference (1 .. Left.Last) >= Right;
337
   end ">=";
338
 
339
   function ">="
340
     (Left  : String;
341
      Right : Unbounded_String) return Boolean
342
   is
343
   begin
344
      return Left >= Right.Reference (1 .. Right.Last);
345
   end ">=";
346
 
347
   ------------
348
   -- Adjust --
349
   ------------
350
 
351
   procedure Adjust (Object : in out Unbounded_String) is
352
   begin
353
      --  Copy string, except we do not copy the statically allocated null
354
      --  string since it can never be deallocated. Note that we do not copy
355
      --  extra string room here to avoid dragging unused allocated memory.
356
 
357
      if Object.Reference /= Null_String'Access then
358
         Object.Reference := new String'(Object.Reference (1 .. Object.Last));
359
      end if;
360
   end Adjust;
361
 
362
   ------------
363
   -- Append --
364
   ------------
365
 
366
   procedure Append
367
     (Source   : in out Unbounded_String;
368
      New_Item : Unbounded_String)
369
   is
370
   begin
371
      Realloc_For_Chunk (Source, New_Item.Last);
372
      Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
373
        New_Item.Reference (1 .. New_Item.Last);
374
      Source.Last := Source.Last + New_Item.Last;
375
   end Append;
376
 
377
   procedure Append
378
     (Source   : in out Unbounded_String;
379
      New_Item : String)
380
   is
381
   begin
382
      Realloc_For_Chunk (Source, New_Item'Length);
383
      Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
384
        New_Item;
385
      Source.Last := Source.Last + New_Item'Length;
386
   end Append;
387
 
388
   procedure Append
389
     (Source   : in out Unbounded_String;
390
      New_Item : Character)
391
   is
392
   begin
393
      Realloc_For_Chunk (Source, 1);
394
      Source.Reference (Source.Last + 1) := New_Item;
395
      Source.Last := Source.Last + 1;
396
   end Append;
397
 
398
   -----------
399
   -- Count --
400
   -----------
401
 
402
   function Count
403
     (Source  : Unbounded_String;
404
      Pattern : String;
405
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
406
   is
407
   begin
408
      return
409
        Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
410
   end Count;
411
 
412
   function Count
413
     (Source  : Unbounded_String;
414
      Pattern : String;
415
      Mapping : Maps.Character_Mapping_Function) return Natural
416
   is
417
   begin
418
      return
419
        Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
420
   end Count;
421
 
422
   function Count
423
     (Source : Unbounded_String;
424
      Set    : Maps.Character_Set) return Natural
425
   is
426
   begin
427
      return Search.Count (Source.Reference (1 .. Source.Last), Set);
428
   end Count;
429
 
430
   ------------
431
   -- Delete --
432
   ------------
433
 
434
   function Delete
435
     (Source  : Unbounded_String;
436
      From    : Positive;
437
      Through : Natural) return Unbounded_String
438
   is
439
   begin
440
      return
441
        To_Unbounded_String
442
          (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
443
   end Delete;
444
 
445
   procedure Delete
446
     (Source  : in out Unbounded_String;
447
      From    : Positive;
448
      Through : Natural)
449
   is
450
   begin
451
      if From > Through then
452
         null;
453
 
454
      elsif From < Source.Reference'First or else Through > Source.Last then
455
         raise Index_Error;
456
 
457
      else
458
         declare
459
            Len : constant Natural := Through - From + 1;
460
 
461
         begin
462
            Source.Reference (From .. Source.Last - Len) :=
463
              Source.Reference (Through + 1 .. Source.Last);
464
            Source.Last := Source.Last - Len;
465
         end;
466
      end if;
467
   end Delete;
468
 
469
   -------------
470
   -- Element --
471
   -------------
472
 
473
   function Element
474
     (Source : Unbounded_String;
475
      Index  : Positive) return Character
476
   is
477
   begin
478
      if Index <= Source.Last then
479
         return Source.Reference (Index);
480
      else
481
         raise Strings.Index_Error;
482
      end if;
483
   end Element;
484
 
485
   --------------
486
   -- Finalize --
487
   --------------
488
 
489
   procedure Finalize (Object : in out Unbounded_String) is
490
      procedure Deallocate is
491
         new Ada.Unchecked_Deallocation (String, String_Access);
492
 
493
   begin
494
      --  Note: Don't try to free statically allocated null string
495
 
496
      if Object.Reference /= Null_String'Access then
497
         Deallocate (Object.Reference);
498
         Object.Reference := Null_Unbounded_String.Reference;
499
         Object.Last := 0;
500
      end if;
501
   end Finalize;
502
 
503
   ----------------
504
   -- Find_Token --
505
   ----------------
506
 
507
   procedure Find_Token
508
     (Source : Unbounded_String;
509
      Set    : Maps.Character_Set;
510
      Test   : Strings.Membership;
511
      First  : out Positive;
512
      Last   : out Natural)
513
   is
514
   begin
515
      Search.Find_Token
516
        (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
517
   end Find_Token;
518
 
519
   ----------
520
   -- Free --
521
   ----------
522
 
523
   procedure Free (X : in out String_Access) is
524
      procedure Deallocate is
525
         new Ada.Unchecked_Deallocation (String, String_Access);
526
 
527
   begin
528
      --  Note: Do not try to free statically allocated null string
529
 
530
      if X /= Null_Unbounded_String.Reference then
531
         Deallocate (X);
532
      end if;
533
   end Free;
534
 
535
   ----------
536
   -- Head --
537
   ----------
538
 
539
   function Head
540
     (Source : Unbounded_String;
541
      Count  : Natural;
542
      Pad    : Character := Space) return Unbounded_String
543
   is
544
   begin
545
      return To_Unbounded_String
546
        (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
547
   end Head;
548
 
549
   procedure Head
550
     (Source : in out Unbounded_String;
551
      Count  : Natural;
552
      Pad    : Character := Space)
553
   is
554
      Old : String_Access := Source.Reference;
555
   begin
556
      Source.Reference :=
557
        new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
558
                    Count, Pad));
559
      Source.Last := Source.Reference'Length;
560
      Free (Old);
561
   end Head;
562
 
563
   -----------
564
   -- Index --
565
   -----------
566
 
567
   function Index
568
     (Source  : Unbounded_String;
569
      Pattern : String;
570
      Going   : Strings.Direction := Strings.Forward;
571
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
572
   is
573
   begin
574
      return Search.Index
575
        (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
576
   end Index;
577
 
578
   function Index
579
     (Source  : Unbounded_String;
580
      Pattern : String;
581
      Going   : Direction := Forward;
582
      Mapping : Maps.Character_Mapping_Function) return Natural
583
   is
584
   begin
585
      return Search.Index
586
        (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
587
   end Index;
588
 
589
   function Index
590
     (Source : Unbounded_String;
591
      Set    : Maps.Character_Set;
592
      Test   : Strings.Membership := Strings.Inside;
593
      Going  : Strings.Direction  := Strings.Forward) return Natural
594
   is
595
   begin
596
      return Search.Index
597
        (Source.Reference (1 .. Source.Last), Set, Test, Going);
598
   end Index;
599
 
600
   function Index
601
     (Source  : Unbounded_String;
602
      Pattern : String;
603
      From    : Positive;
604
      Going   : Direction := Forward;
605
      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
606
   is
607
   begin
608
      return Search.Index
609
        (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
610
   end Index;
611
 
612
   function Index
613
     (Source  : Unbounded_String;
614
      Pattern : String;
615
      From    : Positive;
616
      Going   : Direction := Forward;
617
      Mapping : Maps.Character_Mapping_Function) return Natural
618
   is
619
   begin
620
      return Search.Index
621
        (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
622
   end Index;
623
 
624
   function Index
625
     (Source  : Unbounded_String;
626
      Set     : Maps.Character_Set;
627
      From    : Positive;
628
      Test    : Membership := Inside;
629
      Going   : Direction := Forward) return Natural
630
   is
631
   begin
632
      return Search.Index
633
        (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
634
   end Index;
635
 
636
   function Index_Non_Blank
637
     (Source : Unbounded_String;
638
      Going  : Strings.Direction := Strings.Forward) return Natural
639
   is
640
   begin
641
      return
642
        Search.Index_Non_Blank
643
          (Source.Reference (1 .. Source.Last), Going);
644
   end Index_Non_Blank;
645
 
646
   function Index_Non_Blank
647
     (Source : Unbounded_String;
648
      From   : Positive;
649
      Going  : Direction := Forward) return Natural
650
   is
651
   begin
652
      return
653
        Search.Index_Non_Blank
654
          (Source.Reference (1 .. Source.Last), From, Going);
655
   end Index_Non_Blank;
656
 
657
   ----------------
658
   -- Initialize --
659
   ----------------
660
 
661
   procedure Initialize (Object : in out Unbounded_String) is
662
   begin
663
      Object.Reference := Null_Unbounded_String.Reference;
664
      Object.Last      := 0;
665
   end Initialize;
666
 
667
   ------------
668
   -- Insert --
669
   ------------
670
 
671
   function Insert
672
     (Source   : Unbounded_String;
673
      Before   : Positive;
674
      New_Item : String) return Unbounded_String
675
   is
676
   begin
677
      return To_Unbounded_String
678
        (Fixed.Insert (Source.Reference (1 .. Source.Last), Before, New_Item));
679
   end Insert;
680
 
681
   procedure Insert
682
     (Source   : in out Unbounded_String;
683
      Before   : Positive;
684
      New_Item : String)
685
   is
686
   begin
687
      if Before not in Source.Reference'First .. Source.Last + 1 then
688
         raise Index_Error;
689
      end if;
690
 
691
      Realloc_For_Chunk (Source, New_Item'Length);
692
 
693
      Source.Reference
694
        (Before +  New_Item'Length .. Source.Last + New_Item'Length) :=
695
           Source.Reference (Before .. Source.Last);
696
 
697
      Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
698
      Source.Last := Source.Last + New_Item'Length;
699
   end Insert;
700
 
701
   ------------
702
   -- Length --
703
   ------------
704
 
705
   function Length (Source : Unbounded_String) return Natural is
706
   begin
707
      return Source.Last;
708
   end Length;
709
 
710
   ---------------
711
   -- Overwrite --
712
   ---------------
713
 
714
   function Overwrite
715
     (Source   : Unbounded_String;
716
      Position : Positive;
717
      New_Item : String) return Unbounded_String
718
   is
719
   begin
720
      return To_Unbounded_String
721
        (Fixed.Overwrite
722
          (Source.Reference (1 .. Source.Last), Position, New_Item));
723
   end Overwrite;
724
 
725
   procedure Overwrite
726
     (Source    : in out Unbounded_String;
727
      Position  : Positive;
728
      New_Item  : String)
729
   is
730
      NL : constant Natural := New_Item'Length;
731
   begin
732
      if Position <= Source.Last - NL + 1 then
733
         Source.Reference (Position .. Position + NL - 1) := New_Item;
734
      else
735
         declare
736
            Old : String_Access := Source.Reference;
737
         begin
738
            Source.Reference := new String'
739
              (Fixed.Overwrite
740
                (Source.Reference (1 .. Source.Last), Position, New_Item));
741
            Source.Last := Source.Reference'Length;
742
            Free (Old);
743
         end;
744
      end if;
745
   end Overwrite;
746
 
747
   -----------------------
748
   -- Realloc_For_Chunk --
749
   -----------------------
750
 
751
   procedure Realloc_For_Chunk
752
     (Source     : in out Unbounded_String;
753
      Chunk_Size : Natural)
754
   is
755
      Growth_Factor : constant := 32;
756
      --  The growth factor controls how much extra space is allocated when
757
      --  we have to increase the size of an allocated unbounded string. By
758
      --  allocating extra space, we avoid the need to reallocate on every
759
      --  append, particularly important when a string is built up by repeated
760
      --  append operations of small pieces. This is expressed as a factor so
761
      --  32 means add 1/32 of the length of the string as growth space.
762
 
763
      Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
764
      --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
765
      --  no memory loss as most (all?) malloc implementations are obliged to
766
      --  align the returned memory on the maximum alignment as malloc does not
767
      --  know the target alignment.
768
 
769
      S_Length : constant Natural := Source.Reference'Length;
770
 
771
   begin
772
      if Chunk_Size > S_Length - Source.Last then
773
         declare
774
            New_Size : constant Positive :=
775
                         S_Length + Chunk_Size + (S_Length / Growth_Factor);
776
 
777
            New_Rounded_Up_Size : constant Positive :=
778
                                    ((New_Size - 1) / Min_Mul_Alloc + 1) *
779
                                       Min_Mul_Alloc;
780
 
781
            Tmp : constant String_Access :=
782
                    new String (1 .. New_Rounded_Up_Size);
783
 
784
         begin
785
            Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
786
            Free (Source.Reference);
787
            Source.Reference := Tmp;
788
         end;
789
      end if;
790
   end Realloc_For_Chunk;
791
 
792
   ---------------------
793
   -- Replace_Element --
794
   ---------------------
795
 
796
   procedure Replace_Element
797
     (Source : in out Unbounded_String;
798
      Index  : Positive;
799
      By     : Character)
800
   is
801
   begin
802
      if Index <= Source.Last then
803
         Source.Reference (Index) := By;
804
      else
805
         raise Strings.Index_Error;
806
      end if;
807
   end Replace_Element;
808
 
809
   -------------------
810
   -- Replace_Slice --
811
   -------------------
812
 
813
   function Replace_Slice
814
     (Source : Unbounded_String;
815
      Low    : Positive;
816
      High   : Natural;
817
      By     : String) return Unbounded_String
818
   is
819
   begin
820
      return To_Unbounded_String
821
        (Fixed.Replace_Slice
822
           (Source.Reference (1 .. Source.Last), Low, High, By));
823
   end Replace_Slice;
824
 
825
   procedure Replace_Slice
826
     (Source : in out Unbounded_String;
827
      Low    : Positive;
828
      High   : Natural;
829
      By     : String)
830
   is
831
      Old : String_Access := Source.Reference;
832
   begin
833
      Source.Reference := new String'
834
        (Fixed.Replace_Slice
835
           (Source.Reference (1 .. Source.Last), Low, High, By));
836
      Source.Last := Source.Reference'Length;
837
      Free (Old);
838
   end Replace_Slice;
839
 
840
   --------------------------
841
   -- Set_Unbounded_String --
842
   --------------------------
843
 
844
   procedure Set_Unbounded_String
845
     (Target : out Unbounded_String;
846
      Source : String)
847
   is
848
      Old : String_Access := Target.Reference;
849
   begin
850
      Target.Last          := Source'Length;
851
      Target.Reference     := new String (1 .. Source'Length);
852
      Target.Reference.all := Source;
853
      Free (Old);
854
   end Set_Unbounded_String;
855
 
856
   -----------
857
   -- Slice --
858
   -----------
859
 
860
   function Slice
861
     (Source : Unbounded_String;
862
      Low    : Positive;
863
      High   : Natural) return String
864
   is
865
   begin
866
      --  Note: test of High > Length is in accordance with AI95-00128
867
 
868
      if Low > Source.Last + 1 or else High > Source.Last then
869
         raise Index_Error;
870
      else
871
         return Source.Reference (Low .. High);
872
      end if;
873
   end Slice;
874
 
875
   ----------
876
   -- Tail --
877
   ----------
878
 
879
   function Tail
880
     (Source : Unbounded_String;
881
      Count  : Natural;
882
      Pad    : Character := Space) return Unbounded_String is
883
   begin
884
      return To_Unbounded_String
885
        (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
886
   end Tail;
887
 
888
   procedure Tail
889
     (Source : in out Unbounded_String;
890
      Count  : Natural;
891
      Pad    : Character := Space)
892
   is
893
      Old : String_Access := Source.Reference;
894
   begin
895
      Source.Reference := new String'
896
        (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
897
      Source.Last := Source.Reference'Length;
898
      Free (Old);
899
   end Tail;
900
 
901
   ---------------
902
   -- To_String --
903
   ---------------
904
 
905
   function To_String (Source : Unbounded_String) return String is
906
   begin
907
      return Source.Reference (1 .. Source.Last);
908
   end To_String;
909
 
910
   -------------------------
911
   -- To_Unbounded_String --
912
   -------------------------
913
 
914
   function To_Unbounded_String (Source : String) return Unbounded_String is
915
      Result : Unbounded_String;
916
   begin
917
      Result.Last          := Source'Length;
918
      Result.Reference     := new String (1 .. Source'Length);
919
      Result.Reference.all := Source;
920
      return Result;
921
   end To_Unbounded_String;
922
 
923
   function To_Unbounded_String
924
     (Length : Natural) return Unbounded_String
925
   is
926
      Result : Unbounded_String;
927
   begin
928
      Result.Last      := Length;
929
      Result.Reference := new String (1 .. Length);
930
      return Result;
931
   end To_Unbounded_String;
932
 
933
   ---------------
934
   -- Translate --
935
   ---------------
936
 
937
   function Translate
938
     (Source  : Unbounded_String;
939
      Mapping : Maps.Character_Mapping) return Unbounded_String
940
   is
941
   begin
942
      return To_Unbounded_String
943
        (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
944
   end Translate;
945
 
946
   procedure Translate
947
     (Source  : in out Unbounded_String;
948
      Mapping : Maps.Character_Mapping)
949
   is
950
   begin
951
      Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
952
   end Translate;
953
 
954
   function Translate
955
     (Source  : Unbounded_String;
956
      Mapping : Maps.Character_Mapping_Function) return Unbounded_String
957
   is
958
   begin
959
      return To_Unbounded_String
960
        (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
961
   end Translate;
962
 
963
   procedure Translate
964
     (Source  : in out Unbounded_String;
965
      Mapping : Maps.Character_Mapping_Function)
966
   is
967
   begin
968
      Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
969
   end Translate;
970
 
971
   ----------
972
   -- Trim --
973
   ----------
974
 
975
   function Trim
976
     (Source : Unbounded_String;
977
      Side   : Trim_End) return Unbounded_String
978
   is
979
   begin
980
      return To_Unbounded_String
981
        (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
982
   end Trim;
983
 
984
   procedure Trim
985
     (Source : in out Unbounded_String;
986
      Side   : Trim_End)
987
   is
988
      Old : String_Access := Source.Reference;
989
   begin
990
      Source.Reference := new String'
991
        (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
992
      Source.Last      := Source.Reference'Length;
993
      Free (Old);
994
   end Trim;
995
 
996
   function Trim
997
     (Source : Unbounded_String;
998
      Left   : Maps.Character_Set;
999
      Right  : Maps.Character_Set) return Unbounded_String
1000
   is
1001
   begin
1002
      return To_Unbounded_String
1003
        (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1004
   end Trim;
1005
 
1006
   procedure Trim
1007
     (Source : in out Unbounded_String;
1008
      Left   : Maps.Character_Set;
1009
      Right  : Maps.Character_Set)
1010
   is
1011
      Old : String_Access := Source.Reference;
1012
   begin
1013
      Source.Reference := new String'
1014
        (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1015
      Source.Last      := Source.Reference'Length;
1016
      Free (Old);
1017
   end Trim;
1018
 
1019
   ---------------------
1020
   -- Unbounded_Slice --
1021
   ---------------------
1022
 
1023
   function Unbounded_Slice
1024
     (Source : Unbounded_String;
1025
      Low    : Positive;
1026
      High   : Natural) return Unbounded_String
1027
   is
1028
   begin
1029
      if Low > Source.Last + 1 or else High > Source.Last then
1030
         raise Index_Error;
1031
      else
1032
         return To_Unbounded_String (Source.Reference.all (Low .. High));
1033
      end if;
1034
   end Unbounded_Slice;
1035
 
1036
   procedure Unbounded_Slice
1037
     (Source : Unbounded_String;
1038
      Target : out Unbounded_String;
1039
      Low    : Positive;
1040
      High   : Natural)
1041
   is
1042
   begin
1043
      if Low > Source.Last + 1 or else High > Source.Last then
1044
         raise Index_Error;
1045
      else
1046
         Target := To_Unbounded_String (Source.Reference.all (Low .. High));
1047
      end if;
1048
   end Unbounded_Slice;
1049
 
1050
end Ada.Strings.Unbounded;

powered by: WebSVN 2.1.0

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