1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--      A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D       --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
10--                                                                          --
11-- This specification is derived from the Ada Reference Manual for use with --
12-- GNAT. The copyright notice above, and the license provisions that follow --
13-- apply solely to the  contents of the part following the private keyword. --
14--                                                                          --
15-- GNAT is free software;  you can  redistribute it  and/or modify it under --
16-- terms of the  GNU General Public License as published  by the Free Soft- --
17-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
18-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
19-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
20-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
21--                                                                          --
22-- As a special exception under Section 7 of GPL version 3, you are granted --
23-- additional permissions described in the GCC Runtime Library Exception,   --
24-- version 3.1, as published by the Free Software Foundation.               --
25--                                                                          --
26-- You should have received a copy of the GNU General Public License and    --
27-- a copy of the GCC Runtime Library Exception along with this program;     --
28-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
29-- <http://www.gnu.org/licenses/>.                                          --
30--                                                                          --
31-- GNAT was originally developed  by the GNAT team at  New York University. --
32-- Extensive contributions were provided by Ada Core Technologies Inc.      --
33--                                                                          --
34------------------------------------------------------------------------------
35
36--  This version is supported on:
37--    - all Alpha platforms
38--    - all ia64 platforms
39--    - all PowerPC platforms
40--    - all SPARC V9 platforms
41--    - all x86 platforms
42--    - all x86_64 platforms
43
44with Ada.Strings.Wide_Wide_Maps;
45private with Ada.Finalization;
46private with System.Atomic_Counters;
47
48package Ada.Strings.Wide_Wide_Unbounded is
49   pragma Preelaborate;
50
51   type Unbounded_Wide_Wide_String is private;
52   pragma Preelaborable_Initialization (Unbounded_Wide_Wide_String);
53
54   Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String;
55
56   function Length (Source : Unbounded_Wide_Wide_String) return Natural;
57
58   type Wide_Wide_String_Access is access all Wide_Wide_String;
59
60   procedure Free (X : in out Wide_Wide_String_Access);
61
62   --------------------------------------------------------
63   -- Conversion, Concatenation, and Selection Functions --
64   --------------------------------------------------------
65
66   function To_Unbounded_Wide_Wide_String
67     (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String;
68
69   function To_Unbounded_Wide_Wide_String
70     (Length : Natural) return Unbounded_Wide_Wide_String;
71
72   function To_Wide_Wide_String
73     (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String;
74
75   procedure Set_Unbounded_Wide_Wide_String
76     (Target : out Unbounded_Wide_Wide_String;
77      Source : Wide_Wide_String);
78   pragma Ada_05 (Set_Unbounded_Wide_Wide_String);
79
80   procedure Append
81     (Source   : in out Unbounded_Wide_Wide_String;
82      New_Item : Unbounded_Wide_Wide_String);
83
84   procedure Append
85     (Source   : in out Unbounded_Wide_Wide_String;
86      New_Item : Wide_Wide_String);
87
88   procedure Append
89     (Source   : in out Unbounded_Wide_Wide_String;
90      New_Item : Wide_Wide_Character);
91
92   function "&"
93     (Left  : Unbounded_Wide_Wide_String;
94      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String;
95
96   function "&"
97     (Left  : Unbounded_Wide_Wide_String;
98      Right : Wide_Wide_String) return Unbounded_Wide_Wide_String;
99
100   function "&"
101     (Left  : Wide_Wide_String;
102      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String;
103
104   function "&"
105     (Left  : Unbounded_Wide_Wide_String;
106      Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String;
107
108   function "&"
109     (Left  : Wide_Wide_Character;
110      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String;
111
112   function Element
113     (Source : Unbounded_Wide_Wide_String;
114      Index  : Positive) return Wide_Wide_Character;
115
116   procedure Replace_Element
117     (Source : in out Unbounded_Wide_Wide_String;
118      Index  : Positive;
119      By     : Wide_Wide_Character);
120
121   function Slice
122     (Source : Unbounded_Wide_Wide_String;
123      Low    : Positive;
124      High   : Natural) return Wide_Wide_String;
125
126   function Unbounded_Slice
127     (Source : Unbounded_Wide_Wide_String;
128      Low    : Positive;
129      High   : Natural) return Unbounded_Wide_Wide_String;
130   pragma Ada_05 (Unbounded_Slice);
131
132   procedure Unbounded_Slice
133     (Source : Unbounded_Wide_Wide_String;
134      Target : out Unbounded_Wide_Wide_String;
135      Low    : Positive;
136      High   : Natural);
137   pragma Ada_05 (Unbounded_Slice);
138
139   function "="
140     (Left  : Unbounded_Wide_Wide_String;
141      Right : Unbounded_Wide_Wide_String) return Boolean;
142
143   function "="
144     (Left  : Unbounded_Wide_Wide_String;
145      Right : Wide_Wide_String) return Boolean;
146
147   function "="
148     (Left  : Wide_Wide_String;
149      Right : Unbounded_Wide_Wide_String) return Boolean;
150
151   function "<"
152     (Left  : Unbounded_Wide_Wide_String;
153      Right : Unbounded_Wide_Wide_String) return Boolean;
154
155   function "<"
156     (Left  : Unbounded_Wide_Wide_String;
157      Right : Wide_Wide_String) return Boolean;
158
159   function "<"
160     (Left  : Wide_Wide_String;
161      Right : Unbounded_Wide_Wide_String) return Boolean;
162
163   function "<="
164     (Left  : Unbounded_Wide_Wide_String;
165      Right : Unbounded_Wide_Wide_String) return Boolean;
166
167   function "<="
168     (Left  : Unbounded_Wide_Wide_String;
169      Right : Wide_Wide_String) return Boolean;
170
171   function "<="
172     (Left  : Wide_Wide_String;
173      Right : Unbounded_Wide_Wide_String) return Boolean;
174
175   function ">"
176     (Left  : Unbounded_Wide_Wide_String;
177      Right : Unbounded_Wide_Wide_String) return Boolean;
178
179   function ">"
180     (Left  : Unbounded_Wide_Wide_String;
181      Right : Wide_Wide_String) return Boolean;
182
183   function ">"
184     (Left  : Wide_Wide_String;
185      Right : Unbounded_Wide_Wide_String) return Boolean;
186
187   function ">="
188     (Left  : Unbounded_Wide_Wide_String;
189      Right : Unbounded_Wide_Wide_String) return Boolean;
190
191   function ">="
192     (Left  : Unbounded_Wide_Wide_String;
193      Right : Wide_Wide_String) return Boolean;
194
195   function ">="
196     (Left  : Wide_Wide_String;
197      Right : Unbounded_Wide_Wide_String) return Boolean;
198
199   ------------------------
200   -- Search Subprograms --
201   ------------------------
202
203   function Index
204     (Source  : Unbounded_Wide_Wide_String;
205      Pattern : Wide_Wide_String;
206      Going   : Direction := Forward;
207      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
208                  Wide_Wide_Maps.Identity)
209      return Natural;
210
211   function Index
212     (Source  : Unbounded_Wide_Wide_String;
213      Pattern : Wide_Wide_String;
214      Going   : Direction := Forward;
215      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
216      return Natural;
217
218   function Index
219     (Source : Unbounded_Wide_Wide_String;
220      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
221      Test   : Membership := Inside;
222      Going  : Direction  := Forward) return Natural;
223
224   function Index
225     (Source  : Unbounded_Wide_Wide_String;
226      Pattern : Wide_Wide_String;
227      From    : Positive;
228      Going   : Direction := Forward;
229      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
230                  Wide_Wide_Maps.Identity)
231      return Natural;
232   pragma Ada_05 (Index);
233
234   function Index
235     (Source  : Unbounded_Wide_Wide_String;
236      Pattern : Wide_Wide_String;
237      From    : Positive;
238      Going   : Direction := Forward;
239      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
240      return Natural;
241   pragma Ada_05 (Index);
242
243   function Index
244     (Source  : Unbounded_Wide_Wide_String;
245      Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
246      From    : Positive;
247      Test    : Membership := Inside;
248      Going   : Direction := Forward) return Natural;
249   pragma Ada_05 (Index);
250
251   function Index_Non_Blank
252     (Source : Unbounded_Wide_Wide_String;
253      Going  : Direction := Forward) return Natural;
254
255   function Index_Non_Blank
256     (Source : Unbounded_Wide_Wide_String;
257      From   : Positive;
258      Going  : Direction := Forward) return Natural;
259   pragma Ada_05 (Index_Non_Blank);
260
261   function Count
262     (Source  : Unbounded_Wide_Wide_String;
263      Pattern : Wide_Wide_String;
264      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
265                  Wide_Wide_Maps.Identity)
266      return Natural;
267
268   function Count
269     (Source  : Unbounded_Wide_Wide_String;
270      Pattern : Wide_Wide_String;
271      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
272      return Natural;
273
274   function Count
275     (Source : Unbounded_Wide_Wide_String;
276      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural;
277
278   procedure Find_Token
279     (Source : Unbounded_Wide_Wide_String;
280      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
281      From   : Positive;
282      Test   : Membership;
283      First  : out Positive;
284      Last   : out Natural);
285   pragma Ada_2012 (Find_Token);
286
287   procedure Find_Token
288     (Source : Unbounded_Wide_Wide_String;
289      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
290      Test   : Membership;
291      First  : out Positive;
292      Last   : out Natural);
293
294   ------------------------------------
295   -- String Translation Subprograms --
296   ------------------------------------
297
298   function Translate
299     (Source  : Unbounded_Wide_Wide_String;
300      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
301      return Unbounded_Wide_Wide_String;
302
303   procedure Translate
304     (Source  : in out Unbounded_Wide_Wide_String;
305      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping);
306
307   function Translate
308     (Source  : Unbounded_Wide_Wide_String;
309      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
310      return Unbounded_Wide_Wide_String;
311
312   procedure Translate
313     (Source  : in out Unbounded_Wide_Wide_String;
314      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function);
315
316   ---------------------------------------
317   -- String Transformation Subprograms --
318   ---------------------------------------
319
320   function Replace_Slice
321     (Source : Unbounded_Wide_Wide_String;
322      Low    : Positive;
323      High   : Natural;
324      By     : Wide_Wide_String) return Unbounded_Wide_Wide_String;
325
326   procedure Replace_Slice
327     (Source : in out Unbounded_Wide_Wide_String;
328      Low    : Positive;
329      High   : Natural;
330      By     : Wide_Wide_String);
331
332   function Insert
333     (Source   : Unbounded_Wide_Wide_String;
334      Before   : Positive;
335      New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String;
336
337   procedure Insert
338     (Source   : in out Unbounded_Wide_Wide_String;
339      Before   : Positive;
340      New_Item : Wide_Wide_String);
341
342   function Overwrite
343     (Source   : Unbounded_Wide_Wide_String;
344      Position : Positive;
345      New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String;
346
347   procedure Overwrite
348     (Source   : in out Unbounded_Wide_Wide_String;
349      Position : Positive;
350      New_Item : Wide_Wide_String);
351
352   function Delete
353     (Source  : Unbounded_Wide_Wide_String;
354      From    : Positive;
355      Through : Natural) return Unbounded_Wide_Wide_String;
356
357   procedure Delete
358     (Source  : in out Unbounded_Wide_Wide_String;
359      From    : Positive;
360      Through : Natural);
361
362   function Trim
363     (Source : Unbounded_Wide_Wide_String;
364      Side   : Trim_End) return Unbounded_Wide_Wide_String;
365
366   procedure Trim
367     (Source : in out Unbounded_Wide_Wide_String;
368      Side   : Trim_End);
369
370   function Trim
371     (Source : Unbounded_Wide_Wide_String;
372      Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
373      Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
374      return Unbounded_Wide_Wide_String;
375
376   procedure Trim
377     (Source : in out Unbounded_Wide_Wide_String;
378      Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
379      Right  : Wide_Wide_Maps.Wide_Wide_Character_Set);
380
381   function Head
382     (Source : Unbounded_Wide_Wide_String;
383      Count  : Natural;
384      Pad    : Wide_Wide_Character := Wide_Wide_Space)
385      return Unbounded_Wide_Wide_String;
386
387   procedure Head
388     (Source : in out Unbounded_Wide_Wide_String;
389      Count  : Natural;
390      Pad    : Wide_Wide_Character := Wide_Wide_Space);
391
392   function Tail
393     (Source : Unbounded_Wide_Wide_String;
394      Count  : Natural;
395      Pad    : Wide_Wide_Character := Wide_Wide_Space)
396      return Unbounded_Wide_Wide_String;
397
398   procedure Tail
399     (Source : in out Unbounded_Wide_Wide_String;
400      Count  : Natural;
401      Pad    : Wide_Wide_Character := Wide_Wide_Space);
402
403   function "*"
404     (Left  : Natural;
405      Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String;
406
407   function "*"
408     (Left  : Natural;
409      Right : Wide_Wide_String) return Unbounded_Wide_Wide_String;
410
411   function "*"
412     (Left  : Natural;
413      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String;
414
415private
416   pragma Inline (Length);
417
418   package AF renames Ada.Finalization;
419
420   type Shared_Wide_Wide_String (Max_Length : Natural) is limited record
421      Counter : System.Atomic_Counters.Atomic_Counter;
422      --  Reference counter
423
424      Last : Natural := 0;
425      Data : Wide_Wide_String (1 .. Max_Length);
426      --  Last is the index of last significant element of the Data. All
427      --  elements with larger indexes are just extra room for expansion.
428   end record;
429
430   type Shared_Wide_Wide_String_Access is access all Shared_Wide_Wide_String;
431
432   procedure Reference (Item : not null Shared_Wide_Wide_String_Access);
433   --  Increment reference counter.
434
435   procedure Unreference (Item : not null Shared_Wide_Wide_String_Access);
436   --  Decrement reference counter. Deallocate Item when reference counter is
437   --  zero.
438
439   function Can_Be_Reused
440     (Item   : Shared_Wide_Wide_String_Access;
441      Length : Natural) return Boolean;
442   --  Returns True if Shared_Wide_Wide_String can be reused. There are two
443   --  criteria when Shared_Wide_Wide_String can be reused: its reference
444   --  counter must be one (thus Shared_Wide_Wide_String is owned exclusively)
445   --  and its size is sufficient to store string with specified length
446   --  effectively.
447
448   function Allocate
449     (Max_Length : Natural) return Shared_Wide_Wide_String_Access;
450   --  Allocates new Shared_Wide_Wide_String with at least specified maximum
451   --  length. Actual maximum length of the allocated Shared_Wide_Wide_String
452   --  can be slightly greater. Returns reference to
453   --  Empty_Shared_Wide_Wide_String when requested length is zero.
454
455   Empty_Shared_Wide_Wide_String : aliased Shared_Wide_Wide_String (0);
456
457   function To_Unbounded
458     (S : Wide_Wide_String) return Unbounded_Wide_Wide_String
459     renames To_Unbounded_Wide_Wide_String;
460   --  This renames are here only to be used in the pragma Stream_Convert.
461
462   type Unbounded_Wide_Wide_String is new AF.Controlled with record
463      Reference : Shared_Wide_Wide_String_Access :=
464                    Empty_Shared_Wide_Wide_String'Access;
465   end record;
466
467   --  The Unbounded_Wide_Wide_String uses several techniques to increase speed
468   --  of the application:
469
470   --   - implicit sharing or copy-on-write. Unbounded_Wide_Wide_String
471   --     contains only the reference to the data which is shared between
472   --     several instances. The shared data is reallocated only when its value
473   --     is changed and the object mutation can't be used or it is inefficient
474   --     to use it;
475
476   --   - object mutation. Shared data object can be reused without memory
477   --     reallocation when all of the following requirements are meat:
478   --      - shared data object don't used anywhere longer;
479   --      - its size is sufficient to store new value;
480   --      - the gap after reuse is less than some threshold.
481
482   --   - memory preallocation. Most of used memory allocation algorithms
483   --     aligns allocated segment on the some boundary, thus some amount of
484   --     additional memory can be preallocated without any impact. Such
485   --     preallocated memory can used later by Append/Insert operations
486   --     without reallocation.
487
488   --  Reference counting uses GCC builtin atomic operations, which allows safe
489   --  sharing of internal data between Ada tasks. Nevertheless, this does not
490   --  make objects of Unbounded_String thread-safe: an instance cannot be
491   --  accessed by several tasks simultaneously.
492
493   pragma Stream_Convert
494     (Unbounded_Wide_Wide_String, To_Unbounded, To_Wide_Wide_String);
495   --  Provide stream routines without dragging in Ada.Streams
496
497   pragma Finalize_Storage_Only (Unbounded_Wide_Wide_String);
498   --  Finalization is required only for freeing storage
499
500   overriding procedure Initialize
501     (Object : in out Unbounded_Wide_Wide_String);
502   overriding procedure Adjust
503     (Object : in out Unbounded_Wide_Wide_String);
504   overriding procedure Finalize
505     (Object : in out Unbounded_Wide_Wide_String);
506   pragma Inline (Initialize, Adjust);
507
508   Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String :=
509                                       (AF.Controlled with
510                                          Reference =>
511                                            Empty_Shared_Wide_Wide_String'
512                                              Access);
513
514end Ada.Strings.Wide_Wide_Unbounded;
515