mike
/
transcendental-lisp
1
1
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Expanded dlambda example some more

This commit is contained in:
Mike Cifelli 2017-03-02 14:26:47 -05:00
parent d55ebdd22f
commit 4a91d197fd
2 changed files with 78 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lisp/dlambda.lisp
View File

@ -1,8 +1,9 @@
(defun map (fn ls)
(defun mapcar (fn ls)
(if (null ls)
()
(cons (funcall fn (first ls))
(map fn (rest ls))
(cons
(funcall fn (first ls))
(mapcar fn (rest ls))
)
)
)
@ -17,7 +18,7 @@
(quote case)
(cons
(quote (first arguments))
(map
(mapcar
(lambda (method)
(cons
(first method)
@ -29,7 +30,12 @@
(quote lambda)
(rest method)
)
(list (quote (rest arguments)))
(list
(if (equal t (car method))
(quote arguments)
(quote (rest arguments))
)
)
)
)
)

98
lisp/fruit-counter.lisp
View File

@ -1,60 +1,96 @@
(load "dlambda.lisp")
(defun fruit-counter (initial-count)
(let ((apple-count initial-count)
(banana-count initial-count)
(coconut-count initial-count))
(defun counter (initial-count)
(let ((count initial-count))
(eval
(dlambda
(:inc-apple ()
(setf apple-count (+ apple-count 1))
(:inc ()
(setf count (+ count 1))
)
(:dec-apple ()
(setf apple-count (- apple-count 1))
(:dec ()
(setf count (- count 1))
)
(:get-apple ()
apple-count
(:get ()
count
)
(:set-apple (value)
(setf apple-count value)
(:set (value)
(setf count value)
)
(:inc-banana ()
(setf banana-count (+ banana-count 1))
)
)
(:dec-banana ()
(setf banana-count (- banana-count 1))
)
)
(:get-banana ()
banana-count
(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)
)
(:set-banana (value)
(setf banana-count value)
(:dec-apples ()
(funcall apple-counter :dec)
)
(:inc-coconut ()
(setf coconut-count (+ coconut-count 1))
(:get-apples ()
(funcall apple-counter :get)
)
(:dec-coconut ()
(setf coconut-count (- coconut-count 1))
(:set-apples (value)
(funcall apple-counter :set value)
)
(:get-coconut ()
coconut-count
(:inc-bananas ()
(funcall banana-counter :inc)
)
(:set-coconut (value)
(setf coconut-count value)
(: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)
)
)
)
@ -66,7 +102,7 @@
; Create an instance
;
; usage:
; ~ (my-counter :set-apple 23)
; ~ (my-counter :set-apples 23)
; 23
;
(let ((instance (fruit-counter 0)))
@ -76,7 +112,7 @@
; Another way
;
; usage:
; ~ (funcall my-counter2 :set-apple 23)
; ~ (funcall my-counter2 :set-apples 23)
; 23
;
(setf my-counter2 (fruit-counter 10000))