transcendental-lisp/lisp/object/composition.lisp

(load "../lang/dlambda.lisp")

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

    (eval
      (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)))

    (eval
      (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))