end if;
elsif Is_Access_Type (U_Type) then
- if Is_Access_Protected_Subprogram_Type (U_Type) then
+ if Is_Access_Protected_Subprogram_Type (Base_Type (U_Type)) then
Lib_RE := RE_Put_Image_Access_Prot_Subp;
- elsif Is_Access_Subprogram_Type (U_Type) then
+ elsif Is_Access_Subprogram_Type (Base_Type (U_Type)) then
Lib_RE := RE_Put_Image_Access_Subp;
elsif P_Size = System_Address_Size then
Lib_RE := RE_Put_Image_Thin_Pointer;
------------------------------------------------------------------------------
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Bounded_Doubly_Linked_Lists with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : List)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
Last : Count_Type := 0;
Length : Count_Type := 0;
TC : aliased Tamper_Counts;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : List);
procedure Read
(Stream : not null access Root_Stream_Type'Class;
with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Bounded_Hashed_Maps with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+
+ procedure Put_Key_Value (Position : Cursor);
+ procedure Put_Key_Value (Position : Cursor) is
+ begin
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Key_Type'Put_Image (S, Key (Position));
+ Put_Arrow (S);
+ Element_Type'Put_Image (S, Element (Position));
+ end Put_Key_Value;
+
+ begin
+ Array_Before (S);
+ Iterate (V, Put_Key_Value'Access);
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
private with Ada.Finalization;
+private with Ada.Strings.Text_Output;
generic
type Key_Type is private;
new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
type Map (Capacity : Count_Type; Modulus : Hash_Type) is
- new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
+ new HT_Types.Hash_Table_Type (Capacity, Modulus)
+ with null record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
use HT_Types, HT_Types.Implementation;
use Ada.Streams;
with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Bounded_Hashed_Sets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
type Set (Capacity : Count_Type; Modulus : Hash_Type) is
- new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
+ new HT_Types.Hash_Table_Type (Capacity, Modulus)
+ with null record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
use HT_Types, HT_Types.Implementation;
use Ada.Streams;
with Ada.Finalization;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Bounded_Multiway_Trees with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree)
+ is
+ use System.Put_Images;
+
+ procedure Rec (Position : Cursor);
+ -- Recursive routine operating on cursors
+
+ procedure Rec (Position : Cursor) is
+ First_Time : Boolean := True;
+ begin
+ Array_Before (S);
+
+ for X in Iterate_Children (V, Position) loop
+ if First_Time then
+ First_Time := False;
+ else
+ Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, Element (X));
+ if Child_Count (X) > 0 then
+ Simple_Array_Between (S);
+ Rec (X);
+ end if;
+ end loop;
+
+ Array_After (S);
+ end Rec;
+
+ begin
+ if First_Child (Root (V)) = No_Element then
+ Array_Before (S);
+ Array_After (S);
+ else
+ Rec (First_Child (Root (V)));
+ end if;
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
Free : Count_Type'Base := No_Node;
TC : aliased Tamper_Counts;
Count : Count_Type := 0;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree);
procedure Write
(Stream : not null access Root_Stream_Type'Class;
(Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys);
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Bounded_Ordered_Maps with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+
+ procedure Put_Key_Value (Position : Cursor);
+ procedure Put_Key_Value (Position : Cursor) is
+ begin
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Key_Type'Put_Image (S, Key (Position));
+ Put_Arrow (S);
+ Element_Type'Put_Image (S, Element (Position));
+ end Put_Key_Value;
+
+ begin
+ Array_Before (S);
+ Iterate (V, Put_Key_Value'Access);
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Streams;
private with Ada.Finalization;
+private with Ada.Strings.Text_Output;
generic
type Key_Type is private;
new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
type Map (Capacity : Count_Type) is
- new Tree_Types.Tree_Type (Capacity) with null record;
+ new Tree_Types.Tree_Type (Capacity)
+ with null record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
use Red_Black_Trees;
use Tree_Types, Tree_Types.Implementation;
(Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations);
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Bounded_Ordered_Sets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Streams;
private with Ada.Finalization;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
type Set (Capacity : Count_Type) is
- new Tree_Types.Tree_Type (Capacity) with null record;
+ new Tree_Types.Tree_Type (Capacity)
+ with null record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
use Tree_Types, Tree_Types.Implementation;
use Ada.Finalization;
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Doubly_Linked_Lists with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : List)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
Last : Node_Access := null;
Length : Count_Type := 0;
TC : aliased Tamper_Counts;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : List);
overriding procedure Adjust (Container : in out List);
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Doubly_Linked_Lists with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : List)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type (<>) is private;
Last : Node_Access := null;
Length : Count_Type := 0;
TC : aliased Tamper_Counts;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : List);
overriding procedure Adjust (Container : in out List);
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Hashed_Maps with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+
+ procedure Put_Key_Value (Position : Cursor);
+ procedure Put_Key_Value (Position : Cursor) is
+ begin
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Key_Type'Put_Image (S, Key (Position));
+ Put_Arrow (S);
+ Element_Type'Put_Image (S, Element (Position));
+ end Put_Key_Value;
+
+ begin
+ Array_Before (S);
+ Iterate (V, Put_Key_Value'Access);
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Hash_Tables;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Key_Type (<>) is private;
type Map is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
with Ada.Containers.Prime_Numbers;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Hashed_Sets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
+private with Ada.Strings.Text_Output;
generic
type Element_Type (<>) is private;
type Set is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Multiway_Trees with
SPARK_Mode => Off
Process (Position.Node.Element.all);
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree)
+ is
+ use System.Put_Images;
+
+ procedure Rec (Position : Cursor);
+ -- Recursive routine operating on cursors
+
+ procedure Rec (Position : Cursor) is
+ First_Time : Boolean := True;
+ begin
+ Array_Before (S);
+
+ for X in Iterate_Children (V, Position) loop
+ if First_Time then
+ First_Time := False;
+ else
+ Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, Element (X));
+ if Child_Count (X) > 0 then
+ Simple_Array_Between (S);
+ Rec (X);
+ end if;
+ end loop;
+
+ Array_After (S);
+ end Rec;
+
+ begin
+ if First_Child (Root (V)) = No_Element then
+ Array_Before (S);
+ Array_After (S);
+ else
+ Rec (First_Child (Root (V)));
+ end if;
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type (<>) is private;
Root : aliased Tree_Node_Type;
TC : aliased Tamper_Counts;
Count : Count_Type := 0;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree);
overriding procedure Adjust (Container : in out Tree);
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Ordered_Maps with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+
+ procedure Put_Key_Value (Position : Cursor);
+ procedure Put_Key_Value (Position : Cursor) is
+ begin
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Key_Type'Put_Image (S, Key (Position));
+ Put_Arrow (S);
+ Element_Type'Put_Image (S, Element (Position));
+ end Put_Key_Value;
+
+ begin
+ Array_Before (S);
+ Iterate (V, Put_Key_Value'Access);
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Key_Type (<>) is private;
type Map is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Ordered_Multisets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
with Ada.Iterator_Interfaces;
generic
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Ordered_Sets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type (<>) is private;
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
------------------------------------------------------------------------------
with Unchecked_Conversion;
+with System.Put_Images;
package body Ada.Containers.Bounded_Holders is
return Get (Left) = Get (Right);
end "=";
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder)
+ is
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+ Element_Type'Put_Image (S, Get (V));
+ Array_After (S);
+ end Put_Image;
+
---------
-- Get --
---------
------------------------------------------------------------------------------
private with System;
+private with Ada.Strings.Text_Output;
generic
type Element_Type (<>) is private;
type Holder is record
Data : Storage_Array (1 .. Max_Size_In_Storage_Elements);
end record
- with Alignment => Standard'Maximum_Alignment;
+ with Alignment => Standard'Maximum_Alignment, Put_Image => Put_Image;
-- We would like to say "Alignment => Element_Type'Alignment", but that
-- is illegal because it's not static, so we use the maximum possible
-- (default) alignment instead.
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder);
+
type Element_Access is access all Element_Type;
pragma Assert (Element_Access'Size = Standard'Address_Size,
"cannot instantiate with an array type");
with Ada.Containers.Generic_Array_Sort;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Bounded_Vectors is
Query_Element (Position.Container.all, Position.Index, Process);
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
+private with Ada.Strings.Text_Output;
generic
type Index_Type is range <>;
Elements : Elements_Array (1 .. Capacity) := (others => <>);
Last : Extended_Index := No_Index;
TC : aliased Tamper_Counts;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector);
procedure Write
(Stream : not null access Root_Stream_Type'Class;
with Ada.Containers.Helpers; use Ada.Containers.Helpers;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Hashed_Maps with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+
+ procedure Put_Key_Value (Position : Cursor);
+ procedure Put_Key_Value (Position : Cursor) is
+ begin
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Key_Type'Put_Image (S, Key (Position));
+ Put_Arrow (S);
+ Element_Type'Put_Image (S, Element (Position));
+ end Put_Key_Value;
+
+ begin
+ Array_Before (S);
+ Iterate (V, Put_Key_Value'Access);
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Hash_Tables;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
-- The language-defined generic package Containers.Hashed_Maps provides
-- private types Map and Cursor, and a set of operations for each type. A map
type Map is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
with Ada.Containers.Prime_Numbers;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Hashed_Sets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
type Set is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Holders is
B := B - 1;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder)
+ is
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+ if not Is_Empty (V) then
+ Element_Type'Put_Image (S, Element (V));
+ end if;
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type (<>) is private;
type Holder is new Ada.Finalization.Controlled with record
Element : Element_Access;
Busy : Natural := 0;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder);
+
for Holder'Read use Read;
for Holder'Write use Write;
-- internal shared object and element).
with Ada.Unchecked_Deallocation;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Holders is
B := B - 1;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder)
+ is
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+ if not Is_Empty (V) then
+ Element_Type'Put_Image (S, Element (V));
+ end if;
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Streams;
private with System.Atomic_Counters;
+private with Ada.Strings.Text_Output;
generic
type Element_Type (<>) is private;
type Holder is new Ada.Finalization.Controlled with record
Reference : Shared_Holder_Access;
Busy : Natural := 0;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder);
+
for Holder'Read use Read;
for Holder'Write use Write;
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Indefinite_Vectors with
SPARK_Mode => Off
end if;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Index_Type is range <>;
Elements : Elements_Access := null;
Last : Extended_Index := No_Index;
TC : aliased Tamper_Counts;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector);
overriding procedure Adjust (Container : in out Vector);
overriding procedure Finalize (Container : in out Vector);
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Multiway_Trees with
SPARK_Mode => Off
Process (Position.Node.Element);
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree)
+ is
+ use System.Put_Images;
+
+ procedure Rec (Position : Cursor);
+ -- Recursive routine operating on cursors
+
+ procedure Rec (Position : Cursor) is
+ First_Time : Boolean := True;
+ begin
+ Array_Before (S);
+
+ for X in Iterate_Children (V, Position) loop
+ if First_Time then
+ First_Time := False;
+ else
+ Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, Element (X));
+ if Child_Count (X) > 0 then
+ Simple_Array_Between (S);
+ Rec (X);
+ end if;
+ end loop;
+
+ Array_After (S);
+ end Rec;
+
+ begin
+ if First_Child (Root (V)) = No_Element then
+ Array_Before (S);
+ Array_After (S);
+ else
+ Rec (First_Child (Root (V)));
+ end if;
+ end Put_Image;
+
----------
-- Read --
----------
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
Root : aliased Root_Node_Type;
TC : aliased Tamper_Counts;
Count : Count_Type := 0;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree);
overriding procedure Adjust (Container : in out Tree);
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Ordered_Maps with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+
+ procedure Put_Key_Value (Position : Cursor);
+ procedure Put_Key_Value (Position : Cursor) is
+ begin
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Key_Type'Put_Image (S, Key (Position));
+ Put_Arrow (S);
+ Element_Type'Put_Image (S, Element (Position));
+ end Put_Key_Value;
+
+ begin
+ Array_Before (S);
+ Iterate (V, Put_Key_Value'Access);
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Key_Type is private;
type Map is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Ordered_Multisets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
with Ada.Iterator_Interfaces;
generic
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
with System; use type System.Address;
+with System.Put_Images;
package body Ada.Containers.Ordered_Sets with
SPARK_Mode => Off
end;
end Query_Element;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ is
+ First_Time : Boolean := True;
+ use System.Put_Images;
+ begin
+ Array_Before (S);
+
+ for X of V loop
+ if First_Time then
+ First_Time := False;
+ else
+ Simple_Array_Between (S);
+ end if;
+
+ Element_Type'Put_Image (S, X);
+ end loop;
+
+ Array_After (S);
+ end Put_Image;
+
----------
-- Read --
----------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
+private with Ada.Strings.Text_Output;
generic
type Element_Type is private;
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
package body Ada.Strings.Text_Output.Buffers is
+ type Chunk_Access is access all Chunk;
+
function New_Buffer
(Indent_Amount : Natural := Default_Indent_Amount;
Chunk_Length : Positive := Default_Chunk_Length) return Buffer
end return;
end New_Buffer;
+ -- We need type conversions of Chunk_Access values in the following two
+ -- procedures, because the one in Text_Output has Storage_Size => 0,
+ -- because Text_Output is Pure. We do not run afoul of 13.11.2(16/3),
+ -- which requires the allocation and deallocation to have the same pool,
+ -- because the allocation in Full_Method and the deallocation in Destroy
+ -- use the same access type, and therefore the same pool.
+
procedure Destroy (S : in out Buffer) is
procedure Free is new Unchecked_Deallocation (Chunk, Chunk_Access);
- Cur : Chunk_Access := S.Initial_Chunk.Next;
+ Cur : Chunk_Access := Chunk_Access (S.Initial_Chunk.Next);
begin
while Cur /= null loop
declare
- Temp : constant Chunk_Access := Cur.Next;
+ Temp : constant Chunk_Access := Chunk_Access (Cur.Next);
begin
Free (Cur);
Cur := Temp;
begin
pragma Assert (S.Cur_Chunk.Next = null);
pragma Assert (S.Last = S.Cur_Chunk.Chars'Length);
- S.Cur_Chunk.Next := new Chunk (S.Chunk_Length);
+ S.Cur_Chunk.Next :=
+ Text_Output.Chunk_Access (Chunk_Access'(new Chunk (S.Chunk_Length)));
S.Cur_Chunk := S.Cur_Chunk.Next;
S.Num_Extra_Chunks := @ + 1;
S.Last := 0;
S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item;
S.Last := S.Last + Item'Length;
+ S.Column := S.Column + Item'Length;
Full (S);
-- ???Seems like maybe we shouldn't call Full until we have MORE
-- characters. But then we can't pass Chunk_Length => 1 to
S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item;
S.Last := S.Last + Item'Length;
+ S.Column := S.Column + Item'Length;
else
Put_UTF_8_Outline (S, Item);
end if;
Put_UTF_8 (S, Item (Line_Start .. Index - 1));
end if;
New_Line (S);
- S.Column := 1;
Line_Start := Index + 1;
end if;
-- --
------------------------------------------------------------------------------
-package Ada.Strings.Text_Output.Utils with Preelaborate is
+package Ada.Strings.Text_Output.Utils with Pure is
-- This package provides utility functions on Sink'Class. These are
-- intended for use by Put_Image attributes, both the default versions
-- Send data that is already UTF-8 encoded (including 7-bit ASCII) to
-- S. These are more efficient than Put_String.
- procedure New_Line (S : in out Sink'Class) with Inline;
+ procedure New_Line (S : in out Sink'Class) with
+ Inline, Post => Column (S) = 1;
-- Puts the new-line character.
function Column (S : Sink'Class) return Positive with Inline;
end if;
end Overwrite;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String) is
+ begin
+ String'Put_Image (S, To_String (V));
+ end Put_Image;
+
-----------------------
-- Realloc_For_Chunk --
-----------------------
with Ada.Strings.Maps;
with Ada.Finalization;
+private with Ada.Strings.Text_Output;
-- The language-defined package Strings.Unbounded provides a private type
-- Unbounded_String and a set of operations. An object of type
type Unbounded_String is new AF.Controlled with record
Reference : String_Access := Null_String'Access;
Last : Natural := 0;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String);
+
-- The Unbounded_String is using a buffered implementation to increase
-- speed of the Append/Delete/Insert procedures. The Reference string
-- pointer above contains the current string value and extra room at the
end if;
end Overwrite;
+ ---------------
+ -- Put_Image --
+ ---------------
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String) is
+ begin
+ String'Put_Image (S, To_String (V));
+ end Put_Image;
+
---------------
-- Reference --
---------------
with Ada.Strings.Maps;
private with Ada.Finalization;
private with System.Atomic_Counters;
+private with Ada.Strings.Text_Output;
package Ada.Strings.Unbounded with
Initial_Condition => Length (Null_Unbounded_String) = 0
type Unbounded_String is new AF.Controlled with record
Reference : not null Shared_String_Access := Empty_Shared_String'Access;
- end record;
+ end record with Put_Image => Put_Image;
+
+ procedure Put_Image
+ (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String);
pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String);
-- Provide stream routines without dragging in Ada.Streams
with Ada.Strings.UTF_Encoding;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
-package Ada.Strings.Text_Output with Preelaborate is
+package Ada.Strings.Text_Output with Pure is
-- This package provides a "Sink" abstraction, to which characters of type
-- Character, Wide_Character, and Wide_Wide_Character can be sent. This
-- extended. It is designed with particular extensions in mind, and these
-- extensions are declared in child packages of this package, because they
-- depend on implementation details in the private part of this
- -- package. The primary extensions of Sink are:
+ -- package.
+ --
+ -- Users are not expected to extend type Sink.
+ --
+ -- The primary extensions of Sink are:
--
-- Buffer. The characters sent to a Buffer are stored in memory, and can
-- be retrieved via Get functions. This is intended for the
-- slows things down, but increasing it doesn't gain much.
private
- type String_Access is access all String;
-
-- For Buffer, the "internal buffer" mentioned above is implemented as a
-- linked list of chunks. When the current chunk is full, we allocate a new
-- one. For File, there is only one chunk. When it is full, we send the
-- data to the file, and empty it.
type Chunk;
- type Chunk_Access is access all Chunk;
+ type Chunk_Access is access all Chunk with Storage_Size => 0;
type Chunk (Length : Positive) is limited record
Next : Chunk_Access := null;
Chars : UTF_8_Lines (1 .. Length);
Put_7bit (S, ')');
end Record_After;
+ procedure Put_Arrow (S : in out Sink'Class) is
+ begin
+ Put_UTF_8 (S, " => ");
+ end Put_Arrow;
+
procedure Put_Image_Unknown (S : in out Sink'Class; Type_Name : String) is
begin
Put_UTF_8 (S, "{");
with Ada.Strings.Text_Output;
with System.Unsigned_Types;
-package System.Put_Images is
+package System.Put_Images with Pure is
-- This package contains subprograms that are called by the generated code
-- for the 'Put_Image attribute.
type Byte is new Character with Alignment => 1;
type Byte_String is array (Positive range <>) of Byte with Alignment => 1;
- type Thin_Pointer is access all Byte;
- type Fat_Pointer is access all Byte_String;
+ type Thin_Pointer is access all Byte with Storage_Size => 0;
+ type Fat_Pointer is access all Byte_String with Storage_Size => 0;
procedure Put_Image_Thin_Pointer (S : in out Sink'Class; X : Thin_Pointer);
procedure Put_Image_Fat_Pointer (S : in out Sink'Class; X : Fat_Pointer);
-- Print "null", or the address of the designated object as an unsigned
procedure Record_Between (S : in out Sink'Class);
procedure Record_After (S : in out Sink'Class);
+ procedure Put_Arrow (S : in out Sink'Class);
+
procedure Put_Image_Unknown (S : in out Sink'Class; Type_Name : String);
-- For Put_Image of types that don't have the attribute, such as type
-- Sink.
projects / gcc.git / commitdiff