The Ada 2012 standard introduced user-defined references. The main idea behind this is simplifying the access to elements in a container. But you can use them to control the life-circle of your persistent objects. Let's see how it could work.

For example you have some object representing a user:

package Users is type User_Identifier is range 0 .. 2 ** 31 - 1; end Users; package Users.Objects is type User_Object is tagged limited private; function Get_Login (Self : User_Object'Class) return League.Strings.Universal_String; private type User_Object is tagged limited record Identifier : User_Identifier; Login : League.Strings.Universal_String; end record; end Users.Objects;

You want to be able to store/retrieve a user object to/from a database. To do this you have the following package:

with SQL.Databases; package Users.Objects.Stores is type User_Access is access all User_Object'Class; type User_Store is tagged limited private; procedure Initialize (Self : in out User_Store'Class; Database : not null access SQL.Databases.SQL_Database'Class); not overriding function Get (Self : in out User_Store; Identifier : User_Identifier) return User_Access; not overriding procedure Release (Self : in out User_Store; Object : User_Access); private type User_Store is tagged limited record Database : access SQL.Databases.SQL_Database; end record; end Users.Objects.Stores;

The subprogram Get loads an object into memory, and Release should be called when the application doesn't need it any more. Such approach works, but it's cumbersome because you should manually release objects. Having circular dependencies between objects makes this even harder. Eventually this could result in that a lot of (not actually used) objects would be loaded into memory and stay there forever. We could leverage user defined references here to simplify this task. We need two types a reference to the object - User_Reference and transient user-defined reference - Variable_Reference_Type

package Users.References is type User_Reference is tagged private; procedure Initialize (Self : in out User_Reference'Class; Store : not null access Users.Objects.Stores.User_Store'Class; Identifier : Users.User_Identifier); type Variable_Reference_Type (Object : not null access Users.Objects.User_Object'Class) is limited private with Implicit_Dereference => Object; function Object (Self : in out User_Reference'Class) return Variable_Reference_Type; private type User_Reference is tagged record Store : not null access Users.Objects.Stores.User_Store'Class; Identifier : Users.User_Identifier; end record; type Variable_Reference_Type (Object : not null access Users.Objects.User_Object'Class) is new Ada.Finalization.Limited_Controlled with record Store : not null access Users.Objects.Stores.User_Store'Class; end record; procedure Finalize (Self : in out Variable_Reference_Type); end Users.References;

As you can see, User_Reference doesn't contain a pointer to the user object. To reach the object it provides the method Object. Let's see an implementation of this package:

package body Users.References is procedure Finalize (Self : in out Variable_Reference_Type) is begin Self.Store.Release (Self.Object); end Finalize; procedure Initialize (Self : in out User_Reference'Class; Store : not null access Users.Objects.Stores.User_Store'Class; Identifier : Users.User_Identifier) is begin Self.Store := Store; Self.Identifier := Identifier; end Initialize; function Object (Self : in out User_Reference'Class) return Variable_Reference_Type is begin return (Ada.Finalization.Limited_Controlled with Object => Self.Store.Get (Self.Identifier), Store => Self.Store); end Object; end Users.References;

A client using this package could look like:

with SQL.Databases; with SQL.Options; with Users.References; with Users.Objects.Stores; procedure Demo is Options : SQL.Options.SQL_Options; Database : aliased SQL.Databases.SQL_Database := SQL.Databases.Create (League.Strings.To_Universal_String ("SQLITE3"), Options); Store : aliased Users.Objects.Stores.User_Store; User : Users.References.User_Reference; begin Database.Open; Store.Initialize (Database'Unchecked_Access); User.Initialize (Store'Unchecked_Access, 0); Ada.Wide_Wide_Text_IO.Put_Line (User.Object.Get_Login.To_Wide_Wide_String); end Demo;