src/module-{proto,impl}.lisp, etc.: Don't output erroneous modules.

Add a new reader `module-errors' which reports the number of errors
found while processing the module.  Notice (but decline to handle)
errors while loading modules.  And, in the front-end, don't try to
output erroneous modules.

This fixes an annoying problem where errors are reported and cause
`make' to fail, and then a subsequent `make' apparently succeeds,
possibly with bogus C code.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 4f13521..944a975 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -588,6 +588,7 @@ module-proto.lisp
   finalize-module                               generic
   module                                        class
   module-dependencies                           generic setf
+  module-errors                                 generic
   module-import                                 generic
   module-items                                  generic setf
   module-name                                   generic
@@ -1323,6 +1324,8 @@ module-dependencies
   module
 (setf module-dependencies)
   t module
+module-errors
+  module
 module-import
   t
   module

diff --git a/doc/module.tex b/doc/module.tex
index 3c62625..802e32b 100644 (file)
--- a/doc/module.tex
+++ b/doc/module.tex
@@ -53,6 +53,7 @@
 \begin{describe*}
     {\dhead{gf}{module-name @<module> @> @<pathname>}
      \dhead{gf}{module-pset @<module> @> @<pset>}
+     \dhead{gf}{module-errors @<module> @> @<integer>}
      \dhead{gf}{module-items @<module> @> @<list>}
      \dhead{gf}{module-dependencies @<module> @> @<list>}
      \dhead{gf}{module-state @<module> @> @<keyword>}}

diff --git a/src/frontend.lisp b/src/frontend.lisp
index a4625f7..7648e2d 100644 (file)
--- a/src/frontend.lisp
+++ b/src/frontend.lisp
@@ -182,7 +182,9 @@
 
               ;; Parse and write out the remaining modules.
               (dolist (arg args)
-                (hack-module (read-module arg)))))
+                (let ((module (read-module arg)))
+                  (when (zerop (module-errors module))
+                    (hack-module module))))))
 
       (if backtracep (hack-modules)
          (multiple-value-bind (hunoz nerror nwarn)

diff --git a/src/module-impl.lisp b/src/module-impl.lisp
index cb3a8ad..4da7804 100644 (file)
--- 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.

diff --git a/src/module-proto.lisp b/src/module-proto.lisp
index a79069a..7e42a5b 100644 (file)
--- a/src/module-proto.lisp
+++ b/src/module-proto.lisp
@@ -148,11 +148,13 @@
 ;;;--------------------------------------------------------------------------
 ;;; Module objects.
 
-(export '(module module-name module-pset module-items module-dependencies))
+(export '(module module-name module-pset module-errors
+         module-items module-dependencies))
 (defclass module ()
   ((name :initarg :name :type pathname :reader module-name)
    (%pset :initarg :pset :initform (make-pset)
          :type pset :reader module-pset)
+   (errors :initarg :errors :initform 0 :type fixnum :reader module-errors)
    (items :initarg :items :initform nil :type list :accessor module-items)
    (dependencies :initarg :dependencies :initform nil
                 :type list :accessor module-dependencies)