From: Lieven Marchand
Subject: Singleton pattern in CLOS
Date: 
Message-ID: <6n2ut6$ep1$1@xenon.inbe.net>
I'm trying to implement a class that will only have one instance, what
they call a singleton in pattern languages.

After reading the Hyperspec on creating/initializing object it would
seem that specializing MAKE-INSTANCE would be enough to accomplish
this. However it doesn't work.

USER(1): (defclass singleton () (x))
#<STANDARD-CLASS SINGLETON>
USER(2): (defvar *unique* (let ((u (allocate-instance (find-class 'singleton))))
			    (setf (slot-value u 'x) 'single)
			    u))
*UNIQUE*
USER(3): *unique*
#<SINGLETON @ #x836a76a>
USER(4): (slot-value *unique* 'x)
SINGLE
USER(5): (defmethod make-instance ((s singleton) &rest rest)
	   (declare (ignore rest))
	   *unique*)
#<STANDARD-METHOD MAKE-INSTANCE (SINGLETON)>
USER(6): (make-instance (find-class 'singleton))
#<SINGLETON @ #x836b702>
USER(7): (make-instance (find-class 'singleton))
#<SINGLETON @ #x836bada>
USER(8): (make-instance (find-class 'singleton))
#<SINGLETON @ #x836be82>
USER(9): (slot-value * 'x)
Error: The slot X is unbound in the object #<SINGLETON @ #x836be82> of class
       #<STANDARD-CLASS SINGLETON>.
  [condition type: UNBOUND-SLOT]


What am I doing wrong?

-- 
Lieven Marchand <···@bewoner.dma.be> 
------------------------------------------------------------------------------
Few people have a talent for constructive laziness. -- Lazarus Long

From: Matthias Hoelzl (tc)
Subject: Re: Singleton pattern in CLOS
Date: 
Message-ID: <871zsaz5ew.fsf@gauss.muc.de>
Lieven Marchand <···@bewoner.dma.be> writes:

> I'm trying to implement a class that will only have one instance, what
> they call a singleton in pattern languages.
> 
> After reading the Hyperspec on creating/initializing object it would
> seem that specializing MAKE-INSTANCE would be enough to accomplish
> this. However it doesn't work.

Here is one way to do it (in CLisp, the details vary from
implementation to implementation):

> (defclass singleton-class (standard-class)
  ((unique-instance :accessor unique-instance :initform nil))
  (:documentation
   "If class C has SINGLETON-CLASS as metaclass all calls to
(MAKE-INSTANCE 'C) return the same object.")
  (:metaclass structure-class))
#<STRUCTURE-CLASS SINGLETON-CLASS>
> (defmethod make-instance ((class singleton-class) &rest initargs)
  (when (null (unique-instance class))
    (setf (unique-instance class) (call-next-method)))
  (unique-instance class))
#<STANDARD-METHOD (#<STRUCTURE-CLASS SINGLETON-CLASS>)>
> (defclass singleton ()
    ((my-slot :accessor my-slot :initform nil :initarg :my-slot))
    (:metaclass singleton-class))
#<SINGLETON-CLASS SINGLETON>
> (make-instance 'singleton)
#<SINGLETON #x00000014>
> (make-instance 'singleton)
#<SINGLETON #x00000014>
> (make-instance 'singleton :my-slot 123)
#<SINGLETON #x00000014>
> (my-slot (make-instance 'singleton))
NIL
> (setf (my-slot (make-instance 'singleton)) 123)
123
> (my-slot (make-instance 'singleton))
123
> (defclass singleton-2 ()
    ((my-slot :accessor my-slot :initform nil :initarg :my-slot))
    (:metaclass singleton-class))
#<SINGLETON-CLASS SINGLETON-2>
> (make-instance 'singleton-2 :my-slot 1234)
#<SINGLETON-2 #x0000004C>
> (my-slot (make-instance 'singleton-2))
1234

You need to be clear about the semantics you want to have for the
initarg, if you want to set the slot value when calling MAKE-INSTANCE
for an already existing singleton you need to change the definitions
accordingly.

  Matthias
From: Lyman S. Taylor
Subject: Re: Singleton pattern in CLOS
Date: 
Message-ID: <6n4gp0$ptj@pravda.cc.gatech.edu>
In article <············@xenon.inbe.net>,
Lieven Marchand  <···@bewoner.dma.be> wrote:
>
>I'm trying to implement a class that will only have one instance, what
>they call a singleton in pattern languages.
......
...
>USER(5): (defmethod make-instance ((s singleton) &rest rest)
>	   (declare (ignore rest))
>	   *unique*)


The above defines a MAKE-INSTANCE method that specialized for instances of the 
singleton class as arguments.  Err... MAKE-INSTANCE takes symbols or
classes (some thing of type STANDARD-CLASS) .... not instances of a 
class. :-)

You want a method that is specialized ONLY on the singleton class itself.

(defmethod make-instance ( (class (eql (find-class 'singleton))) 
                           &rest initargs)
   (declare (ignore initargs))
   *unique*)   

I'd probably also recommend that the singleton class only have a reader
method to get at the object. 

(defclass singleton () 
     (( x  :reader object )) )


So that:

   (object  instance-of-singleton)   

retrieves the object that's being "singletoned".  This has the benefit
that the "name" of instance slot, the symbol X, need not be well known.

The "backdoor" here is that ALLOCATE-INSTANCE still exists....

It would probably be prudent to use another name for the constructor
for singletons just to make clear that a different protocol is
being followed.   Something called  MAKE-SINGLETON for example. 

-- 
Lyman S. Taylor           Comment by a professor observing two students 
(·····@cc.gatech.edu)     unconscious at their keyboards:
				"That's the trouble with graduate students.
				 Every couple of days, they fall asleep."
From: Lieven Marchand
Subject: Re: Singleton pattern in CLOS
Date: 
Message-ID: <6nb6d0$9mi$1@xenon.inbe.net>
·····@cc.gatech.edu (Lyman S. Taylor) writes:

> In article <············@xenon.inbe.net>,
> Lieven Marchand  <···@bewoner.dma.be> wrote:
> >USER(5): (defmethod make-instance ((s singleton) &rest rest)
> >	   (declare (ignore rest))
> >	   *unique*)
> 
> 
> The above defines a MAKE-INSTANCE method that specialized for instances of the 
> singleton class as arguments.  Err... MAKE-INSTANCE takes symbols or
> classes (some thing of type STANDARD-CLASS) .... not instances of a 
> class. :-)
> 

Yes. Obvious once you mentioned it :-) Thanks.

> The "backdoor" here is that ALLOCATE-INSTANCE still exists....

I don't mind that much. If people want to break abstraction barriers
or go behind the back of the library programmer they usually will find
a way. When they do such things all guarantees are off anyway.


-- 
Lieven Marchand <···@bewoner.dma.be> 
------------------------------------------------------------------------------
Few people have a talent for constructive laziness. -- Lazarus Long