X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=5e407c331fd361f5e9d0813827c29a8114774857;hb=d5aafdd8ab6387e12bac187048ed322bc96fb79a;hp=86a7b8d8d10c784ffd95a7c2948fc320b4149a62;hpb=64bf93a97814ea1caf62bbdcc7ef43e2fbfc8f73;p=sbcl.git diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 86a7b8d..5e407c3 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -345,13 +345,12 @@ (declare (type lexenv lexenv)) (let ((ipolicy (lexenv-interface-policy lexenv)) (policy (lexenv-policy lexenv))) - (make-policy - :speed (or (policy-speed ipolicy) (policy-speed policy)) - :space (or (policy-space ipolicy) (policy-space policy)) - :safety (or (policy-safety ipolicy) (policy-safety policy)) - :cspeed (or (policy-cspeed ipolicy) (policy-cspeed policy)) - :brevity (or (policy-brevity ipolicy) (policy-brevity policy)) - :debug (or (policy-debug ipolicy) (policy-debug policy))))) + (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 @@ -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." @@ -1273,21 +1272,26 @@ (declaim (special *current-path*)) -;;; We bind print level and length when printing out messages so that we don't -;;; dump huge amounts of garbage. +;;; We bind print level and length when printing out messages so that +;;; we don't dump huge amounts of garbage. +;;; +;;; FIXME: It's not possible to get the defaults right for everyone. +;;; So: Should these variables be in the SB-EXT package? Or should we +;;; just get rid of them completely and just use the bare +;;; CL:*PRINT-FOO* variables instead? (declaim (type (or unsigned-byte null) *compiler-error-print-level* *compiler-error-print-length* *compiler-error-print-lines*)) -(defvar *compiler-error-print-level* 3 +(defvar *compiler-error-print-level* 5 #!+sb-doc - "The value for *PRINT-LEVEL* when printing compiler error messages.") -(defvar *compiler-error-print-length* 5 + "the value for *PRINT-LEVEL* when printing compiler error messages") +(defvar *compiler-error-print-length* 10 #!+sb-doc - "The value for *PRINT-LENGTH* when printing compiler error messages.") -(defvar *compiler-error-print-lines* 5 + "the value for *PRINT-LENGTH* when printing compiler error messages") +(defvar *compiler-error-print-lines* 12 #!+sb-doc - "The value for *PRINT-LINES* when printing compiler error messages.") + "the value for *PRINT-LINES* when printing compiler error messages") (defvar *enclosing-source-cutoff* 1 #!+sb-doc @@ -1513,10 +1517,10 @@ (setq *last-message-count* 0)) ;;; Print out the message, with appropriate context if we can find it. -;;; If If the context is different from the context of the last -;;; message we printed, then we print the context. If the original -;;; source is different from the source we are working on, then we -;;; print the current source in addition to the original source. +;;; If the context is different from the context of the last message +;;; we printed, then we print the context. If the original source is +;;; different from the source we are working on, then we print the +;;; current source in addition to the original source. ;;; ;;; We suppress printing of messages identical to the previous, but ;;; record the number of times that the message is repeated. @@ -1608,9 +1612,10 @@ (defun print-compiler-condition (condition) (declare (type condition condition)) - (let (;; These different classes of conditions have different effects - ;; on the return codes of COMPILE-FILE, so it's nice for users to be - ;; able to pick them out by lexical search through the output. + (let (;; These different classes of conditions have different + ;; effects on the return codes of COMPILE-FILE, so it's nice + ;; for users to be able to pick them out by lexical search + ;; through the output. (what (etypecase condition (style-warning 'style-warning) (warning 'warning) @@ -1637,8 +1642,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)) @@ -1697,8 +1702,8 @@ (defvar *warnings-p*) ;;; condition handlers established by the compiler. We re-signal the -;;; condition, if it is not handled, we increment our warning counter -;;; and print the error message. +;;; condition, then if it isn't handled, we increment our warning +;;; counter and print the error message. (defun compiler-error-handler (condition) (signal condition) (incf *compiler-error-count*) @@ -1730,7 +1735,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 +1743,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 +1836,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))))