Only three variables *COMPILE-PRINT*, *COMPILE-VERBOSE* and *SUPPRESS-COMPILER-MESSAGES* to govern information printed by COMPILE-FILE/COMPILE

src/CHANGELOG

@@ -6,6 +6,14 @@ ECL 0.9l-p1:
  - The compiler now signals compiler-error, compiler-warning and compiler-note
    for errors, warnings and notes, respectively.
 
+ - Printing of compiler messages is now ruled by *COMPILE-PRINT*, *COMPILE-VERBOSE*
+   and *SUPPRESS-COMPILER-MESSAGES*. The latter is either NIL or a valid lisp type
+   which denotes which compiler messages are suppressed. If *SUPPRESS-COMPILER-MESSAGES*
+   is NIL and *COMPILE-VERBOSE* is NIL, then no messages are shown.
+
+ - *SUPPRESS-COMPILER-NOTES* and *SUPPRES-COMPILER-WARNINGS* are deprecated and
+   will be removed in next release.
+
  - ECL allows the user to set up handlers for different compiler conditions,
    including errors, warnings and simple notes. The recommended procedure is to
    use HANDLER-BIND and _NOT_ to transfer control out of the compilation
@@ -13,17 +21,12 @@ ECL 0.9l-p1:
    and MUFFLE-WARNING.
 
 	(use-package :c)
-	(let ((messages nil))
-	  (handler-bind ((compiler-error #'(lambda (c)
-					     (push c messages)
-					     (abort c)))
-			 (compiler-message #'(lambda (c)
-					       (push c messages)
-					       (muffle-warning))))
-	    (let ((*compile-verbose* nil))
-	      (compile-file "foo.lsp")))
+	(let ((warnings nil))
+	  (handler-bind ((compiler-message #'(lambda (c)
+					       (push c warnings))))
+	    (compile-file "foo.lsp" :verbose nil :print nil))
 	  (format t "~&;;; Printing compiler messages")
-	  (loop for m in (nreverse messages)
+	  (loop for m in (nreverse warnings)
 	     for i from 0
 	     do (format t "~&~@<;;; ~@;Message #~D~%~A~:>" i m)))
 

src/cmp/cmpdefs.lsp

@@ -39,7 +39,8 @@
 	   "COMPILER-MESSAGE-FILE-POSITION"
 	   "COMPILER-MESSAGE-FORM"
 	   "*SUPPRESS-COMPILER-WARNINGS*"
-	   "*SUPPRESS-COMPILER-NOTES*")
+	   "*SUPPRESS-COMPILER-NOTES*"
+	   "*SUPPRESS-COMPILER-MESSAGES*")
   (:import-from "SI" "GET-SYSPROP" "PUT-SYSPROP" "REM-SYSPROP" "MACRO"
 		"*COMPILER-CONSTANTS*" "REGISTER-GLOBAL" "CMP-ENV-REGISTER-MACROLET"
 		"COMPILER-LET"))
@@ -276,13 +277,11 @@ each form it processes. The default value is NIL.")
   "This variable controls whether the compiler should display messages about its
 progress. The default value is T.")
 
-(defvar *suppress-compiler-warnings* nil
-  "This variable controls whether the compiler should issue warnings.
-The default value is NIL.")
+(defvar *suppress-compiler-messages* nil
+  "A type denoting which compiler messages and conditions are _not_ displayed.")
 
-(defvar *suppress-compiler-notes* nil
-  "This variable controls whether the compiler displays compilation notices.
-The default value is NIL.")
+(defvar *suppress-compiler-notes* nil) ; Deprecated
+(defvar *suppress-compiler-warnings* nil) ; Deprecated
 
 (defvar *compiler-break-enable* nil)
 

src/cmp/cmpmain.lsp

@@ -302,8 +302,16 @@ filesystem or in the database of ASDF modules."
 		(epilogue-code (when (eq target :program) '(SI::TOP-LEVEL)))
 		#+:win32 (system :console)
 		&aux
-		(*suppress-compiler-notes* (or *suppress-compiler-notes* (not *compile-verbose*)))
-		(*suppress-compiler-warnings* (or *suppress-compiler-warnings* (not *compile-verbose*))))
+		(*suppress-compiler-messages* (or *suppress-compiler-messages*
+						  (not *compile-verbose*))))
+  ;; Deprecated, to be removed in next release
+  (when *suppress-compiler-notes*
+    (setf *suppress-compiler-messages*
+	  `(or ,*suppress-compiler-messages* compiler-note)))
+  (when *suppress-compiler-warnings*
+    (setf *suppress-compiler-messages*
+	  `(or ,*suppress-compiler-messages* compiler-warning)))
+
   ;;
   ;; The epilogue-code can be either a string made of C code, or a
   ;; lisp form.  In the latter case we add some additional C code to
@@ -458,8 +466,8 @@ static cl_object VV[VM];
 
 (defun compile-file (input-pathname
                       &key
-		      (verbose *compile-verbose*)
-		      (print *compile-print*)
+		      ((:verbose *compile-verbose*) *compile-verbose*)
+		      ((:print *compile-print*) *compile-print*)
 		      (c-file nil)
 		      (h-file nil)
 		      (data-file nil)
@@ -474,12 +482,19 @@ static cl_object VV[VM];
 			   (*print-pretty* nil)
 			   (*compile-file-pathname* nil)
 			   (*compile-file-truename* nil)
-			   (*compile-verbose* verbose)
-			   (*suppress-compiler-notes* (or *suppress-compiler-notes* (not verbose)))
-			   (*suppress-compiler-warnings* (or *suppress-compiler-warnings* (not verbose)))
+			   (*suppress-compiler-messages*
+			    (or *suppress-compiler-messages* (not *compile-verbose*)))
 			   init-name)
   (declare (notinline compiler-cc))
 
+  ;; Deprecated, to be removed in next release
+  (when *suppress-compiler-notes*
+    (setf *suppress-compiler-messages*
+	  `(or ,*suppress-compiler-messages* compiler-note)))
+  (when *suppress-compiler-warnings*
+    (setf *suppress-compiler-messages*
+	  `(or ,*suppress-compiler-messages* compiler-warning)))
+
   #-dlopen
   (unless system-p
     (format t "~%;;;~
@@ -500,8 +515,6 @@ static cl_object VV[VM];
 
   (when (eq output-file 'T)
     (setf output-file *compile-file-truename*))
-  (setf output-file (compile-file-pathname output-file :type (if system-p :object :fasl)))
-
   (when (and system-p load)
     (error "Cannot load system files."))
 
@@ -510,11 +523,8 @@ static cl_object VV[VM];
   (let* ((eof '(NIL))
 	 (*compiler-in-use* *compiler-in-use*)
 	 (*load-time-values* nil) ;; Load time values are compiled
-	 (o-pathname (or #+dlopen (and system-p output-file)
-			 #-dlopen output-file
-			 (compile-file-pathname (or output-file input-pathname) :type :object)))
-	 #+dlopen
-	 (so-pathname (unless system-p output-file))
+	 (o-pathname (compile-file-pathname output-file :type :object))
+	 (so-pathname (compile-file-pathname output-file :type :fasl))
          (c-pathname (get-output-pathname o-pathname c-file :c))
          (h-pathname (get-output-pathname o-pathname h-file :h))
          (data-pathname (get-output-pathname o-pathname data-file :data))
@@ -524,6 +534,8 @@ static cl_object VV[VM];
 
     (with-compiler-env (compiler-conditions)
 
+      (setf output-file (if system-p o-pathname so-pathname))
+
       (print-compiler-info)
 
       (when (probe-file "./cmpinit.lsp")
@@ -562,12 +574,13 @@ static cl_object VV[VM];
 	(unless system-p (bundle-cc (si::coerce-to-filename so-pathname)
 				    init-name
 				    (si::coerce-to-filename o-pathname)))
-	(unless (if system-p
-		    (probe-file o-pathname)
-		    (probe-file so-pathname))
+	(unless (setf output-file (probe-file output-file))
 	  (cmperr "The C compiler failed to compile the intermediate file.")))
       (cmpprogress "~&;;; Finished compiling ~a.~%" (namestring input-pathname))
-      
+
+      (when (and load output-file (not system-p))
+	(load output-file :verbose *compile-verbose*))
+
       ) ; with-compiler-env
 
     (unless c-file (cmp-delete-file c-pathname))
@@ -576,9 +589,7 @@ static cl_object VV[VM];
       (cmp-delete-file data-pathname))
     #+dlopen
     (unless system-p (cmp-delete-file o-pathname))
-    (compiler-output-values (truename #+dlopen (if system-p o-pathname so-pathname)
-				      #-dlopen o-pathname)
-			    compiler-conditions)))
+    (compiler-output-values output-file compiler-conditions)))
 
 (defun compiler-output-values (main-value conditions)
   (loop for i in conditions
@@ -603,8 +614,8 @@ static cl_object VV[VM];
 #+dlopen
 (defun compile (name &optional (def nil supplied-p)
                       &aux form data-pathname
-                      (*suppress-compiler-warnings* (or *suppress-compiler-warnings* (not *compile-verbose*)))
-                      (*suppress-compiler-notes* (or *suppress-compiler-notes* (not *compile-verbose*)))
+                      (*suppress-compiler-messages* (or *suppress-compiler-messages*
+							(not *compile-verbose*)))
                       (*compiler-in-use* *compiler-in-use*)
                       (*standard-output* *standard-output*)
                       (*error-output* *error-output*)
@@ -615,6 +626,14 @@ static cl_object VV[VM];
 
   (unless (symbolp name) (error "~s is not a symbol." name))
 
+  ;; Deprecated, to be removed in next release
+  (when *suppress-compiler-notes*
+    (setf *suppress-compiler-messages*
+	  `(or ,*suppress-compiler-messages* compiler-note)))
+  (when *suppress-compiler-warnings*
+    (setf *suppress-compiler-messages*
+	  `(or ,*suppress-compiler-messages* compiler-warning)))
+
   (cond ((and supplied-p def)
 	 (when (functionp def)
 	   (unless (function-lambda-expression def)

src/cmp/cmptop.lsp

@@ -27,8 +27,7 @@
   (catch *cmperr-tag*
     (when (consp form)
       (let ((fun (car form)) (args (cdr form)) fd)
-	(when (and *compile-print*
-		   (member fun *toplevel-forms-to-print*))
+	(when (member fun *toplevel-forms-to-print*)
 	  (print-current-form))
 	(cond
             ((consp fun) (t1ordinary form))
@@ -525,7 +524,7 @@
                               (lambda-list (c1form-arg 0 lambda-expr))
                               (requireds (car lambda-list)))
   (declare (fixnum level nenvs))
-  (when *compile-print* (print-emitting fun))
+  (print-emitting fun)
   (wt-comment (cond ((fun-global fun) "function definition for ")
 		    ((eq (fun-closure fun) 'CLOSURE) "closure ")
 		    (t "local function "))

src/cmp/cmputil.lsp

@@ -56,16 +56,13 @@
 	     (slot-value condition 'variable)))))
 
 (defun print-compiler-message (c stream)
-  (format stream "~&~@<;;; ~@;~A~:>" c))
+  (unless (typep c *suppress-compiler-messages*)
+    (format stream "~&~@<;;; ~@;~A~:>" c)))
 
 (defun handle-note (c)
   nil)
 
-(defun handle-warning (c)
-  (push c *compiler-conditions*)
-  nil)
-
-(defun handle-error (c)
+(defun handle-warning/error (c)
   (push c *compiler-conditions*)
   nil)
 
@@ -103,8 +100,8 @@
      (declare (special *compiler-conditions*))
      (restart-case
 	 (handler-bind ((compiler-note #'handle-note)
-			(warning #'handle-warning)
-			(compiler-error #'handle-error))
+			(warning #'handle-warning/error)
+			(compiler-error #'handle-warning/error))
 	   (handler-bind ((error #'handle-internal-error))
 	     (if *compiler-in-use*
 		 (error "The compiler was called recursively.")
@@ -165,43 +162,36 @@
           lower-bound
           n))
 
-(defun do-cmpwarn (suppress &rest args)
+(defun do-cmpwarn (&rest args)
   (declare (si::c-local))
   (let ((condition (apply #'make-condition args)))
     (restart-case (signal condition)
       (muffle-warning ()
 	:REPORT "Skip warning"
 	(return-from do-cmpwarn nil)))
-    (unless suppress
-      (print-compiler-message condition t))))
+    (print-compiler-message condition t)))
 
 (defun cmpwarn (string &rest args)
-  (do-cmpwarn *suppress-compiler-warnings* 'compiler-warning
-    :format-control string
-    :format-arguments args))
+  (do-cmpwarn 'compiler-warning :format-control string :format-arguments args))
 
 (defun cmpnote (string &rest args)
-  (do-cmpwarn *suppress-compiler-notes* 'compiler-note
-    :format-control string
-    :format-arguments args))
+  (do-cmpwarn 'compiler-note :format-control string :format-arguments args))
 
 (defun print-current-form ()
-  (when *compile-verbose*
+  (when *compile-print*
     (let ((*print-length* 2)
 	  (*print-level* 2))
       (format t "~&;;; Compiling ~s.~%" *current-form*)))
   nil)
 
 (defun print-emitting (f)
-  (let* ((name (fun-name f)))
-    (unless name
-      (setf name (fun-description f)))
-    (when (and name *compile-verbose*)
-      (format t "~&;;; Emitting code for ~s.~%" name))))
+  (when *compile-print*
+    (let* ((name (or (fun-name f) (fun-description f))))
+      (when name
+	(format t "~&;;; Emitting code for ~s.~%" name)))))
 
 (defun undefined-variable (sym)
-  (do-cmpwarn *suppress-compiler-warnings*
-    'compiler-undefined-variable :name sym))
+  (do-cmpwarn 'compiler-undefined-variable :name sym))
   
 (defun baboon (&aux (*print-case* :upcase))
   (signal 'compiler-internal-error