@@ -133,17 +133,22 @@ (bt:with-recursive-lock-held (*storage-lock*) (generate-code-from-info (find-root-info info)))) +(defun maybe-compile (function) + ;; compiles function if possible. + (or (ignore-errors (compile nil function)) + function)) + (defun generate-closure-values-generator (variables) - `(compile nil (lambda (internal-info) ; internal-info is the same as info, but for run-time access + `(maybe-compile (lambda (internal-info) ; internal-info is the same as info, but for run-time access ; this is to make future expansions (e.g. run time checking ; which variables need to be stored) - (declare (ignore internal-info)) - (list . ,variables)))) + (declare (ignore internal-info)) + (list . ,variables)))) (defgeneric generate-code-from-info (info)) (defmethod generate-code-from-info ((info lambda-info)) - (setting-info-value info `(compile nil ,(generate-function-lambda info)))) + (setting-info-value info `(maybe-compile ,(generate-function-lambda info)))) (defgeneric generate-function-lambda (info)) src/classes.lisp @@ -84,7 +84,7 @@ ;; n-func is bound to the restored "copy" of the function (dotimes (i 3) (ensure=-funcall func n-func)) - (ensure-cases (x) '((16) (-4) (-18) (5)) + (ensure-cases (x) '(16 -4 -18 5) (ensure=-funcall func n-func x))) ;;; Multiple closures work just fine as well @@ -106,7 +106,7 @@ (dotimes (i 3) (ensure=-funcall inc-func n-inc-func)) (ensure=-funcall set-func n-set-func 10) - (ensure-cases (x) '((19) (-6) (-2) (3)) + (ensure-cases (x) '(19 -6 -2 3) (ensure=-funcall inc-func n-inc-func x)) (ensure=-funcall set-func n-set-func 12)) @@ -178,7 +178,7 @@ (shiftf a b c (the fixnum value)))))))) (dolist (x '(3 11 10 8 16)) (funcall func x)) - (ensure-cases (x) '((10) (6) (-13) (-7) (10) (13) (-15) (-18) (0) (0) (0)) + (ensure-cases (x) '(10 6 -13 -7 10 13 -15 -18 0 0 0) (ensure=-funcall func n-func x))) (def-std-test recursive-shifting-closure-test @@ -199,19 +199,19 @@ (funcall func1 x)) (dolist (x '(8 14 0)) (funcall func2 x))) - (ensure-cases (x) '((2) (0) (-13)) + (ensure-cases (x) '(2 0 -13) (ensure=-funcall func1 n-func1 x)) - (ensure-cases (x) '((2) (0) (-13)) + (ensure-cases (x) '(2 0 -13) (ensure=-funcall func1 n-func1 x)) - (ensure-cases (x) '((-8) (8)) + (ensure-cases (x) '(-8 8) (ensure=-funcall func2 n-func2 x)) - (ensure-cases (x) '((15) (-3)) + (ensure-cases (x) '(15 -3) (ensure=-funcall func1 n-func1 x)) - (ensure-cases (x) '((4) (-1) (18)) + (ensure-cases (x) '(4 -1 18) (ensure=-funcall func2 n-func2 x)) - (ensure-cases (x) '((0) (0)) + (ensure-cases (x) '(0 0) (ensure=-funcall func1 n-func1 x)) - (ensure-cases (x) '((0) (0) (0)) + (ensure-cases (x) '(0 0 0) (ensure=-funcall func2 n-func2 x))) (def-std-test labels-add-sub-test tests/general.lisp 4c36c64768634cdd58aadbfd9b59d16c7ea348f2 Gustavo Henrique Milaré gugamilare@gmail.com http://github.com/gugamilare/storable-functions/commit/a248709fad15a815a564c9f5a45e45945f70a18d a248709fad15a815a564c9f5a45e45945f70a18d 2009-03-12T13:12:58-07:00 2009-03-12T13:12:58-07:00 Changed default behavior so that it works when implementation can't compile. Fixed some bugs caused by changes in lift package. 838d1502eb7e946d0168e23a4aa4f60c4a095b1c Gustavo Henrique Milaré gugamilare@gmail.com