Plaster
New
List
Login
common-lisp
default
phoe
2022.01.31 19:38:02
;;; Code under test (defmacro first-time-value (form) (let ((cache-var (gensym (string '#:cache)))) `(let ((,cache-var (load-time-value (cons nil nil)))) (if (car ,cache-var) (cdr ,cache-var) (prog1 (setf (cdr ,cache-var) ,form) (setf (car ,cache-var) t)))))) (defmacro first-time-values (form) `(values-list (first-time-value (multiple-value-list ,form)))) ;;; Simplified test framework (defmacro are (comp expected form) `(assert (,comp ,expected (multiple-value-list ,form)))) ;;; Tests (let* ((eval-count 0) (nested (lambda () (lambda () (lambda () (first-time-value (prog1 8 (incf eval-count)))))))) (are equal '(8 8 1) (values (funcall (funcall (funcall nested))) (funcall (funcall (funcall nested))) eval-count))) (let* ((eval-count 0) (nested (lambda () (lambda () (lambda () (first-time-values (multiple-value-prog1 (values 8 16 32) (incf eval-count)))))))) (are equal '(8 16 32 8 16 32 1) (multiple-value-call #'values (funcall (funcall (funcall nested))) (funcall (funcall (funcall nested))) eval-count))) (let* ((eval-count 0) (nested (lambda () (lambda () (lambda () (handler-case (first-time-value (prog1 8 (incf eval-count) (when (<= eval-count 2) (error "Uh oh.")))) (error () 'error))))))) (are equal '(error error 8 8 3) (flet ((call-it () (funcall (funcall (funcall nested))))) (values (call-it) (call-it) (call-it) (call-it) eval-count))))
Raw
Annotate
Repaste