From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Thread: 103376,54aae3da1cf935cd
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news1.google.com!news2.google.com!fu-berlin.de!uni-berlin.de!not-for-mail
From: "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de>
Newsgroups: comp.lang.ada
Subject: Re: Ada Singleton Pattern
Date: Tue, 14 Sep 2004 10:17:03 +0200
Message-ID: <1826velwc7x9x$.6mjo8v6zq4c4$.dlg@40tude.net>
References: <%Fi1d.245967$OR2.11136154@news3.tin.it>
 <14p6ezf3vze8j$.j05arkr066wi.dlg@40tude.net>
 <hnk1d.246585$OR2.11156430@news3.tin.it>
Mime-Version: 1.0
Content-Type: text/plain; charset="us-ascii"
Content-Transfer-Encoding: 7bit
X-Trace: news.uni-berlin.de Prl6DAODwrLEuvcdhducVQGa2Jxkm3sVyAOHoshgGMO6fWPq4=
User-Agent: 40tude_Dialog/2.0.12.1
Xref: g2news1.google.com comp.lang.ada:3707
Date: 2004-09-14T10:17:03+02:00
List-Id: <comp.lang.ada>

On Mon, 13 Sep 2004 17:01:01 GMT, Luca Stasio wrote:

> Dmitry A. Kazakov ha scritto:
>> On Mon, 13 Sep 2004 15:04:27 GMT, Luca Stasio wrote:
>> 
>>>Hi, there is a way to implement the Singleton Pattern in Ada?
>>>There are some examples out there?
>>>Thanx.
>> 
>> package Foo is
>>    type Singleton (<>) is limited private;
>>    ... -- Public interface subroutines
>> 
>>    The_Only_One : constant Singleton; -- The value
>> private
>>    type Singleton is new Integer; -- Any implementation you want
>>    The_Only_One : constant Singleton := 5;
>> 
>> The public view of Singleton is unconstrained and limited, which prevents
>> it from either being copied or declaring new objects of this type.
>> 
> Thanx for your answer.
> Know, sorry... but, there is a way to create a Singleton Class from wich 
> derive and create concrete singleton classes?

"(<>) is limited" is a kind of such class built in the language. It can be
specified as a generic formal parameter for example. So formally you do not
need to create it, it is already here. However, if you want singleton types
to share something common, apart from being just singletons, then you can
create an abstract type:

with Ada.Finalization;
package Singletons is
   type Singleton (<>) is abstract tagged limited private;
   -- This is an extensible type. Interface follows, it should
   -- have only in-methods, because Singleton is viewed as
   -- a constant. Looks nasty, but technically it is no problem,
   -- because the implementation may use a function returning
   -- the object so that the methods could access the object
   -- directly.
   function Get_Name (X : Singleton) return String is abstract;
   ...
private
   type Singleton is abstract
      new Ada.Finalization.Limited_Controlled with null record;
end Singletons;

Note that the base Limited_Controlled is hidden. It means that only the
packages having a private view on Singleton can in effect extend it. Though
others will be able to declare an extension type, they will fail to create
any concrete object of that type.
  
>   I mean: (1) a Singleton class (2) a DatbaseAccessSingleton or a 
> NetworkAccessSingleton or... heach one with its own methods but sharing 
> the Singleton behaviour.

package Singletons.DB is
   type DB_Singleton is new Singleton with private;
   -- Implementation of the interface, overriding all abstracts:
   function Get_Name (X : DB_Singleton) return String;
   ...
   -- The singleton object itself. Alas, it cannot be declared as a
   -- variable, because the object is unconstrained in its public
   -- view, but you can declare it as either a constant or a function.
   -- For clients it will make no difference:
   DB : constant DB_Singleton;
   -- Or else   
   function DB return DB_Singleton;
private
   DB : constant DB_Singleton; -- If declared as a constant

   type DB_Singleton is new Singleton with
   record
      ...
   end record;
   procedure Finalize (X : in out DB_Singleton);
   procedure Initialize (X : in out DB_Singleton);
end Singletons.DB;

When DB is a function then in the body:

package Singletons.DB is
   procedure Finalize (X : in out DB_Singleton) is
   begin
      ...
   end Finalize;
   procedure Initialize (X : in out DB_Singleton) is
   begin
      ...
   end Initialize;

   My_DB : DB_Singleton;

   function DB return DB_Singleton is
   begin
      return My_DB;
      -- Non-local limited objects can be returned
      -- by reference
   end DB;
   ...

As for singletons in the sense of objects exclusively used by a scheduled
item, see what other posters already wrote. You can use a mutex protected
object or a task implementing a monitor and mix in to the singleton object
trough an access discriminant.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de