X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/e7d43325b56fc912c6ae55225e55529aff12b6ed..287e744e9aa96b8eebeb530b68e2854e8ffe5580:/src/module-impl.lisp diff --git a/src/module-impl.lisp b/src/module-impl.lisp index 2626726..4da7804 100644 --- a/src/module-impl.lisp +++ b/src/module-impl.lisp @@ -73,9 +73,11 @@ (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 @@ (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. @@ -153,8 +159,8 @@ (:documentation "Represents a fragment of C code to be written to an output file. - A C fragment is aware of its original location, and will bear proper #line - markers when written out.")) + A C fragment is aware of its original location, and will bear proper + `#line' markers when written out.")) (defun output-c-excursion (stream location func) "Invoke FUNC surrounding it by writing #line markers to STREAM.