with Ada.Streams; use Ada.Streams;
package Objects is
-- This is the superclass for all objects. The class provides copying,
-- deletion, streaming and stringification procedures. All class should
-- extend either the Object class or the Limited_Object class.
type Object is abstract tagged private;
type A_Object is access all Object'Class;
pragma No_Strict_Aliasing( A_Object );
-- Adjusts the object's fields as part of a Copy. If this class or an
-- ancestor class doesn't support copying then COPY_NOT_ALLOWED will be
-- raised. A subclass should call its superclass' Adjust before doing any
-- work. When an object is copied, Adjust will be called on the new object
-- after the memory copy and Construct will not be called on it.
procedure Adjust( this : access Object );
-- Constructs the object. A subclass should call its superclass' Construct
-- before doing any work.
procedure Construct( this : access Object );
-- Deletes the object's fields as part of object destruction. A subclass
-- should call its superclass' Delete before doing any work.
procedure Delete( this : in out Object );
-- Returns the name of the instance's class in lower case characters. This
-- is defined to be the class' external tag which is not guaranteed to be
-- unique across the entire application. If 'full' is True, the fully
-- qualified class name which includes a package prefix will be returned.
function Get_Class_Name( this : not null access Object'Class;
full : Boolean := False ) return String;
pragma Postcondition( Get_Class_Name'Result'Length > 0 );
-- Returns a string representation of the object.
function To_String( this : access Object ) return String;
-- Reads the object's representation from a stream. This should be
-- overridden to provide streaming support for a subclass.
procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Object );
-- Writes the object's representation to a stream. This should be overridden
-- to provide streaming support for a subclass.
procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Object );
-- Returns a copy of 'src'. Not all object classes can be copied. If 'src'
-- is not allowed to be copied then COPY_NOT_ALLOWED will be raised.
function Copy( src : A_Object ) return A_Object;
pragma Postcondition( Copy'Result /= src or else src = null );
-- Deletes the object.
procedure Delete( this : in out A_Object );
pragma Postcondition( this = null );
-- Concatenates the string representation of the object, as returned by the
-- To_String function.
function "&"( left : A_Object; right : String ) return String;
-- Concatenates the string representation of the object, as returned by the
-- To_String function.
function "&"( left : String; right : A_Object ) return String;
-- Raised when attempting to copy an instance of a class that doesn't
-- allow copying. This occurs if a class doesn't support copying but needs
-- to be streamed. If a subclass does not allow copying and it is never
-- streamed then it should extend the Limited_Object class instead.
COPY_NOT_ALLOWED : exception;
----------------------------------------------------------------------------
-- This is the superclass for all objects that can't be copied or streamed.
-- It behaves the same as the Object class except for the restrictions
-- imposed by its status as a limited type.
type Limited_Object is abstract tagged limited private;
type A_Limited_Object is access all Limited_Object'Class;
pragma No_Strict_Aliasing( A_Limited_Object );
-- Constructs the object. A subclass should call its superclass' Construct
-- before doing any work.
procedure Construct( this : access Limited_Object );
-- Deletes the object's fields as part of object destruction. A subclass
-- should call its superclass' Delete before doing any work.
procedure Delete( this : in out Limited_Object );
-- Returns the name of the instance's class in lower case characters. This
-- is defined to be the class' external tag which is not guaranteed to be
-- unique across the entire application. If 'full' is True, the fully
-- qualified class name which includes a package prefix will be returned.
function Get_Class_Name( this : not null access Limited_Object'Class;
full : Boolean := False ) return String;
pragma Postcondition( Get_Class_Name'Result'Length > 0 );
-- Returns a string representation of the object.
function To_String( this : access Limited_Object ) return String;
-- Deletes the object.
procedure Delete( this : in out A_Limited_Object );
pragma Postcondition( this = null );
-- Concatenates the string representation of the object, as returned by the
-- To_String function.
function "&"( left : A_Limited_Object; right : String ) return String;
-- Concatenates the string representation of the object, as returned by the
-- To_String function.
function "&"( left : String; right : A_Limited_Object ) return String;
----------------------------------------------------------------------------
procedure Finalize;
private
type Object is abstract tagged null record;
for Object'Read use Object_Read;
for Object'Write use Object_Write;
----------------------------------------------------------------------------
type Limited_Object is abstract tagged limited null record;
end Objects;