96 lines
2.7 KiB
Plaintext
96 lines
2.7 KiB
Plaintext
---
|
|
Test
|
|
---
|
|
| script | lisp interpreter fixture |
|
|
| # | Object with multiple methods |
|
|
| show | evaluate |!-
|
|
|
|
(defun counter-class ()
|
|
(let ((counter 0))
|
|
(lambda (msg)
|
|
(case msg
|
|
((:inc)
|
|
(setq counter (+ counter 1)))
|
|
((:dec)
|
|
(setq counter (- counter 1)))))))
|
|
|
|
-!|
|
|
| show | evaluate | (setq my-counter (counter-class)) |
|
|
| check | evaluate | (funcall my-counter :inc) | 1 |
|
|
| check | evaluate | (funcall my-counter :inc) | 2 |
|
|
| check | evaluate | (funcall my-counter :inc) | 3 |
|
|
| check | evaluate | (funcall my-counter :dec) | 2 |
|
|
| check | evaluate | (funcall my-counter :dec) | 1 |
|
|
| check | evaluate | (funcall my-counter :dec) | 0 |
|
|
|
|
|
|
| script | lisp interpreter fixture |
|
|
| # | dlambda |
|
|
| show | evaluate |!-
|
|
|
|
(defun map (fn ls)
|
|
(if (null ls)
|
|
()
|
|
(cons (funcall fn (first ls))
|
|
(map fn (rest ls))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define-macro dlambda (&rest methods)
|
|
(cons
|
|
(quote lambda)
|
|
(cons
|
|
(quote (&rest arguments))
|
|
(list
|
|
(cons
|
|
(quote case)
|
|
(cons
|
|
(quote (first arguments))
|
|
(map
|
|
(lambda (method)
|
|
(cons
|
|
(first method)
|
|
(list
|
|
(cons
|
|
(quote apply)
|
|
(cons
|
|
(cons
|
|
(quote lambda)
|
|
(rest method)
|
|
)
|
|
(list (quote (rest arguments)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
methods
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun apple-counter ()
|
|
(let ((apple-count 0))
|
|
(eval
|
|
(dlambda
|
|
(:inc () (setf apple-count (+ apple-count 1)))
|
|
(:dec () (setf apple-count (- apple-count 1)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
-!|
|
|
| show | evaluate | (setf a (apple-counter)) |
|
|
| check | evaluate | (funcall a :inc) | 1 |
|
|
| check | evaluate | (funcall a :inc) | 2 |
|
|
| check | evaluate | (funcall a :inc) | 3 |
|
|
| check | evaluate | (funcall a :dec) | 2 |
|
|
| check | evaluate | (funcall a :dec) | 1 |
|
|
| check | evaluate | (funcall a :dec) | 0 |
|
|
| show | evaluate | (funcall a :inc 1) |
|