Changeset 8766


Ignore:
Timestamp:
Mar 13, 2008, 10:35:53 AM (11 years ago)
Author:
gb
Message:

Be less terse when reporting compiler-warnings, especially when they
involve mismatches between caller and callee arguments.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/nx-basic.lisp

    r8671 r8766  
    456456    (setq env (lexenv.parent-env env))))
    457457
     458(defun report-compile-time-argument-mismatch (condition stream)
     459  (destructuring-bind (callee reason args spread-p)
     460      (compiler-warning-args condition)
     461    (format stream "In the ~a ~s with arguments ~:s,~%  "
     462            (if spread-p "application of" "call to")
     463            callee
     464            args)
     465    (case (car reason)
     466      (:toomany
     467       (destructuring-bind (provided max)
     468           (cdr reason)
     469         (format stream "~d argument~p were provided, but at most ~d ~a accepted~&  by " provided provided max (if (eql max 1) "is" "are"))))
     470      (:toofew
     471       (destructuring-bind (provided min)
     472           (cdr reason)
     473         (format stream "~d argument~p were provided, but at least ~d ~a required~&  by " provided provided min (if (eql min 1) "is" "are") )))
     474      (:odd-keywords
     475       (let* ((tail (cadr reason)))
     476         (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)))
     477      (:unknown-keyword
     478       (destructuring-bind (badguy goodguys)
     479           (cdr reason)
     480         (format stream "the keyword argument ~s is not one of ~s, which are recognized~&  by " badguy goodguys))))
     481    (format stream
     482            (ecase (compiler-warning-warning-type condition)       
     483              (:global-mismatch "the current global definition of ~s")
     484              (:environment-mismatch "the definition of ~s visible in the current compilation unit")
     485              (:lexical-mismatch "the lexically visible definition of ~s"))
     486            callee)))
     487
    458488(defparameter *compiler-warning-formats*
    459489  '((:special . "Undeclared free variable ~S")
     
    465495    (:macro-used-before-definition . "Macro function ~S was used before it was defined")
    466496    (: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")
    469     (:type . "Type declarations violated in ~S")
     497    (:global-mismatch . report-compile-time-argument-mismatch)
     498    (:environment-mismatch . report-compile-time-argument-mismatch)
     499    (:lexical-mismatch . report-compile-time-argument-mismatch)   
     500    (:type . "Type declarations violated in ~S.")
    470501    (:type-conflict . "Conflicting type declarations for ~S")
    471502    (:special-fbinding . "Attempt to bind compiler special name: ~s. Result undefined")
    472     (:result-ignored . "Function result ignored in call to ~s.")))
     503    (:lambda . "Suspicious lambda-list: ~s")
     504    (:result-ignored . "Function result ignored in call to ~s")))
    473505
    474506(defun report-compiler-warning (condition stream)
    475507  (let* ((warning-type (compiler-warning-warning-type condition))
    476          (format-string (or (cdr (assq warning-type *compiler-warning-formats*))
    477                             (format nil "~S compiler warning with args ~~S"
    478                                     warning-type))))
    479     (apply #'format stream format-string (compiler-warning-args condition))
     508         (format-string (cdr (assq warning-type *compiler-warning-formats*))))
     509    (format stream "In ")
     510    (print-nested-name (reverse (compiler-warning-function-name condition)) stream)
     511    (format stream ": ")
     512    (if (typep format-string 'string)
     513      (apply #'format stream format-string (compiler-warning-args condition))
     514      (funcall format-string condition stream))
     515    (format stream ".")
    480516    (let ((nrefs (compiler-warning-nrefs condition)))
    481517      (when (and nrefs (neq nrefs 1))
    482         (format stream " (~D references)" nrefs)))
    483     (princ ", in " stream)
    484     (print-nested-name (reverse (compiler-warning-function-name condition)) stream)
    485     (princ "." stream)))
     518        (format stream " (~D references)" nrefs)))))
    486519
    487520(defun environment-structref-info (name env)
Note: See TracChangeset for help on using the changeset viewer.