84 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
	
	
			
		
		
	
	
			84 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
	
	
| (load "dlambda.lisp")
 | |
| 
 | |
| (defun fruit-counter (initial-count)
 | |
| 
 | |
|   (let ((apple-count initial-count)
 | |
|         (banana-count initial-count)
 | |
|         (coconut-count initial-count))
 | |
| 
 | |
|     (eval
 | |
|       (dlambda
 | |
| 
 | |
|         (:inc-apple ()
 | |
|           (setf apple-count (+ apple-count 1))
 | |
|         )
 | |
| 
 | |
|         (:dec-apple ()
 | |
|           (setf apple-count (- apple-count 1))
 | |
|         )
 | |
| 
 | |
|         (:get-apple ()
 | |
|           apple-count
 | |
|         )
 | |
| 
 | |
|         (:set-apple (value)
 | |
|           (setf apple-count value)
 | |
|         )
 | |
| 
 | |
|         (:inc-banana ()
 | |
|           (setf banana-count (+ banana-count 1))
 | |
|         )
 | |
| 
 | |
|         (:dec-banana ()
 | |
|           (setf banana-count (- banana-count 1))
 | |
|         )
 | |
| 
 | |
|         (:get-banana ()
 | |
|           banana-count
 | |
|         )
 | |
| 
 | |
|         (:set-banana (value)
 | |
|           (setf banana-count value)
 | |
|         )
 | |
| 
 | |
|         (:inc-coconut ()
 | |
|           (setf coconut-count (+ coconut-count 1))
 | |
|         )
 | |
| 
 | |
|         (:dec-coconut ()
 | |
|           (setf coconut-count (- coconut-count 1))
 | |
|         )
 | |
| 
 | |
|         (:get-coconut ()
 | |
|           coconut-count
 | |
|         )
 | |
| 
 | |
|         (:set-coconut (value)
 | |
|           (setf coconut-count value)
 | |
|         )
 | |
| 
 | |
|       )
 | |
|     )
 | |
| 
 | |
|   )
 | |
| )
 | |
| 
 | |
| ; Create an instance
 | |
| ; 
 | |
| ; usage: 
 | |
| ;   ~ (my-counter :set-apple 23)
 | |
| ;   23
 | |
| ;
 | |
| (let ((instance (fruit-counter 0)))
 | |
|   (defun my-counter (&rest args) (apply instance args))
 | |
| )
 | |
| 
 | |
| ; Another way
 | |
| ; 
 | |
| ; usage: 
 | |
| ;   ~ (funcall my-counter2 :set-apple 23)
 | |
| ;   23
 | |
| ;
 | |
| (setf my-counter2 (fruit-counter 10000))
 | |
| 
 |