Ignore:
Timestamp:
Oct 15, 2008, 8:48:03 PM (13 years ago)
Author:
gz
Message:

Another round of changes from the trunk, mostly just mods in internal mechanisms in support of various recent ports.

File:
1 edited

Legend:

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

    r11074 r11101  
    29902990
    29912991
    2992 
    29932992;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    29942993
     
    30973096(defvar *recording-source-streams* ())
    30983097
     3098(defun make-source-note (&key form stream start-pos end-pos subform-notes)
     3099  (let ((recording (assq stream *recording-source-streams*)))
     3100    (when (and recording (not *read-suppress*))
     3101      (destructuring-bind (map file-name stream-offset) (cdr recording)
     3102        (let* ((prev (gethash form map))
     3103               (note (%make-source-note :file-name file-name
     3104                                        :start-pos (+ stream-offset start-pos)
     3105                                        :end-pos (+ stream-offset end-pos))))
     3106          (setf (gethash form map)
     3107                (cond ((null prev) note)
     3108                      ((consp prev) (cons note prev))
     3109                      (t (list note prev))))
     3110          (loop for sub in subform-notes as subnote = (require-type sub 'source-note)
     3111            do (when (source-note-source subnote) (error "Subnote ~s already owned?" subnote))
     3112            do (setf (source-note-source subnote) note))
     3113          note)))))
     3114
     3115(defun make-code-note (&key form source)
     3116  (declare (ignorable form))
     3117  ;; A note for a form generated by macroexpansion
     3118  (let* ((note (%make-code-note
     3119                :source (and source
     3120                             (if (source-note-p source)
     3121                                 source
     3122                                 (code-note-source source))))))
     3123    #+debug-code-notes
     3124    (when form
     3125      ;; Unfortunately, recording the macroexpanded form is problematic, since they
     3126      ;; can have references to non-dumpable forms, see e.g. loop.
     3127      (setf (code-note-form note)
     3128            (with-output-to-string (s) (let ((*print-circle* t)) (prin1 form s)))))
     3129    note))
     3130
     3131
    30993132(defun read-recording-source (stream &key eofval file-name start-offset map save-source-text)
    31003133  "Read a top-level form, perhaps recording source locations.
    31013134If MAP is NIL, just reads a form as if by READ.
    3102 If MAP is non-NIL, returns a second value of a source-note describing the form.
     3135If MAP is non-NIL, returns a second value of a source-note object describing the form.
    31033136In addition, if MAP is a hash table, it gets filled with source-note's for all
    31043137non-atomic nested subforms."
     
    31313164               (setf (source-note-source source-note) (%fast-compact text)))))
    31323165         (values form source-note))))
    3133     ((eql t)
     3166    (T
    31343167     (let* ((start (file-position stream))
    31353168            (form (read-internal stream nil eofval nil)))
     
    31503183            text))))))
    31513184
    3152 (defun make-source-note (&key form stream start-pos end-pos subform-notes)
    3153   (let ((recording (assq stream *recording-source-streams*)))
    3154     (when (and recording (not *read-suppress*))
    3155       (destructuring-bind (map file-name stream-offset) (cdr recording)
    3156         (let* ((prev (gethash form map))
    3157                (note (%make-source-note :file-name file-name
    3158                                         :start-pos (+ stream-offset start-pos)
    3159                                         :end-pos (+ stream-offset end-pos))))
    3160           (setf (gethash form map)
    3161                 (cond ((null prev) note)
    3162                       ((consp prev) (cons note prev))
    3163                       (t (list note prev))))
    3164           (loop for sub in subform-notes as subnote = (require-type sub 'source-note)
    3165             do (when (source-note-source subnote) (error "Subnote ~s already owned?" subnote))
    3166             do (setf (source-note-source subnote) note))
    3167           note)))))
    3168 
    3169 (defun make-code-note (&key form source)
    3170   (declare (ignorable form))
    3171   ;; A note for a form generated by macroexpansion
    3172   (let* ((note (%make-code-note
    3173                 :source (and source
    3174                              (if (source-note-p source)
    3175                                  source
    3176                                  (code-note-source source))))))
    3177     #+debug-code-notes
    3178     (when form
    3179       ;; Unfortunately, recording the macroexpanded form is problematic, since they
    3180       ;; can have references to non-dumpable forms, see e.g. loop.
    3181       (setf (code-note-form note)
    3182             (with-output-to-string (s) (let ((*print-circle* t)) (prin1 form s)))))
    3183     note))
    3184 
    31853185;; This might be called explicitly by macros that do more complicated transforms
    31863186(defun note-source-transformation (original new)
Note: See TracChangeset for help on using the changeset viewer.