Singleton: Difference between revisions

=={{header|TXR}}==

<syntaxhighlight lang="txrlisp">;; 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 singelton-two

(fn)

(put-line "so far, so good")

(new singleton-two) ;; assertion gooes off</syntaxhighlight>

{{out}}

<pre>I am singleton-one

I am singleton-two

I am singleton-two

so far, so good

txr: unhandled exception of type assert:

txr: assertion (<= (inc me.inst-count)

1) failed in singleton.tl:6

txr: during evaluation at singleton.tl:6 of form (sys:rt-assert-fail "singleton.tl"

6 '(<= (inc me.inst-count)

1))</pre>