transcendental-lisp/lisp/fruit-counter.lisp

(load "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
            'apples   (funcall apple-counter :get)
            'bananas  (funcall banana-counter :get)
            'coconuts (funcall coconut-counter :get)
          )
        )

      )
    )

  )
)

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

; Another way
; 
; usage: 
;   ~ (funcall my-counter2 :set-apples 23)
;   23
;
(setf my-counter2 (fruit-counter 10000))