34 lines
814 B
Plaintext
34 lines
814 B
Plaintext
;; Custom (:singleton) clause which adds behavior to a class
|
|
;; asserting against multiple instantiation.
|
|
(define-struct-clause :singleton ()
|
|
^((:static inst-count 0)
|
|
(:postinit (me)
|
|
(assert (<= (inc me.inst-count) 1)))))
|
|
|
|
(defstruct singleton-one ()
|
|
(:singleton)
|
|
(:method speak (me)
|
|
(put-line "I am singleton-one")))
|
|
|
|
(defstruct singleton-two ()
|
|
(:singleton)
|
|
(:method speak (me)
|
|
(put-line "I am singleton-two")))
|
|
|
|
;; Test
|
|
|
|
;; Global singleton
|
|
(defvarl s1 (new singleton-one))
|
|
|
|
;; Local singleton in function (like static in C)
|
|
;; load-time evaluates once.
|
|
(defun fn ()
|
|
(let ((s2 (load-time (new singleton-two))))
|
|
s2.(speak)))
|
|
|
|
s1.(speak)
|
|
(fn) ;; multiple calls to fn don't re-instantiate singleton-two
|
|
(fn)
|
|
(put-line "so far, so good")
|
|
(new singleton-two) ;; assertion gooes off
|