X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=66d35aab6ae8fde32b7af5ad526b5faaf59fea98;hb=fa8962d732057015fbb9a2f8a08ea8d5299b50dd;hp=220bf09f728a0e0e86e3f553d63eba95a15794a5;hpb=2d195da5e29feadce7190ea1a68a2efa83a5e1c0;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 220bf09..66d35aa 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -323,8 +323,8 @@
 			 options
 			 (lambda (lexenv-lambda default))
 			 (cleanup (lexenv-cleanup default))
-			 (cookie (lexenv-cookie default))
-			 (interface-cookie (lexenv-interface-cookie default)))
+			 (policy (lexenv-policy default))
+			 (interface-policy (lexenv-interface-policy default)))
   (macrolet ((frob (var slot)
 	       `(let ((old (,slot default)))
 		  (if ,var
@@ -336,26 +336,25 @@
      (frob blocks lexenv-blocks)
      (frob tags lexenv-tags)
      (frob type-restrictions lexenv-type-restrictions)
-     lambda cleanup cookie interface-cookie
+     lambda cleanup policy interface-policy
      (frob options lexenv-options))))
 
-;;; Return a cookie that defaults any unsupplied optimize qualities in
-;;; the Interface-Cookie with the corresponding ones from the Cookie.
-(defun make-interface-cookie (lexenv)
+;;; Return a POLICY that defaults any unsupplied optimize qualities in
+;;; the INTERFACE-POLICY with the corresponding ones from the POLICY.
+(defun make-interface-policy (lexenv)
   (declare (type lexenv lexenv))
-  (let ((icookie (lexenv-interface-cookie lexenv))
-	(cookie (lexenv-cookie lexenv)))
-    (make-cookie
-     :speed (or (cookie-speed icookie) (cookie-speed cookie))
-     :space (or (cookie-space icookie) (cookie-space cookie))
-     :safety (or (cookie-safety icookie) (cookie-safety cookie))
-     :cspeed (or (cookie-cspeed icookie) (cookie-cspeed cookie))
-     :brevity (or (cookie-brevity icookie) (cookie-brevity cookie))
-     :debug (or (cookie-debug icookie) (cookie-debug cookie)))))
+  (let ((ipolicy (lexenv-interface-policy lexenv))
+	(policy (lexenv-policy lexenv)))
+    (let ((result policy))
+      (dolist (quality '(speed safety space))
+	(let ((iquality-entry (assoc quality ipolicy)))
+	  (when iquality-entry
+	    (push iquality-entry result))))
+      result)))
 
 ;;;; flow/DFO/component hackery
 
-;;; Join Block1 and Block2.
+;;; Join BLOCK1 and BLOCK2.
 #!-sb-fluid (declaim (inline link-blocks))
 (defun link-blocks (block1 block2)
   (declare (type cblock block1 block2))
@@ -890,7 +889,7 @@
     (unless (or (leaf-ever-used var)
 		(lambda-var-ignorep var))
       (let ((*compiler-error-context* (lambda-bind fun)))
-	(unless (policy *compiler-error-context* (= brevity 3))
+	(unless (policy *compiler-error-context* (= inhibit-warnings 3))
 	  ;; ANSI section "3.2.5 Exceptional Situations in the Compiler"
 	  ;; requires this to be a STYLE-WARNING.
 	  (compiler-style-warning "The variable ~S is defined but never used."
@@ -1637,8 +1636,8 @@
 ;;; out how to compile something as efficiently as it liked.)
 (defun compiler-note (format-string &rest format-args)
   (unless (if *compiler-error-context*
-	      (policy *compiler-error-context* (= brevity 3))
-	      (policy nil (= brevity 3)))
+	      (policy *compiler-error-context* (= inhibit-warnings 3))
+	      (policy nil (= inhibit-warnings 3)))
     (incf *compiler-note-count*)
     (print-compiler-message (format nil "note: ~A" format-string)
 			    format-args))
@@ -1730,7 +1729,7 @@
   problem is a missing definition (as opposed to a typo in the use.)")
 
 ;;; Make an entry in the *UNDEFINED-WARNINGS* describing a reference
-;;; to Name of the specified Kind. If we have exceeded the warning
+;;; to NAME of the specified KIND. If we have exceeded the warning
 ;;; limit, then just increment the count, otherwise note the current
 ;;; error context.
 ;;;
@@ -1738,14 +1737,18 @@
 ;;; WITH-COMPILATION-UNIT, which can potentially be invoked outside
 ;;; the compiler, hence the BOUNDP check.
 (defun note-undefined-reference (name kind)
-  (unless (and (boundp '*lexenv*)
-	       ;; FIXME: I'm pretty sure the BREVITY test below isn't
-	       ;; a good idea; we should have BREVITY affect compiler
-	       ;; notes, not STYLE-WARNINGs. And I'm not sure what the
-	       ;; BOUNDP '*LEXENV* test above is for; it's likely
-	       ;; a good idea, but it probably deserves an explanatory
-	       ;; comment.
-	       (policy nil (= brevity 3)))
+  (unless (and
+	   ;; (POLICY NIL ..) isn't well-defined except in IR1
+	   ;; conversion. This BOUNDP test seems to be a test for
+	   ;; whether IR1 conversion is going on.
+	   (boundp '*lexenv*)
+	   ;; FIXME: I'm pretty sure the INHIBIT-WARNINGS test below
+	   ;; isn't a good idea; we should have INHIBIT-WARNINGS
+	   ;; affect compiler notes, not STYLE-WARNINGs. And I'm not
+	   ;; sure what the BOUNDP '*LEXENV* test above is for; it's
+	   ;; likely a good idea, but it probably deserves an
+	   ;; explanatory comment.
+	   (policy nil (= inhibit-warnings 3)))
     (let* ((found (dolist (warning *undefined-warnings* nil)
 		    (when (and (equal (undefined-warning-name warning) name)
 			       (eq (undefined-warning-kind warning) kind))
@@ -1827,8 +1830,8 @@
   (incf (event-info-count info))
   (when (and (>= (event-info-level info) *event-note-threshold*)
 	     (if node
-		 (policy node (= brevity 0))
-		 (policy nil (= brevity 0))))
+		 (policy node (= inhibit-warnings 0))
+		 (policy nil (= inhibit-warnings 0))))
     (let ((*compiler-error-context* node))
       (compiler-note (event-info-description info))))