transcendental-lisp/lisp/object/fruit-counter.lisp

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

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

    (eval
      (dlambda

        (:inc ()
          (setf count (+ count 1)))

        (:dec ()
          (setf count (- count 1)))

        (:get ()
          count)

        (:set (value)
          (setf 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 ()
          (funcall apple-counter :inc))


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


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


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


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


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


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


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


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


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


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


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


        (t (&rest arguments)
          (list
            (list 'apples   (funcall apple-counter :get))
            (list 'bananas  (funcall banana-counter :get))
            (list 'coconuts (funcall 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:
;   ~ (funcall my-fruits2 :set-apples 23)
;   23
;
(setf my-fruits2 (fruit-counter 10000))