X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/3a774b55edfea441c1715994924c2999e9202143..9c29a20fc74f6a5710a83cdb17d3e8814de4605e:/src/module-impl.lisp diff --git a/src/module-impl.lisp b/src/module-impl.lisp index cb3a8ad..4da7804 100644 --- a/src/module-impl.lisp +++ b/src/module-impl.lisp @@ -73,9 +73,11 @@ (defun build-module (let ((existing (gethash truename *module-map*))) (cond ((null existing)) ((eq (module-state existing) t) + (when (plusp (module-errors existing)) + (error "Module `~A' contains errors" name)) (return-from build-module existing)) (t - (error "Module ~A already being imported at ~A" + (error "Module `~A' already being imported at ~A" name (module-state existing)))))) ;; Construct the new module. @@ -101,10 +103,14 @@ (defun call-with-module-environment (thunk &optional (module *module*)) (progv (mapcar #'car *module-bindings-alist*) (module-variables module) - (unwind-protect (funcall thunk) - (setf (module-variables module) - (mapcar (compose #'car #'symbol-value) - *module-bindings-alist*))))) + (handler-bind ((error (lambda (cond) + (declare (ignore cond)) + (incf (slot-value module 'errors)) + :decline))) + (unwind-protect (funcall thunk) + (setf (module-variables module) + (mapcar (compose #'car #'symbol-value) + *module-bindings-alist*)))))) (defun call-with-temporary-module (thunk) "Invoke THUNK in the context of a temporary module, returning its values.