with Ada.Finalization, Ada.Unchecked_Deallocation;

generic

  type Object is private;

package Safe_Pointers.On_Definite_Types is

  type Safe_Pointer is private;

  type Accessor (Value: not null access Object) is limited private;

  function Null_Pointer return Safe_Pointer;

  function "=" (Left, Right: Safe_Pointer) return Boolean;

  procedure Allocate   (Pointer: in out Safe_Pointer);
  procedure Allocate   (Pointer: in out Safe_Pointer; Value : in     Object);
  procedure Deallocate (Pointer: in out Safe_Pointer);
--procedure Alias      (Pointer: in out Safe_Pointer; Value : access Object);
  procedure Assign     (Pointer: in     Safe_Pointer; Value : in     Object);
  function  Value      (Pointer:        Safe_Pointer)         return Object;
  function  Reference  (Pointer:        Safe_Pointer)         return Accessor;

  -- These are equivalent operations (A: an access object, P: a safe pointer,
  -- Free an appropriate instantiation of Unchecked_Conversion):
  --
  -- A := new T;                         Allocate (P);
  -- A := new T'(X);                     Allocate (P, X);
  -- Free (A);                           Deallocate (P);
  -- A.all := X;                         Assign (P, X);
  -- X     := A.all;                     X := Value (P);
  -- A.C   := X.C;                       Reference (P).Value.C := X.C

private

  type Object_Pointer is access Object;
  procedure Free is new Ada.Unchecked_Deallocation (Object, Object_Pointer);

  type Track is record
    Object: Object_Pointer;
    Count : Natural := 0;
  end record;

  type Tracker is access Track;
  procedure Free is new Ada.Unchecked_Deallocation (Track, Tracker);

  Null_Track: constant Tracker := new Track;

  type Safe_Pointer is new Ada.Finalization.Controlled with record
    Track: Tracker := Null_Track;
  end record;

  procedure Adjust    (Pointer: in out Safe_Pointer);
  procedure Finalize  (Pointer: in out Safe_Pointer);

  type Accessor (Value: not null access Object) is ...;

end Safe_Pointers.On_Definite_Types;

Back to text.