This is the mail archive of the guile@sourceware.cygnus.com mailing list for the Guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: metaclass <singleton>


Klaus Schilling <Klaus.Schilling@munich.netsurf.de> writes:

> Is it possible to create a singleton metaclass using the MOP
> of goops?
> At most one instance is allowed to exist simultaneously, but
> how may one detect whether previously created instances have
> been garbage collected or at least dropped all strong references
> already?

It is possible.  See below.

I've implemented it according to your spec, but I doubt that it is a
good thing to depend on the object being GC:d.  I think it's better to
create the object once and for all and not to allow any further
objects of that class regardless if the object has been GC:d or not.
GC isn't supposed to be involved in the semantics of programs.  If you
want to redefine it you can create the class anew as well.

(use-modules (oop goops))

(define singleton-guardian (make-guardian))

(define-class <singleton-class> (<class>)
  (instance? #:accessor instance? #:init-value #f))

(define-class <singleton> ()
  #:metaclass <singleton-class>)

(define-method initialize ((obj <singleton>) initargs)
  (next-method)
  (gc)
  (do ((singleton (singleton-guardian) (singleton-guardian)))
      ((not singleton))
    (if singleton
	(set! (instance? (class-of singleton)) #f)))
  (if (instance? (class-of obj))
      (error "Can't make more than one singleton"))
  (set! (instance? (class-of obj)) #t)
  (singleton-guardian obj))

(define-class c (<singleton>)
  (x #:init-value 1))

(define o (make c))
;; (define o (make c)) ==> error

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]