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
(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)))
\f
;;;; 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))
(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."
(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*
(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.
(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)
;;; 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))
(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*)
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.
;;;
;;; 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))
(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))))
projects / sbcl.git / blobdiff