Ignore:
Timestamp:
Mar 24, 2008, 11:12:46 PM (13 years ago)
Author:
mb
Message:

Fix handling of *record-source-file* and *save-source-locations*.

We now respect *r-s-f* and *s-s-l* so that only the right information
is stored in the fasl and spurious source-notes are no longer created.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/source-files.lisp

    r8878 r8882  
    2525(in-package "CCL")
    2626
    27  ;; Attempting to record-source while defining the source recording framework is a bad idea. When
    28  ;; we're done loading this file we re-enable source recording.
    29 (setf *record-source-file* nil)
     27(defparameter *old-record-source-file*
     28  (prog1
     29      *record-source-file*
     30    ;; this needs to be in the value of parameter so that it is evaluated before the call to
     31    ;; record-source-file in the execution of the defparameter itself.
     32    (setf *record-source-file* nil))
     33  "While compiling this file we don't want *record-source-file*, this stores the value of
     34  *record-source-file* on entry to this file.")
    3035
    3136;;;; * Mapping names of things to the text which defines the thing.
     
    126131;;;; ** Storing definitions for a name
    127132
    128 (defun record-source-file (name definition-type-name
    129                            &key (file-name *loading-file-source-file*)
    130                                 (toplevel-source-note *loading-toplevel-location*))
     133(defun record-source-file (name definition-type-name &optional (toplevel-source-note *loading-toplevel-location*))
    131134  "Records where the thing of type DEFINITION-TYPE-NAME named NAME is stored.
    132135
    133136NAME is a definition-name; DEFINITION-TYPE-NAME is a symbol naming a definition-type-name (see
    134 definition-type-instance) or a definition-type object; FILE-NAME is the file where this thing is
    135 stored and TOPLEVEL-SOURCE-NOTE is the source-note. If TOPLEVEL-SOURCE-NOTE is non-NIL we use it and
    136 ignore the FILE-NAME argument."
    137   (when (not *record-source-file*)
    138     (return-from record-source-file nil))
    139   (when (and (null file-name)
    140              (null toplevel-source-note))
    141     ;; no file-name, no toplevel-location, what is it we want to record?
    142     (return-from record-source-file nil))
    143   ;; bootstrapping
    144   (unless (member definition-type-name *definition-types* :key #'definition-type-name)
    145     (warn "No known definition-type named ~S." definition-type-name)
    146     (return-from record-source-file nil))
    147   (let* ((definition-type (definition-type-instance definition-type-name))
    148          (source-note (or toplevel-source-note ;; mb 2007-03-23: do we really want to ignore file-name?
    149                           (%make-source-note :file-name (truename file-name))))
    150          (existing-note (definition-source definition-type name)))
    151     (when (and *warn-if-redefine*
    152                (not (equal (full-pathname (source-note-file-name existing-note))
    153                            (full-pathname (source-note-file-name source-note)))))
    154       ;; have an existing definition in another file. warn.
    155       (warn "The ~S ~S, which was defined in ~S, is being redefined in ~S."
    156             definition-type-name (effective-name definition-type name)
    157             (source-note-file-name existing-note)
    158             (source-note-file-name source-note)))
    159     (setf (definition-source definition-type name) source-note)
    160     (list definition-type-name (effective-name definition-type name) source-note)))
     137definition-type-instance) or a definition-type object; TOPLEVEL-SOURCE-NOTE is the source-note."
     138  (when (and *record-source-file* toplevel-source-note)
     139    (let* ((definition-type (definition-type-instance definition-type-name))
     140           (source-note  toplevel-source-note)
     141           (existing-note (definition-source definition-type name)))
     142      (when (and *warn-if-redefine*
     143                 (not (equal (full-pathname (source-note-file-name existing-note))
     144                             (full-pathname (source-note-file-name source-note)))))
     145        ;; have an existing definition in another file. warn.
     146        (warn "The ~S ~S, which was defined in ~S, is being redefined in ~S."
     147              definition-type-name (effective-name definition-type name)
     148              (source-note-file-name existing-note)
     149              (source-note-file-name source-note)))
     150      (setf (definition-source definition-type name) source-note)
     151      (list definition-type-name (effective-name definition-type name) source-note))))
    161152
    162153;;;; * Framework for definig definition-types
     
    477468;;;; * Done loading the r-s-f stuff. Do some housekeeping.
    478469
    479 (setf *record-source-file* t)
     470(setf *record-source-file* *old-record-source-file*)
    480471
    481472;; Now that the real r-s-f framework is ready we can go back and fixup the early stuff. This early
     
    491482(loop
    492483  while *early-source-files*
    493   for (type name file-name source-note) = (pop *early-source-files*)
    494   do (record-source-file name type
    495                          :file-name file-name
    496                          :toplevel-source-note source-note))
     484  for (type name source-note) = (pop *early-source-files*)
     485  do (record-source-file name type source-note))
Note: See TracChangeset for help on using the changeset viewer.