Re: Ada-Singleton-Why does it work like this?

[Ludovic Brenta <ludovic@ludovic-brenta.org>]

Patrick Gunia wrote:
> Hi all,
> I´m currently working on implementing several design patterns in Ada,
> and I found some code concerning the Singleton-pattern when searching
> through the posts of this group. I used this code and it all worked as
> expected. My problem is, that I don´t ave any idea, why it does...here
> is my code:
>
> package Singleton is
>
>         type Singleton_Type (<>) is tagged limited private;
>         type Singleton_Access is access all Singleton_Type;
>
>         function return_Single return Singleton_Access;
>
>         procedure setValues(input : in out Singleton_Access; valueIN :
> Integer; valueIN2 : Integer);
>         procedure print_something(input : Singleton_Access);
>
>         private
>         type Singleton_Type is tagged limited record
>                 value : Integer;
>                 value2 : Integer;
>         end record;
>
> end Singleton;
>
> Here is the implementation part:
>
> package body Singleton is
>         It: aliased Singleton_Type;
>         procedure setValues(input : in out Singleton_Access; valueIN :
> Integer; valueIN2 : Integer) is
>                 begin
>                         input.value := valueIN;
>                         input.value2 := valueIN2;
>
>                 end setValues;
>
>         function return_Single return Singleton_Access is
>                 begin
>                         return It'Access;
>                 end return_Single;
>
>         procedure print_something(input : Singleton_Access) is
>                 begin
>                         put(input.value);
>                         put(input.value2);
>                 end print_something;
>
> end Singleton;
>
> As far as I get it, is the declaration "type Singleton_Type (<>) is
> tagged limited private;" the key-feature to realize the Singleton
> pattern, but how, and why does this work? I looked through my Ada-
> book, searched the web but didn´t find an explanation for this
> construct! Could you please tell me, what exactly happens when I use
> (<>) within a type-declaration and why it is necessary for the
> Singleton-Implementation?

As Pascal replied, the (<>) declares that Singleton_Type is
unconstrained; because, in addition, it is private, it is therefore
impossible to declare objects of this type outside the package
Singleton.  Consider:

with Singleton;
procedure Wrong is
   Second_Singleton : Singleton.Singleton_Type;
   -- error, the type is unconstrained

But your example is much too complicated.  Why is Singleton_Type
tagged?  Why pass parameters to all subprograms when there is only one
object anyway?  A proper singleton looks like this:

package Singleton is
   procedure Set (Value_1, Value_2 : in Integer);
   procedure Print;
private
   Value_1, Value_2 : Integer;
end Singleton;

package body Singleton is
   procedure Set (Value_1, Value_2 : in Integer) is
   begin
      Singleton.Value_1 := Value_1;
      Singleton.Value_2 := Value_2;
   end Set;

   procedure Print is
   begin
      Put (Value_1);
      Put (Value_2);
   end Print;
end Singleton;

A variation of this design pattern is when you want to allocate the
singleton dynamically on first use and never deallocate it.  In this
situation, you do need an access type and value but you do not need to
expose them to clients; in fact the whole allocation business should
be confined to the body of the package:

package body Singleton is

   type Singleton_Type is record
      Value_1, Value_2 : Integer;
   end record;
   type Singleton_Access is access Singleton_Type;
   The_Singleton : Singleton_Access;

   procedure Allocate_If_Null is
   begin
      if The_Singleton = null then
         The_Singleton := new Singleton_Type;
      end if;
   end Allocate_If_Null;

   procedure Set (Value_1, Value_2 : in Integer) is
   begin
      Allocate_If_Null;
      The_Singleton.Value_1 := Value_1;
      The_Singleton.Value_2 := Value_2;
   end Set;

   procedure Print is
      -- raises Constraint_Error if The_Singleton = null, i.e. if Set
never called
   begin
      Put (The_Singleton.Value_1);
      Put (The_Singleton.Value_2);
   end Print;

end Singleton;

HTH

--
Ludovic Brenta.