Changeset 8927


Ignore:
Timestamp:
Mar 28, 2008, 9:12:11 AM (11 years ago)
Author:
gb
Message:

REPORT-DEFERRED-WARNINGS: better handling of forward-referenced macros.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/sysutils.lisp

    r8912 r8927  
    553553      (let* ((file nil)
    554554             (init t))
    555         (dolist (w warnings)
    556           (let* ((args (compiler-warning-args w))
    557                  (wfname (car args))
    558                 (def nil))
    559             (when (if (typep w 'undefined-function-reference)
    560                     (not (setq def (or (fboundp wfname)
    561                                        (assq wfname defs)))))
    562               (multiple-value-setq (harsh any file) (signal-compiler-warning w init file harsh any))
    563               (setq init nil))
    564             ;; Check args in call to forward-referenenced function.
    565             (when (and (typep def 'function) (cdr args))
    566               (destructuring-bind (arglist spread-p)
    567                   (cdr args)
    568                 (multiple-value-bind (deftype reason)
    569                     (nx1-check-call-args def arglist spread-p)
    570                   (when deftype
    571                     (let* ((w2 (make-condition
    572                                 'invalid-arguments
    573                                 :file-name (compiler-warning-file-name w)
    574                                 :function-name (compiler-warning-function-name w)
    575                                 :warning-type deftype
    576                                 :args (list (car args) reason arglist spread-p))))
    577                       (setf (compiler-warning-stream-position w2)
    578                             (compiler-warning-stream-position w))
    579 
    580                     (multiple-value-setq (harsh any file)
    581                       (signal-compiler-warning w2 init file harsh any))
    582                     (setq init nil))))))))))
     555        (flet ((signal-warning (w)
     556                 (multiple-value-setq (harsh any file) (signal-compiler-warning w init file harsh any))
     557                 (setq init nil)))
     558          (dolist (w warnings)
     559            (let* ((args (compiler-warning-args w))
     560                   (wfname (car args))
     561                   (def nil))
     562              (when (if (typep w 'undefined-function-reference)
     563                      (not (setq def (or (assq wfname defs)
     564                                         (let* ((global (fboundp wfname)))
     565                                           (if (typep global 'function)
     566                                             global))))))
     567                (signal-warning w))
     568              ;; Check args in call to forward-referenenced function.
     569              (if (or (typep def 'function)
     570                      (and (consp def)
     571                           (consp (cdr def))
     572                           (cadr def)))
     573                (when (cdr args)
     574                  (destructuring-bind (arglist spread-p)
     575                      (cdr args)
     576                    (multiple-value-bind (deftype reason)
     577                        (nx1-check-call-args def arglist spread-p)
     578                      (when deftype
     579                        (let* ((w2 (make-condition
     580                                    'invalid-arguments
     581                                    :file-name (compiler-warning-file-name w)
     582                                    :function-name (compiler-warning-function-name w)
     583                                    :warning-type deftype
     584                                    :args (list (car args) reason arglist spread-p))))
     585                          (setf (compiler-warning-stream-position w2)
     586                                (compiler-warning-stream-position w))
     587                          (signal-warning w2))))))
     588                (if def
     589                  (let* ((w2 (make-condition
     590                              'macro-used-before-definition
     591                              :file-name (compiler-warning-file-name w)
     592                              :function-name (compiler-warning-function-name w)
     593                              :warning-type :macro-used-before-definition
     594                              :args (list (car args)))))
     595                    (setf (compiler-warning-stream-position w2)
     596                          (compiler-warning-stream-position w))
     597                    (signal-warning w2)))))))))
    583598    (values any harsh parent)))
    584599
Note: See TracChangeset for help on using the changeset viewer.