Re: bloody warnings !

[bill@cambridge.apple.com (Bill St. Clair)]

Many people haveexpressed dismay about the elimination of *compiler-warnings*
and *fasl-compiler-warnings*. Here's a little file I put together a while
back that restores that functionality.

-------------------------------------------------------------------

;-*- Mode: Lisp; Package: CCL -*-

; compiler-warning-muffler.lisp
;
; Install a new toplevel-loop which will muffle compiler warnings
; if *signal-compiler-warnings* is NIL
;
; Since this file throws to toplevel, loading it will not return.
; Hence, if you load it in your init file, it must be the last thing
; you try to do there.

(in-package :ccl)

; If true, signal compiler warnings normally.
; If NIL, muffle all compiler warnings.
(defparameter *signal-compiler-warnings* t)

; A function of one parameter, the condition object
; which, if non-NIL will be called when an error occurs.
(defparameter *error-catcher* nil)

(defun compiler-warning-muffler ()
  (handler-bind ((compiler-warning
                  #'(lambda (condition)
                      (unless *signal-compiler-warnings*
                        (muffle-warning condition))))
                 (error
                  #'(lambda (condition)
                      (if *error-catcher*
                        (funcall *error-catcher* condition)
                        (signal condition)))))
    (toplevel-loop)))

(defun install-compiler-warning-muffler ()
  (unless (eq 'compiler-warning-muffler (function-name (%set-toplevel)))
    (%set-toplevel #'compiler-warning-muffler)
    (toplevel)))

(install-compiler-warning-muffler)

#|
; An example of an error catching function.
; A real error handler would want to query the error to decide what
; to do and then do some sort of non-local exit to resume execution.
(setq *error-catcher*
      #'(lambda (condition)
          (format *error-output* "~a" condition)        ; print the error
          (break)))                     ; and enter a break loop
|#

#|
; Another way to muffle compiler warnings.
; This one depends on knowledge of undocumented parts of MCL
(defvar *compiler-warning-signaller* #'signal-compiler-warning)
(let ((*warn-if-redefine* nil)
      (*warn-if-redefine-kernel* nil))
  (defun signal-compiler-warning (&rest rest)
    (declare (dynamic-extent rest))
    (when *signal-compiler-warnings*
      (apply *compiler-warning-signaller* rest))))
|#