transcendental-lisp/lisp/object/composition.lisp

(defun counter (initial-count)
  (let ((count initial-count))

    (dlambda
      (:inc ()
        (setq count (+ count 1)))

      (:dec ()
        (setq count (- count 1)))

      (:get ()
        count)

      (:set (value)
        (setq count value)))))


(defun fruit-counter (initial-count)
  (let ((apple-counter (counter initial-count))
        (banana-counter (counter initial-count))
        (coconut-counter (counter initial-count)))

    (dlambda
      (:inc-apples ()
        (call apple-counter :inc))

      (:dec-apples ()
        (call apple-counter :dec))

      (:get-apples ()
        (call apple-counter :get))

      (:set-apples (value)
        (call apple-counter :set value))

      (:inc-bananas ()
        (call banana-counter :inc))

      (:dec-bananas ()
        (call banana-counter :dec))

      (:get-bananas ()
        (call banana-counter :get))

      (:set-bananas (value)
        (call banana-counter :set value))

      (:inc-coconuts ()
        (call coconut-counter :inc))

      (:dec-coconuts ()
        (call coconut-counter :dec))

      (:get-coconuts ()
        (call coconut-counter :get))

      (:set-coconuts (value)
        (call coconut-counter :set value))

      (t (&rest arguments)
        (list
          (list 'apples   (call apple-counter :get))
          (list 'bananas  (call banana-counter :get))
          (list 'coconuts (call coconut-counter :get)))))))


; Create an instance
;
; usage:
;   ~ (my-fruits :set-apples 23)
;   23
;
(let ((instance (fruit-counter 0)))
  (defun my-fruits (&rest args) (apply instance args)))

; Another way
;
; usage:
;   ~ (call my-fruits2 :set-apples 23)
;   23
;
(setq my-fruits2 (fruit-counter 10000))