transcendental-lisp/lisp/object/composition.lisp

89 lines
1.8 KiB
Common 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))