From 4a91d197fd94164eb8bf4cb4e0f84d5ea0be0061 Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Thu, 2 Mar 2017 14:26:47 -0500 Subject: [PATCH] Expanded dlambda example some more --- lisp/dlambda.lisp | 16 ++++--- lisp/fruit-counter.lisp | 98 ++++++++++++++++++++++++++++------------- 2 files changed, 78 insertions(+), 36 deletions(-) diff --git a/lisp/dlambda.lisp b/lisp/dlambda.lisp index 76331c6..3428bc5 100644 --- a/lisp/dlambda.lisp +++ b/lisp/dlambda.lisp @@ -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)) + ) + ) ) ) ) diff --git a/lisp/fruit-counter.lisp b/lisp/fruit-counter.lisp index d9fb6b8..c32041f 100644 --- a/lisp/fruit-counter.lisp +++ b/lisp/fruit-counter.lisp @@ -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)) + ) + ) + + ) +) + +(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 () - (setf banana-count (- banana-count 1)) + (:dec-apples () + (funcall apple-counter :dec) ) - (:get-banana () - banana-count + (:get-apples () + (funcall apple-counter :get) ) - (:set-banana (value) - (setf banana-count value) + (:set-apples (value) + (funcall apple-counter :set value) ) - (:inc-coconut () - (setf coconut-count (+ coconut-count 1)) + (:inc-bananas () + (funcall banana-counter :inc) ) - (:dec-coconut () - (setf coconut-count (- coconut-count 1)) + (:dec-bananas () + (funcall banana-counter :dec) ) - (:get-coconut () - coconut-count + (:get-bananas () + (funcall banana-counter :get) ) - (:set-coconut (value) - (setf coconut-count value) + (: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))