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 4f13521ba603ca95089af280f3bebc34a635cb87..944a9752a29f1a8948bb417a400da100ebb038d8 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -588,6 +588,7 @@ module-proto.lisp
   finalize-module                               generic
   module                                        class
   module-dependencies                           generic setf
   finalize-module                               generic
   module                                        class
   module-dependencies                           generic setf

+  module-errors                                 generic

   module-import                                 generic
   module-items                                  generic setf
   module-name                                   generic
   module-import                                 generic
   module-items                                  generic setf
   module-name                                   generic


@@ -1323,6 +1324,8 @@ module-dependencies
   module
 (setf module-dependencies)
   t module
   module
 (setf module-dependencies)
   t module

+module-errors
+  module

 module-import
   t
   module
 module-import
   t
   module

diff --git a/doc/module.tex b/doc/module.tex
index 3c626251098f51909e1bfd3e4794672780f3c885..802e32bb4927447d0072b7c5fd88c26755bf9f7e 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>}
 \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>}}
      \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 a4625f736361391ec6c4f0f07cc67121390e8c70..7648e2d69ed11f4e7a6c367207b722819953d3cb 100644 (file)
--- a/src/frontend.lisp
+++ b/src/frontend.lisp
@@ -182,7 +182,9 @@     (define-program
 
               ;; Parse and write out the remaining modules.
               (dolist (arg args)
 
               ;; 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)
 
       (if backtracep (hack-modules)
          (multiple-value-bind (hunoz nerror nwarn)

diff --git a/src/module-impl.lisp b/src/module-impl.lisp
index cb3a8ad8b51612b40627045b942969fab08b9756..4da7804dac61f6beb97e87b9f76629787c7efa7b 100644 (file)
--- 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)
     (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
             (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.
                    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)
   (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.
 
 (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 a79069a933788c7a7a7d800338abfcfb4ef48bf1..7e42a5b5c1c171528476411209142f503e9b1a89 100644 (file)
--- a/src/module-proto.lisp
+++ b/src/module-proto.lisp
@@ -148,11 +148,13 @@ (defgeneric finalize-module (module)
 ;;;--------------------------------------------------------------------------
 ;;; Module objects.
 
 ;;;--------------------------------------------------------------------------
 ;;; 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)
 (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)
    (items :initarg :items :initform nil :type list :accessor module-items)
    (dependencies :initarg :dependencies :initform nil
                 :type list :accessor module-dependencies)