Ignore:
Timestamp:
Feb 17, 2008, 4:37:21 PM (13 years ago)
Author:
gz
Message:

checkpoint work in progress, mainly some final cleanup, reorg, don't try to track atoms, keep track of source through transforms; reporting implementation in library;cover.lisp

File:
1 edited

Legend:

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

    r8477 r8505  
    29822982;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    29832983
    2984 (defstruct (source-note (:constructor %make-source-note))
     2984(defstruct (code-note (:constructor %make-code-note))
    29852985  ;; Code coverage state.  This MUST be the first slot - see nx2-code-coverage.
    29862986  code-coverage
    2987   ;; The actual form
     2987  ;; The actual form - useful during debugging, perhaps remove later.
    29882988  form
    2989   ;; The source location: file name, and start/end offsets within the file
    2990   file-name
    2991   start-pos
    2992   end-pos
    29932989  ;; For the outermost source form, a string (the text of the form).
    29942990  ;; For an inner source form, the source-note of the outer source form.
    2995   ;; For a generated form (no file info), source-note of original form.
     2991  ;; For a random code form (no file info, generated by macros or other source
     2992  ;; transform), code-note of parent form
    29962993  source
    29972994  ;; PC information generated by compiler.  For source notes not stored in
    2998   ;; an lfun, it could contain garbage if compilation of containing form
    2999   ;; was started and interrupted.
     2995  ;; an lfun, it could contain intermediate results during compilation.
    30002996  start-pc
    30012997  end-pc
     
    30032999  subform-notes)
    30043000
    3005 (defmethod make-load-form ((note source-note) &optional env)
     3001(defstruct (source-note (:include code-note)
     3002                        (:constructor %make-source-note))
     3003  ;; The source location: file name, and start/end offsets within the file
     3004  file-name
     3005  start-pos
     3006  end-pos)
     3007
     3008
     3009(defmethod make-load-form ((note code-note) &optional env)
    30063010  (make-load-form-saving-slots note :environment env))
    30073011
    3008 (defmethod print-object ((note source-note) stream)
     3012(defmethod print-object ((note code-note) stream)
    30093013  (print-unreadable-object (note stream :type t :identity t)
    3010     (let ((text (ignore-errors (source-note-text note))))
     3014    (let ((text (and (source-note-p note) (ignore-errors (source-note-text note)))))
    30113015      (when (null text)
    30123016        (setq text (ignore-errors
    30133017                    (let ((*print-circle* t))
    3014                       (format nil "~s" (source-note-form note))))))
     3018                      (format nil "~s" (code-note-form note))))))
    30153019      (when (> (length text) 20)
    30163020        (let ((end (position #\Newline text :start 20)))
     
    30193023                                    (subseq text 0 (min (or end (length text)) 120))
    30203024                                    "...")))))
    3021       (format stream "[~s] for ~s (~s subforms)"
    3022               (source-note-code-coverage note)
     3025      (format stream "[~s]~:[~;for ~:*~a~] (~s subforms)"
     3026              (code-note-code-coverage note)
    30233027              text
    3024               (length (source-note-subform-notes note))))))
     3028              (length (code-note-subform-notes note))))))
    30253029
    30263030(defun source-note-length (note)
     
    30343038(defun source-note-string-and-offset (note)
    30353039  "Returns a string and offset where the text of note's form starts"
    3036   (let ((source (source-note-source note)))
    3037     (cond ((stringp source)
    3038            (assert (<= (source-note-length note) (length source)))
    3039            (values source 0))
    3040           ((source-note-p source)
    3041            (let ((start (source-note-start-pos note))
    3042                  (parent-start (source-note-start-pos source)))
    3043            (assert (<= parent-start start
    3044                        (source-note-end-pos note) (source-note-end-pos source)))
    3045            (multiple-value-bind (parent-string parent-offset)
    3046                                 (source-note-string-and-offset source)
    3047              (values parent-string (+ parent-offset (- start parent-start)))))))))
     3040  (when (source-note-p note)
     3041    (let ((source (source-note-source note)))
     3042      (cond ((stringp source)
     3043             (assert (<= (source-note-length note) (length source)))
     3044             (values source 0))
     3045            ((source-note-p source)
     3046             (let ((start (source-note-start-pos note))
     3047                   (parent-start (source-note-start-pos source)))
     3048               (assert (<= parent-start start
     3049                           (source-note-end-pos note) (source-note-end-pos source)))
     3050               (multiple-value-bind (parent-string parent-offset)
     3051                                    (source-note-string-and-offset source)
     3052                 (values parent-string (+ parent-offset (- start parent-start))))))))))
    30483053
    30493054(defvar *recording-source-streams* ())
     
    30793084                                              :end-pos (+ (or start-offset 0) (file-position stream)))))))))
    30803085
    3081 (defun make-source-note (&key form stream start-pos end-pos subform-notes source)
    3082   (assert (or (null source) (null (or stream start-pos end-pos subform-notes))))
    3083   (if stream
    3084     ;; source note for form read from a stream
    3085     (let ((recording (assoc stream *recording-source-streams*)))
    3086       (assert (null source))
    3087       (when (and recording (not *read-suppress*))
    3088         (destructuring-bind (map file-name stream-offset) (cdr recording)
    3089           (let* ((prev (gethash form map))
    3090                  (note (%make-source-note :form form
    3091                                           :file-name file-name
    3092                                           :start-pos (+ stream-offset start-pos)
    3093                                           :end-pos (+ stream-offset end-pos))))
    3094             (setf (gethash form map)
    3095                   (cond ((null prev) note)
    3096                         ((consp prev) (cons note prev))
    3097                         (t (list note prev))))
    3098             (loop for sub in subform-notes as subnote = (require-type sub 'source-note)
    3099               do (when (source-note-source subnote) (error "Subnote ~s already owned?" subnote))
    3100               do (setf (source-note-source subnote) note))
    3101             note))))
    3102     ;; Else note for a form generated by macroexpansion
    3103     (let* ((source (and source (require-type source 'source-note)))
    3104            (note (%make-source-note
    3105                   ;; Unfortunately, recording the macroexpanded form is problematic, since they
    3106                   ;; can have references to non-dumpable forms, see e.g. loop.
    3107                   ;; Could print it with *print-string-length* bound to 80 or so, and record
    3108                   ;; the string instead.
    3109                   ;; :form form
    3110                   :source source)))
    3111       ;; For debugging
    3112       #+gz (setf (source-note-form note)
    3113                  (with-output-to-string (s) (let ((*print-string-length* 80)) (prin1 form s))))
    3114       note)))
     3086(defun make-source-note (&key form stream start-pos end-pos subform-notes)
     3087  (let ((recording (assoc stream *recording-source-streams*)))
     3088    (when (and recording (not *read-suppress*))
     3089      (destructuring-bind (map file-name stream-offset) (cdr recording)
     3090        (let* ((prev (gethash form map))
     3091               (note (%make-source-note :form form
     3092                                        :file-name file-name
     3093                                        :start-pos (+ stream-offset start-pos)
     3094                                        :end-pos (+ stream-offset end-pos))))
     3095          (setf (gethash form map)
     3096                (cond ((null prev) note)
     3097                      ((consp prev) (cons note prev))
     3098                      (t (list note prev))))
     3099          (loop for sub in subform-notes as subnote = (require-type sub 'source-note)
     3100            do (when (source-note-source subnote) (error "Subnote ~s already owned?" subnote))
     3101            do (setf (source-note-source subnote) note))
     3102          note)))))
     3103
     3104(defun make-code-note (&key form source)
     3105  (declare (ignorable form))
     3106  ;; A note for a form generated by macroexpansion
     3107  (let* ((source (and source (require-type source 'code-note)))
     3108         (note (%make-code-note
     3109                ;; Unfortunately, recording the macroexpanded form is problematic, since they
     3110                ;; can have references to non-dumpable forms, see e.g. loop.
     3111                ;; Could print it and record the string instead.
     3112                ;; :form form
     3113                :source source)))
     3114    #+debug
     3115    (when form
     3116      (setf (code-note-form note)
     3117            (with-output-to-string (s) (let ((*print-string-length* 80)) (prin1 form s)))))
     3118    note))
    31153119
    31163120; end
Note: See TracChangeset for help on using the changeset viewer.