Source code in the txr programming language

;; 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