Changeset 11598


Ignore:
Timestamp:
Jan 8, 2009, 1:29:11 AM (11 years ago)
Author:
gz
Message:

Defer merging file deferred-warnings/defs into parent compilation unit as long as possible, so can throw them away in case of an interactive recompile.

Location:
branches/working-0711/ccl
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/sysutils.lisp

    r11502 r11598  
    533533      (report-deferred-warnings))))
    534534
    535 (defun %defer-warnings (override &optional flags &aux (parent *outstanding-deferred-warnings*))
     535(defun %defer-warnings (override &aux (parent *outstanding-deferred-warnings*))
     536  (when parent
     537    (ensure-merged-deferred-warnings parent))
    536538  (%istruct 'deferred-warnings
    537539            (unless override parent)
    538540            nil
    539541            (make-hash-table :test #'eq)
    540             flags))
    541 
    542 (defun report-deferred-warnings ()
    543   (let* ((current *outstanding-deferred-warnings*)
     542            nil))
     543
     544(defun ensure-merged-deferred-warnings (parent &aux (last (deferred-warnings.last-file parent)))
     545  (when last
     546    (setf (deferred-warnings.last-file parent) nil)
     547    (let* ((child (car last)) ;; last = (deferred-warnings . file)
     548           (warnings (deferred-warnings.warnings child))
     549           (defs (deferred-warnings.defs child))
     550           (parent-defs (deferred-warnings.defs parent))
     551           (parent-warnings (deferred-warnings.warnings parent)))
     552      (maphash (lambda (key val) (setf (gethash key parent-defs) val)) defs)
     553      (setf (deferred-warnings.warnings parent) (append warnings parent-warnings))))
     554  parent)
     555
     556
     557(defun report-deferred-warnings (&optional (file nil))
     558  (let* ((current (ensure-merged-deferred-warnings *outstanding-deferred-warnings*))
    544559         (parent (deferred-warnings.parent current))
    545560         (warnings (deferred-warnings.warnings current))
     
    548563         (harsh nil))
    549564    (if parent
    550       (let ((parent-defs (deferred-warnings.defs parent))
    551             (parent-warnings (deferred-warnings.warnings parent)))
    552         (maphash (lambda (key val) (setf (gethash key parent-defs) val)) defs)
    553         (setf (deferred-warnings.warnings parent) (append warnings parent-warnings)
    554               parent t))
     565      (progn
     566        (setf (deferred-warnings.last-file parent) (cons current file))
     567        (unless file ;; don't defer merge for non-file units.
     568          (ensure-merged-deferred-warnings parent))
     569        (setq parent t))
    555570      (let* ((file nil)
    556571             (init t))
  • branches/working-0711/ccl/lib/nfcomp.lisp

    r11502 r11598  
    4444(require "X8664-ARCH")
    4545) ;eval-when (:compile-toplevel :execute)
     46
     47;; Temp, for loading into a lisp that doesn't have the report-deferred-warnings change
     48;; in level-1 yet.
     49#-BOOTSTRAPPED (when (eql 0 (ldb $lfbits-numopt (lfun-bits #'report-deferred-warnings)))
     50                 (%fhave 'report-deferred-warnings (lambda (&optional x) x nil)))
     51
    4652
    4753;File compiler options.  Not all of these need to be exported/documented, but
     
    230236           (*fcomp-external-format* external-format)
    231237           (forms nil))
     238      (let ((current *outstanding-deferred-warnings*) last)
     239        (when (and current
     240                   (setq last (deferred-warnings.last-file current))
     241                   (equalp *compile-file-pathname* (cdr last)))
     242          ;; Discard previous deferred warnings when recompiling exactly the same file again,
     243          ;; since most likely this is due to an interactive "retry compilation" request and
     244          ;; we want to avoid duplicate warnings.
     245          (setf (deferred-warnings.last-file current) nil)))
     246
    232247      (let* ((*outstanding-deferred-warnings* (%defer-warnings nil)))
    233248        (rplacd (defenv.type defenv) *outstanding-deferred-warnings*)
     
    239254              (append *fasl-deferred-warnings* (deferred-warnings.warnings *outstanding-deferred-warnings*)))
    240255        (when *compile-verbose* (fresh-line))
    241         (multiple-value-bind (any harsh) (report-deferred-warnings)
     256        (multiple-value-bind (any harsh) (report-deferred-warnings *compile-file-pathname*)
    242257          (setq *fasl-warnings-signalled-p* (or *fasl-warnings-signalled-p* any)
    243258                *fasl-non-style-warnings-signalled-p* (if (eq harsh :very) :very
  • branches/working-0711/ccl/library/lispequ.lisp

    r11412 r11598  
    15721572  deferred-warnings.warnings
    15731573  deferred-warnings.defs
    1574   deferred-warnings.flags ; might use to distinguish interactive case/compile-file
     1574  deferred-warnings.last-file
    15751575)
    15761576
Note: See TracChangeset for help on using the changeset viewer.