X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-cltl2%2Fenv.lisp;h=905e9b6f33a910956a5020d6b7db6d99739e85f6;hb=b544f7bf681260d24a0656872728bbf3feed1ff9;hp=2a99b982a55bb1e5a4ef96732c382f5b87b3ab36;hpb=c8cc0137e55e6179f6af344f42e54f514660f68b;p=sbcl.git

diff --git a/contrib/sb-cltl2/env.lisp b/contrib/sb-cltl2/env.lisp
index 2a99b98..905e9b6 100644
--- a/contrib/sb-cltl2/env.lisp
+++ b/contrib/sb-cltl2/env.lisp
@@ -55,14 +55,19 @@ alist of declarations that apply to the apparent binding of VAR."
 (declaim (ftype (sfunction (symbol &optional (or null lexenv)) t)
                 declaration-information))
 (defun declaration-information (declaration-name &optional env)
-  (let ((policy (sb-c::lexenv-policy (or env (make-null-lexenv)))))
+  (let ((env (or env (make-null-lexenv))))
     (case declaration-name
-      (optimize (collect ((res))
-                  (dolist (name sb-c::*policy-qualities*)
-                    (res (list name (cdr (assoc name policy)))))
-                  (loop for (name . nil) in sb-c::*policy-dependent-qualities*
-                        do (res (list name (sb-c::policy-quality policy name))))
-                  (res)))
+      (optimize
+       (let ((policy (sb-c::lexenv-policy env)))
+         (collect ((res))
+           (dolist (name sb-c::*policy-qualities*)
+             (res (list name (cdr (assoc name policy)))))
+           (loop for (name . nil) in sb-c::*policy-dependent-qualities*
+                 do (res (list name (sb-c::policy-quality policy name))))
+           (res))))
+      (sb-ext:muffle-conditions
+       (car (rassoc 'muffle-warning
+                    (sb-c::lexenv-handled-conditions env))))
       (t (error "Unsupported declaration ~S." declaration-name)))))
 
 (defun parse-macro (name lambda-list body &optional env)