Changeset 8754


Ignore:
Timestamp:
Mar 13, 2008, 6:15:54 AM (12 years ago)
Author:
gb
Message:

Slightly richer scheme for reporting compiler warnings (especially
those involving number-of-argument checking.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx-basic.lisp

    r8462 r8754  
    441441    warnings))
    442442
    443 ; This is called by, e.g., note-function-info & so can't be -too- funky ...
    444 ;;; don't call proclaimed-inline-p or proclaimed-notinline-p with alphatized crap
     443;;; This is called by, e.g., note-function-info & so can't be -too- funky ...
     444;;; don't call proclaimed-inline-p or proclaimed-notinline-p with
     445;;; alphatized crap
    445446
    446447(defun nx-declared-inline-p (sym env)
     
    456457    (setq env (lexenv.parent-env env))))
    457458
     459(defun report-compile-time-argument-mismatch (condition stream)
     460  (destructuring-bind (callee reason args spread-p)
     461      (compiler-warning-args condition)
     462    (format stream "In the ~a ~s with arguments ~:s,~%  "
     463            (if spread-p "application of" "call to")
     464            callee
     465            args)
     466    (case (car reason)
     467      (:toomany
     468       (destructuring-bind (provided max)
     469           (cdr reason)
     470         (format stream "~d argument~p were provided, but at most ~d ~a accepted~&  by " provided provided max (if (eql max 1) "is" "are"))))
     471      (:toofew
     472       (destructuring-bind (provided min)
     473           (cdr reason)
     474         (format stream "~d argument~p were provided, but at least ~d ~a required~&  by " provided provided min (if (eql min 1) "is" "are") )))
     475      (:odd-keywords
     476       (let* ((tail (cadr reason)))
     477         (format stream "the variable portion of the argument list ~s contains an odd number~&  of arguments and so can't be used to initialize keyword parameters~&  for " tail)))
     478      (:unknown-keyword
     479       (destructuring-bind (badguy goodguys)
     480           (cdr reason)
     481         (format stream "the keyword argument ~s is not one of ~s, which are recognized~&  by " badguy goodguys))))
     482    (format stream
     483            (ecase (compiler-warning-warning-type condition)       
     484              (:global-mismatch "the current global definition of ~s.")
     485              (:environment-mismatch "the definition of ~s visible in the current compilation unit.")
     486              (:lexical-mismatch "the lexically visible definition of ~s"))
     487            callee)))
     488
     489
    458490(defparameter *compiler-warning-formats*
    459491  '((:special . "Undeclared free variable ~S")
     
    465497    (:macro-used-before-definition . "Macro function ~S was used before it was defined")
    466498    (:unsettable . "Shouldn't assign to variable ~S")
    467     (:global-mismatch . "Function call arguments don't match current definition of ~S")
    468     (:environment-mismatch . "Function call arguments don't match visible definition of ~S")
     499    (:global-mismatch . report-compile-time-argument-mismatch)
     500    (:environment-mismatch . report-compile-time-argument-mismatch)
     501    (:lexical-mismatch . report-compile-time-argument-mismatch)   
    469502    (:type . "Type declarations violated in ~S")
    470503    (:type-conflict . "Conflicting type declarations for ~S")
    471     (:special-fbinding . "Attempt to bind compiler special name: ~s. Result undefined")))
     504    (:special-fbinding . "Attempt to bind compiler special name: ~s. Result undefined")
     505    (:lambda . "Suspicious lambda-list: ~s")
     506    (:result-ignored . "Function result ignored in call to ~s.")))
    472507
    473508(defun report-compiler-warning (condition stream)
    474509  (let* ((warning-type (compiler-warning-warning-type condition))
    475          (format-string (or (cdr (assq warning-type *compiler-warning-formats*))
    476                             (format nil "~S compiler warning with args ~~S"
    477                                     warning-type))))
    478     (apply #'format stream format-string (compiler-warning-args condition))
     510         (format-string (cdr (assq warning-type *compiler-warning-formats*))))
     511    (format stream "In ")
     512    (print-nested-name (reverse (compiler-warning-function-name condition)) stream)
     513    (format stream ": ")
     514    (if (typep format-string 'string)
     515      (apply #'format stream format-string (compiler-warning-args condition))
     516      (funcall format-string condition stream))
    479517    (let ((nrefs (compiler-warning-nrefs condition)))
    480518      (when (and nrefs (neq nrefs 1))
    481         (format stream " (~D references)" nrefs)))
    482     (princ ", in " stream)
    483     (print-nested-name (reverse (compiler-warning-function-name condition)) stream)))
     519        (format stream " (~D references)" nrefs)))))
    484520
    485521(defun environment-structref-info (name env)
Note: See TracChangeset for help on using the changeset viewer.