1 ;;;; machinery for reporting errors/warnings/notes/whatnot from
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
15 ;;;; compiler error context determination
17 (declaim (special *current-path
*))
19 (defvar *enclosing-source-cutoff
* 1
20 "The maximum number of enclosing non-original source forms (i.e. from
21 macroexpansion) that we print in full. For additional enclosing forms, we
23 (declaim (type unsigned-byte
*enclosing-source-cutoff
*))
25 ;;; We separate the determination of compiler error contexts from the
26 ;;; actual signalling of those errors by objectifying the error
27 ;;; context. This allows postponement of the determination of how (and
28 ;;; if) to signal the error.
30 ;;; We take care not to reference any of the IR1 so that pending
31 ;;; potential error messages won't prevent the IR1 from being GC'd. To
32 ;;; this end, we convert source forms to strings so that source forms
33 ;;; that contain IR1 references (e.g. %DEFUN) don't hold onto the IR.
34 (defstruct (compiler-error-context
35 #-no-ansi-print-object
36 (:print-object
(lambda (x stream
)
37 (print-unreadable-object (x stream
:type t
))))
39 ;; a list of the stringified CARs of the enclosing non-original source forms
40 ;; exceeding the *enclosing-source-cutoff*
41 (enclosing-source nil
:type list
)
42 ;; a list of stringified enclosing non-original source forms
43 (source nil
:type list
)
44 ;; the stringified form in the original source that expanded into SOURCE
45 (original-source (missing-arg) :type simple-string
)
46 ;; a list of prefixes of "interesting" forms that enclose original-source
47 (context nil
:type list
)
48 ;; the FILE-INFO-NAME for the relevant FILE-INFO
49 (file-name (missing-arg) :type
(or pathname
(member :lisp
:stream
)))
50 ;; the file position at which the top level form starts, if applicable
51 (file-position nil
:type
(or index null
))
52 ;; the original source part of the source path
53 (original-source-path nil
:type list
)
54 ;; the lexenv active at the time
55 (lexenv nil
:type
(or null lexenv
)))
57 ;;; If true, this is the node which is used as context in compiler warning
59 (declaim (type (or null compiler-error-context node
) *compiler-error-context
*))
60 (defvar *compiler-error-context
* nil
)
62 ;;; a hashtable mapping macro names to source context parsers. Each parser
63 ;;; function returns the source-context list for that form.
64 (defvar *source-context-methods
* (make-hash-table))
66 ;;; documentation originally from cmu-user.tex:
67 ;;; This macro defines how to extract an abbreviated source context from
68 ;;; the \var{name}d form when it appears in the compiler input.
69 ;;; \var{lambda-list} is a \code{defmacro} style lambda-list used to
70 ;;; parse the arguments. The \var{body} should return a list of
71 ;;; subforms that can be printed on about one line. There are
72 ;;; predefined methods for \code{defstruct}, \code{defmethod}, etc. If
73 ;;; no method is defined, then the first two subforms are returned.
74 ;;; Note that this facility implicitly determines the string name
75 ;;; associated with anonymous functions.
76 ;;; So even though SBCL itself only uses this macro within this file,
77 ;;; it's a reasonable thing to put in SB-EXT in case some dedicated
78 ;;; user wants to do some heavy tweaking to make SBCL give more
79 ;;; informative output about his code.
80 (defmacro define-source-context
(name lambda-list
&body body
)
81 "DEFINE-SOURCE-CONTEXT Name Lambda-List Form*
82 This macro defines how to extract an abbreviated source context from the
83 Named form when it appears in the compiler input. Lambda-List is a DEFMACRO
84 style lambda-list used to parse the arguments. The Body should return a
85 list of subforms suitable for a \"~{~S ~}\" format string."
86 (with-unique-names (whole)
87 `(setf (gethash ',name
*source-context-methods
*)
89 (destructuring-bind ,lambda-list
,whole
,@body
)))))
91 (define-source-context defstruct
(name-or-options &rest slots
)
92 (declare (ignore slots
))
93 `(defstruct ,(if (consp name-or-options
)
97 (define-source-context function
(thing)
98 (if (and (consp thing
) (eq (first thing
) 'lambda
) (consp (rest thing
)))
99 `(lambda ,(second thing
))
102 (define-source-context named-lambda
(name lambda-list
&body forms
)
103 (declare (ignore lambda-list forms
))
104 (if (and (consp name
) (eq 'eval
(first name
)))
106 `(named-lambda ,name
)))
108 (defvar *source-form-context-alist
* nil
)
110 ;;; Return the first two elements of FORM if FORM is a list. Take the
111 ;;; CAR of the second form if appropriate.
112 (defun source-form-context (form)
113 (flet ((get-it (form)
114 (cond ((atom form
) nil
)
115 ((>= (length form
) 2)
116 (let* ((context-fun-default
119 (list (first form
) (second form
))))
121 (gethash (first form
)
122 *source-context-methods
*
123 context-fun-default
)))
124 (declare (type function context-fun
))
125 (funcall context-fun
(rest form
))))
128 (get-it (or (cdr (assoc form
*source-form-context-alist
* :test
#'eq
))
131 ;;; Given a source path, return the original source form and a
132 ;;; description of the interesting aspects of the context in which it
133 ;;; appeared. The context is a list of lists, one sublist per context
134 ;;; form. The sublist is a list of some of the initial subforms of the
137 ;;; For now, we use the first two subforms of each interesting form. A
138 ;;; form is interesting if the first element is a symbol beginning
139 ;;; with "DEF" and it is not the source form. If there is no
140 ;;; DEF-mumble, then we use the outermost containing form. If the
141 ;;; second subform is a list, then in some cases we return the CAR of
142 ;;; that form rather than the whole form (i.e. don't show DEFSTRUCT
144 (defun find-original-source (path)
145 (declare (list path
))
146 (let* ((rpath (reverse (source-path-original-source path
)))
148 (root (find-source-root tlf
*source-info
*)))
151 (current (rest rpath
)))
153 (when (sb!int
:comma-p form
)
154 (setf form
(sb!int
:comma-expr form
)))
156 (aver (null current
))
158 (let ((head (first form
)))
160 (let ((name (symbol-name head
)))
161 (when (and (>= (length name
) 3) (string= name
"DEF" :end1
3))
162 (context (source-form-context form
))))))
163 (when (null current
) (return))
164 (setq form
(nth (pop current
) form
)))
167 (values form
(context)))
169 (let ((c (source-form-context root
)))
170 (values form
(if c
(list c
) nil
))))
172 (values '(unable to locate source
)
173 '((some strange place
)))))))))
175 ;;; Convert a source form to a string, suitably formatted for use in
176 ;;; compiler warnings.
177 (defun stringify-form (form &optional
(pretty t
))
178 (with-standard-io-syntax
179 (with-compiler-io-syntax
180 (let ((*print-pretty
* pretty
))
182 (format nil
"~<~@; ~S~:>" (list form
))
183 (prin1-to-string form
))))))
185 ;;; Return a COMPILER-ERROR-CONTEXT structure describing the current
186 ;;; error context, or NIL if we can't figure anything out. ARGS is a
187 ;;; list of things that are going to be printed out in the error
188 ;;; message, and can thus be blown off when they appear in the source
191 ;;; If OLD-CONTEXTS is passed in, and includes a context with the
192 ;;; same original source path as the new context would have, the old
193 ;;; context is reused instead, and a secondary value of T is returned.
194 (defun find-error-context (args &optional old-contexts
)
195 (let ((context *compiler-error-context
*))
196 (if (compiler-error-context-p context
)
198 (let* ((path (or (and (node-p context
) (node-source-path context
))
199 (and (boundp '*current-path
*) *current-path
*)))
201 (find (when path
(source-path-original-source path
))
202 (remove-if #'null old-contexts
)
204 :key
#'compiler-error-context-original-source-path
)))
207 (when (and *source-info
* path
)
208 (multiple-value-bind (form src-context
) (find-original-source path
)
209 (collect ((full nil cons
)
211 (let ((forms (source-path-forms path
))
213 (dolist (src (if (member (first forms
) args
)
216 (if (>= n
*enclosing-source-cutoff
*)
217 (short (stringify-form (if (consp src
)
221 (full (stringify-form src
)))
224 (let* ((tlf (source-path-tlf-number path
))
225 (file-info (source-info-file-info *source-info
*)))
227 (make-compiler-error-context
228 :enclosing-source
(short)
230 :original-source
(stringify-form form
)
232 :file-name
(file-info-name file-info
)
234 (nth-value 1 (find-source-root tlf
*source-info
*))
235 :original-source-path
(source-path-original-source path
)
237 (node-lexenv context
)
238 (if (boundp '*lexenv
*) *lexenv
* nil
)))
241 ;;;; printing error messages
243 ;;; We save the context information that we printed out most recently
244 ;;; so that we don't print it out redundantly.
246 ;;; The last COMPILER-ERROR-CONTEXT that we printed.
247 (defvar *last-error-context
* nil
)
248 (declaim (type (or compiler-error-context null
) *last-error-context
*))
250 ;;; The format string and args for the last error we printed.
251 (defvar *last-format-string
* nil
)
252 (defvar *last-format-args
* nil
)
253 (declaim (type (or string null
) *last-format-string
*))
254 (declaim (type list
*last-format-args
*))
256 ;;; The number of times that the last error message has been emitted,
257 ;;; so that we can compress duplicate error messages.
258 (defvar *last-message-count
* 0)
259 (declaim (type index
*last-message-count
*))
261 ;;; If the last message was given more than once, then print out an
262 ;;; indication of how many times it was repeated. We reset the message
263 ;;; count when we are done.
264 (defun note-message-repeats (stream &optional
(terpri t
))
265 (cond ((= *last-message-count
* 1)
268 ((> *last-message-count
* 1)
269 (format stream
"~&; [Last message occurs ~W times.]~2%"
270 *last-message-count
*)))
271 (setq *last-message-count
* 0))
273 ;;; Print out the message, with appropriate context if we can find it.
274 ;;; If the context is different from the context of the last message
275 ;;; we printed, then we print the context. If the original source is
276 ;;; different from the source we are working on, then we print the
277 ;;; current source in addition to the original source.
279 ;;; We suppress printing of messages identical to the previous, but
280 ;;; record the number of times that the message is repeated.
281 (defun print-compiler-message (stream format-string format-args
)
282 (with-compiler-io-syntax
283 (%print-compiler-message stream format-string format-args
)))
285 (defun %print-compiler-message
(stream format-string format-args
)
286 (declare (type simple-string format-string
))
287 (declare (type list format-args
))
288 (let ((context (find-error-context format-args
)))
290 (let ((file (compiler-error-context-file-name context
))
291 (in (compiler-error-context-context context
))
292 (form (compiler-error-context-original-source context
))
293 (enclosing (compiler-error-context-enclosing-source context
))
294 (source (compiler-error-context-source context
))
295 (last *last-error-context
*))
298 (equal file
(compiler-error-context-file-name last
)))
299 (when (pathnamep file
)
300 (note-message-repeats stream
)
302 (format stream
"~2&; file: ~A~%" (namestring file
))))
305 (equal in
(compiler-error-context-context last
)))
306 (note-message-repeats stream
)
308 (pprint-logical-block (stream nil
:per-line-prefix
"; ")
309 (format stream
"in:~{~<~% ~4:;~{ ~:S~}~>~^ =>~}" in
))
314 (compiler-error-context-original-source last
)))
315 (note-message-repeats stream
)
317 (pprint-logical-block (stream nil
:per-line-prefix
"; ")
323 (compiler-error-context-enclosing-source last
)))
325 (note-message-repeats stream
)
327 (format stream
"~&; --> ~{~<~%; --> ~1:;~A~> ~}~%" enclosing
)))
330 (equal source
(compiler-error-context-source last
)))
331 (setq *last-format-string
* nil
)
333 (note-message-repeats stream
)
336 (write-string "; ==>" stream
)
338 (pprint-logical-block (stream nil
:per-line-prefix
"; ")
339 (write-string src stream
)))))))
342 (note-message-repeats stream
)
343 (setq *last-format-string
* nil
)))
345 (setq *last-error-context
* context
))
347 ;; FIXME: this testing for effective equality of compiler messages
348 ;; is ugly, and really ought to be done at a higher level.
349 (unless (and (equal format-string
*last-format-string
*)
350 (tree-equal format-args
*last-format-args
*))
351 (note-message-repeats stream nil
)
352 (setq *last-format-string
* format-string
)
353 (setq *last-format-args
* format-args
)
355 (pprint-logical-block (stream nil
:per-line-prefix
"; ")
356 (format stream
"~&~?" format-string format-args
))
359 (incf *last-message-count
*)
362 (defun print-compiler-condition (condition)
363 (declare (type condition condition
))
364 (let (;; These different classes of conditions have different
365 ;; effects on the return codes of COMPILE-FILE, so it's nice
366 ;; for users to be able to pick them out by lexical search
367 ;; through the output.
368 (what (etypecase condition
369 (style-warning 'style-warning
)
371 ((or error compiler-error
) 'error
))))
372 (print-compiler-message
374 (format nil
"caught ~S:~%~~@< ~~@;~~A~~:>" what
)
375 (list (princ-to-string condition
)))))
377 ;;; The act of signalling one of these beasts must not cause WARNINGSP
378 ;;; (or FAILUREP) to be set from COMPILE or COMPILE-FILE, so we can't
379 ;;; inherit from WARNING or STYLE-WARNING.
381 ;;; FIXME: the handling of compiler-notes could be unified with
382 ;;; warnings and style-warnings (see the various handler functions
384 (define-condition compiler-note
(condition) ()
386 "Root of the hierarchy of conditions representing information discovered
387 by the compiler that the user might wish to know, but which does not merit
388 a STYLE-WARNING (or any more serious condition)."))
389 (define-condition simple-compiler-note
(simple-condition compiler-note
) ())
390 (define-condition code-deletion-note
(simple-compiler-note) ()
392 "A condition type signalled when the compiler deletes code that the user
393 has written, having proved that it is unreachable."))
395 (define-condition compiler-macro-application-missed-warning
397 ((count :initarg
:count
398 :reader compiler-macro-application-missed-warning-count
)
399 (function :initarg
:function
400 :reader compiler-macro-application-missed-warning-function
))
403 :function
(missing-arg))
405 (lambda (condition stream
)
406 ;; Grammar note - starting a sentence with a numeral is wrong.
408 "~@<~@(~D~) call~:P to ~
409 ~/sb!impl:print-symbol-with-prefix/ ~
410 ~2:*~[~;was~:;were~] compiled before a compiler-macro ~
411 was defined for it. A declaration of NOTINLINE at the ~
412 call site~:P will eliminate this warning, as will ~
413 defining the compiler-macro before its first potential ~
415 (compiler-macro-application-missed-warning-count condition
)
416 (compiler-macro-application-missed-warning-function condition
)))))
418 (macrolet ((with-condition ((condition datum args
) &body body
)
419 (with-unique-names (block)
422 (apply #'coerce-to-condition
,datum
423 'simple-compiler-note
'with-condition
428 (return-from ,block
(values))))
432 (defun compiler-notify (datum &rest args
)
433 (unless (if *compiler-error-context
*
434 (policy *compiler-error-context
* (= inhibit-warnings
3))
435 (policy *lexenv
* (= inhibit-warnings
3)))
436 (with-condition (condition datum args
)
437 (incf *compiler-note-count
*)
438 (print-compiler-message
440 (format nil
"note: ~~A")
441 (list (princ-to-string condition
)))))
444 ;; Issue a note when we might or might not be in the compiler.
445 (defun maybe-compiler-notify (datum &rest args
)
446 (if (boundp '*lexenv
*) ; if we're in the compiler
447 (apply #'compiler-notify datum args
)
448 (with-condition (condition datum args
)
449 (let ((stream *error-output
*))
450 (pprint-logical-block (stream nil
:per-line-prefix
";")
451 (format stream
" note: ~3I~_")
452 (pprint-logical-block (stream nil
)
453 (format stream
"~A" condition
)))
454 ;; (outside logical block, no per-line-prefix)
455 (fresh-line stream
))))))
457 ;;; The politically correct way to print out progress messages and
458 ;;; such like. We clear the current error context so that we know that
459 ;;; it needs to be reprinted, and we also FORCE-OUTPUT so that the
460 ;;; message gets seen right away.
461 (declaim (ftype (function (string &rest t
) (values)) compiler-mumble
))
462 (defun compiler-mumble (control &rest args
)
463 (let ((stream *standard-output
*))
464 (note-message-repeats stream
)
465 (setq *last-error-context
* nil
)
466 (apply #'format stream control args
)
467 (force-output stream
)
470 ;;; Return a string that somehow names the code in COMPONENT. We use
471 ;;; the source path for the bind node for an arbitrary entry point to
472 ;;; find the source context, then return that as a string.
473 (declaim (ftype (function (component) simple-string
) find-component-name
))
474 (defun find-component-name (component)
475 (let ((ep (first (block-succ (component-head component
)))))
476 (aver ep
) ; else no entry points??
477 (multiple-value-bind (form context
)
478 (find-original-source (node-source-path (block-start-node ep
)))
479 (declare (ignore form
))
480 (let ((*print-level
* 2)
481 (*print-pretty
* nil
))
482 ;; It's arbitrary how this name is stringified.
483 ;; Using ~A in lieu of ~S prevents "SB!" strings from getting in.
485 "~{~{~A~^ ~}~^ => ~}"
486 #+sb-xc-host
(list (list (caar context
)))
487 #-sb-xc-host context
)))))
489 ;;;; condition system interface
491 ;;; Keep track of how many times each kind of condition happens.
492 (defvar *compiler-error-count
*)
493 (defvar *compiler-warning-count
*)
494 (defvar *compiler-style-warning-count
*)
495 (defvar *compiler-note-count
*)
497 ;;; Keep track of whether any surrounding COMPILE or COMPILE-FILE call
498 ;;; should return WARNINGS-P or FAILURE-P.
500 (defvar *warnings-p
*)
502 ;;; condition handlers established by the compiler. We re-signal the
503 ;;; condition, then if it isn't handled, we increment our warning
504 ;;; counter and print the error message.
505 (defun compiler-error-handler (condition)
507 (incf *compiler-error-count
*)
510 (print-compiler-condition condition
)
511 (continue condition
))
512 (defun compiler-warning-handler (condition)
514 (incf *compiler-warning-count
*)
517 (print-compiler-condition condition
)
518 (muffle-warning condition
))
519 (defun compiler-style-warning-handler (condition)
521 (incf *compiler-style-warning-count
*)
522 (setf *warnings-p
* t
)
523 (print-compiler-condition condition
)
524 (muffle-warning condition
))
526 ;;;; undefined warnings
528 (defvar *undefined-warning-limit
* 3
529 "If non-null, then an upper limit on the number of unknown function or type
530 warnings that the compiler will print for any given name in a single
531 compilation. This prevents excessive amounts of output when the real
532 problem is a missing definition (as opposed to a typo in the use.)")
534 ;;; Make an entry in the *UNDEFINED-WARNINGS* describing a reference
535 ;;; to NAME of the specified KIND. If we have exceeded the warning
536 ;;; limit, then just increment the count, otherwise note the current
539 ;;; Undefined types are noted by a condition handler in
540 ;;; WITH-COMPILATION-UNIT, which can potentially be invoked outside
541 ;;; the compiler, hence the BOUNDP check.
542 (defun note-undefined-reference (name kind
)
544 ;; Whitelist functions are looked up prior to UNCROSS,
545 ;; so that we can distinguish CL:SOMEFUN from SB-XC:SOMEFUN.
546 (when (and (eq kind
:function
)
547 (gethash name sb-cold
::*undefined-fun-whitelist
*))
548 (return-from note-undefined-reference
(values)))
549 (setq name
(uncross name
))
551 ;; Check for boundness so we don't blow up if we're called
552 ;; when IR1 conversion isn't going on.
555 ;; FIXME: I'm pretty sure the INHIBIT-WARNINGS test below
556 ;; isn't a good idea; we should have INHIBIT-WARNINGS
557 ;; affect compiler notes, not STYLE-WARNINGs. And I'm not
558 ;; sure what the BOUNDP '*LEXENV* test above is for; it's
559 ;; likely a good idea, but it probably deserves an
560 ;; explanatory comment.
561 (policy *lexenv
* (= inhibit-warnings
3))
562 ;; KLUDGE: weird decoupling between here and where we're
563 ;; going to signal the condition. I don't think we can
564 ;; rewrite this using SIGNAL and RESTART-CASE (to take
565 ;; advantage of the (SATISFIES HANDLE-CONDITION-P)
566 ;; handler, because if that doesn't handle it the ordinary
567 ;; compiler handlers will trigger.
570 (:variable
(make-condition 'warning
))
571 ((:function
:type
) (make-condition 'style-warning
))))))
572 (let* ((found (dolist (warning *undefined-warnings
* nil
)
573 (when (and (equal (undefined-warning-name warning
) name
)
574 (eq (undefined-warning-kind warning
) kind
))
577 (make-undefined-warning :name name
:kind kind
))))
578 (unless found
(push res
*undefined-warnings
*))
579 (multiple-value-bind (context old
)
580 (find-error-context (list name
) (undefined-warning-warnings res
))
582 (when (or (not *undefined-warning-limit
*)
583 (< (undefined-warning-count res
) *undefined-warning-limit
*))
584 (push context
(undefined-warning-warnings res
)))
585 (incf (undefined-warning-count res
))))))
588 ;; The compiler tracks full calls that were emitted so that it is possible
589 ;; to detect a definition of a compiler-macro occuring after the first
590 ;; compile-time observed use of (vs. actual call of) that function name.
592 ;; The call count is not reset if the function gets redefined (where the
593 ;; macro could briefly be out-of-sync), but this choice is deliberate.
594 ;; We're not trying to find and report all possible ways that users can
595 ;; introduce semantic glitches, only trying to signal something that is
596 ;; otherwise not always obvious in a totally working built-from-scratch
597 ;; user system, absent any interactive changes.
599 ;; Note on implementation: originally I thought about doing something
600 ;; based on whether the name got an APPROXIMATE-FUN-TYPE and the :WHERE-FROM
601 ;; was :ASSUMED - which together imply that the function did not exist *and*
602 ;; that it was not a NOTINLINE call, however that proved to be fragile.
603 ;; The current approach is reliable, at a cost of ~3 words per function.
605 (defun warn-if-compiler-macro-dependency-problem (name)
606 (unless (sb!xc
:compiler-macro-function name
)
607 (let ((status (car (info :function
:emitted-full-calls name
)))) ; TODO use emitted-full-call-count?
608 (when (and (integerp status
) (oddp status
))
609 ;; Show the total number of calls, because otherwise the warning
610 ;; would be worded rather obliquely: "N calls were compiled
611 ;; not in the scope of a notinline declaration" which is, to me,
612 ;; worse than matter-of-factly stating that N calls were compiled.
613 ;; This is why I don't bother collecting both statistics.
614 ;; It's the tail wagging the dog: the message dictates what to track.
616 'compiler-macro-application-missed-warning
617 :count
(ash status -
2) :function name
)))))
619 ;; Inlining failure scenario 1 [at time of proclamation]:
620 ;; Full call to F is emitted not in the scope of a NOTINLINE, with no definition
621 ;; of F available, and then it's proclaimed INLINE. If F was defined already,
622 ;; it would have been used, unless the expansion limit was hit.
624 (defun warn-if-inline-failed/proclaim
(name new-inlinep
)
625 (when (eq new-inlinep
:inline
)
626 (let ((warning-count (emitted-full-call-count name
)))
627 (when (and warning-count
628 ;; Warn only if the the compiler did not have the expansion.
629 (not (info :function
:inline-expansion-designator name
))
630 ;; and if nothing was previously known about inline status
631 ;; so that repeated proclamations don't warn. NIL is a valid
632 ;; value for :inlinep in the globaldb so use the 2nd result.
633 (not (nth-value 1 (info :function
:inlinep name
))))
634 ;; This will be a STYLE-WARNING for the target, but a full warning
635 ;; for the host. There's no constraint to use _only_ STYLE-WARN
636 ;; to signal a (subtype of) STYLE-WARNING. But conversely we enforce
637 ;; that STYLE-WARN not signal things that aren't style-warnings.
639 'inlining-dependency-failure
641 "~@<Proclaiming ~/sb!impl:print-symbol-with-prefix/ to be INLINE, but ~D call~:P to it ~
642 ~:*~[~;was~:;were~] previously compiled. A declaration of NOTINLINE ~
643 at the call site~:P will eliminate this warning, as will proclaiming ~
644 and defining the function before its first potential use.~@:>"
645 :format-arguments
(list name warning-count
))))))
647 ;; Inlining failure scenario 2 [at time of call]:
648 ;; F is not defined, but either proclaimed INLINE and not declared
649 ;; locally notinline, or expressly declared locally inline.
650 ;; Warn about emitting a full call at that time.
652 ;; It could be friendlier to present this warning as one summary
653 ;; at the end of a compilation unit, but that is not as important as
654 ;; just getting the warning across.
655 ;; [The point of deferring a warning is that some future event can resolve it
656 ;; - like an undefined function becoming defined - but there's nothing
657 ;; that can resolve absence of a definition at a point when it was needed]
659 ;; Should we regard it as more serious if the inline-ness of the global
660 ;; function was lexically declared? Is "Inline F here" stronger than
661 ;; "It would generally be a good idea to inline F everywhere"?
663 ;; Don't be too put off by the above concerns though. It's not customary
664 ;; to write (DECLAIM INLINE) after the function, or so far separated from it
665 ;; that intervening callers know it to be proclaimed inline, and would have
666 ;; liked to have a definition, but didn't.
668 (defun warn-if-inline-failed/call
(name lexenv count-cell
)
669 ;; Do nothing if the inline expansion is known - it wasn't used
670 ;; because of the expansion limit, which is a different problem.
671 (unless (or (logtest 2 (car count-cell
)) ; warn at most once per name
672 (info :function
:inline-expansion-designator name
))
673 ;; This function is only called by PONDER-FULL-CALL when NAME
674 ;; is not lexically NOTINLINE, so therefore if it is globally INLINE,
675 ;; there was no local declaration to the contrary.
676 (when (or (eq (info :function
:inlinep name
) :inline
)
677 (let ((fun (let ((*lexenv
* lexenv
))
678 (lexenv-find name funs
:test
#'equal
))))
681 (eq (defined-fun-inlinep fun
) :inline
))))
682 ;; Set a bit saying that a warning about the call was generated,
683 ;; which suppresses the warning about either a later
684 ;; call or a later proclamation.
685 (setf (car count-cell
) (logior (car count-cell
) 2))
686 ;; While there could be a different style-warning for
687 ;; "You should put the DEFUN after the DECLAIM"
688 ;; if they appeared reversed, it's not ideal to warn as soon as that.
689 ;; It's only a problem if something failed to be inlined in account of it.
691 'inlining-dependency-failure
693 (if (info :function
:assumed-type name
)
694 "~@<Call to ~/sb!impl:print-symbol-with-prefix/ could not be inlined because no definition ~
695 for it was seen prior to its first use.~:@>"
696 ;; This message sort of implies that source form is the
697 ;; only reasonable representation in which an inline definition
698 ;; could have been saved, which isn't in general true - it could
699 ;; be saved as a parsed AST - but I don't really know how else to
700 ;; phrase this. And it happens to be true in SBCL, so it's not wrong.
701 "~@<Call to ~/sb!impl:print-symbol-with-prefix/ could not be inlined because its source code ~
702 was not saved. A global INLINE or SB-EXT:MAYBE-INLINE proclamation must be ~
703 in effect to save function definitions for inlining.~:@>")
704 :format-arguments
(list name
)))))