Expanded dlambda example some more
This commit is contained in:
parent
d55ebdd22f
commit
4a91d197fd
|
@ -1,8 +1,9 @@
|
||||||
(defun map (fn ls)
|
(defun mapcar (fn ls)
|
||||||
(if (null ls)
|
(if (null ls)
|
||||||
()
|
()
|
||||||
(cons (funcall fn (first ls))
|
(cons
|
||||||
(map fn (rest ls))
|
(funcall fn (first ls))
|
||||||
|
(mapcar fn (rest ls))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
@ -17,7 +18,7 @@
|
||||||
(quote case)
|
(quote case)
|
||||||
(cons
|
(cons
|
||||||
(quote (first arguments))
|
(quote (first arguments))
|
||||||
(map
|
(mapcar
|
||||||
(lambda (method)
|
(lambda (method)
|
||||||
(cons
|
(cons
|
||||||
(first method)
|
(first method)
|
||||||
|
@ -29,7 +30,12 @@
|
||||||
(quote lambda)
|
(quote lambda)
|
||||||
(rest method)
|
(rest method)
|
||||||
)
|
)
|
||||||
(list (quote (rest arguments)))
|
(list
|
||||||
|
(if (equal t (car method))
|
||||||
|
(quote arguments)
|
||||||
|
(quote (rest arguments))
|
||||||
|
)
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
|
@ -1,60 +1,96 @@
|
||||||
(load "dlambda.lisp")
|
(load "dlambda.lisp")
|
||||||
|
|
||||||
(defun fruit-counter (initial-count)
|
(defun counter (initial-count)
|
||||||
|
(let ((count initial-count))
|
||||||
(let ((apple-count initial-count)
|
|
||||||
(banana-count initial-count)
|
|
||||||
(coconut-count initial-count))
|
|
||||||
|
|
||||||
(eval
|
(eval
|
||||||
(dlambda
|
(dlambda
|
||||||
|
|
||||||
(:inc-apple ()
|
(:inc ()
|
||||||
(setf apple-count (+ apple-count 1))
|
(setf count (+ count 1))
|
||||||
)
|
)
|
||||||
|
|
||||||
(:dec-apple ()
|
(:dec ()
|
||||||
(setf apple-count (- apple-count 1))
|
(setf count (- count 1))
|
||||||
)
|
)
|
||||||
|
|
||||||
(:get-apple ()
|
(:get ()
|
||||||
apple-count
|
count
|
||||||
)
|
)
|
||||||
|
|
||||||
(:set-apple (value)
|
(:set (value)
|
||||||
(setf apple-count value)
|
(setf count value)
|
||||||
)
|
)
|
||||||
|
|
||||||
(:inc-banana ()
|
)
|
||||||
(setf banana-count (+ banana-count 1))
|
)
|
||||||
|
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(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-banana ()
|
(:dec-apples ()
|
||||||
(setf banana-count (- banana-count 1))
|
(funcall apple-counter :dec)
|
||||||
)
|
)
|
||||||
|
|
||||||
(:get-banana ()
|
(:get-apples ()
|
||||||
banana-count
|
(funcall apple-counter :get)
|
||||||
)
|
)
|
||||||
|
|
||||||
(:set-banana (value)
|
(:set-apples (value)
|
||||||
(setf banana-count value)
|
(funcall apple-counter :set value)
|
||||||
)
|
)
|
||||||
|
|
||||||
(:inc-coconut ()
|
(:inc-bananas ()
|
||||||
(setf coconut-count (+ coconut-count 1))
|
(funcall banana-counter :inc)
|
||||||
)
|
)
|
||||||
|
|
||||||
(:dec-coconut ()
|
(:dec-bananas ()
|
||||||
(setf coconut-count (- coconut-count 1))
|
(funcall banana-counter :dec)
|
||||||
)
|
)
|
||||||
|
|
||||||
(:get-coconut ()
|
(:get-bananas ()
|
||||||
coconut-count
|
(funcall banana-counter :get)
|
||||||
)
|
)
|
||||||
|
|
||||||
(:set-coconut (value)
|
(:set-bananas (value)
|
||||||
(setf coconut-count 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)
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
@ -66,7 +102,7 @@
|
||||||
; Create an instance
|
; Create an instance
|
||||||
;
|
;
|
||||||
; usage:
|
; usage:
|
||||||
; ~ (my-counter :set-apple 23)
|
; ~ (my-counter :set-apples 23)
|
||||||
; 23
|
; 23
|
||||||
;
|
;
|
||||||
(let ((instance (fruit-counter 0)))
|
(let ((instance (fruit-counter 0)))
|
||||||
|
@ -76,7 +112,7 @@
|
||||||
; Another way
|
; Another way
|
||||||
;
|
;
|
||||||
; usage:
|
; usage:
|
||||||
; ~ (funcall my-counter2 :set-apple 23)
|
; ~ (funcall my-counter2 :set-apples 23)
|
||||||
; 23
|
; 23
|
||||||
;
|
;
|
||||||
(setf my-counter2 (fruit-counter 10000))
|
(setf my-counter2 (fruit-counter 10000))
|
||||||
|
|
Loading…
Reference in New Issue