/[slime]/slime/swank-source-path-parser.lisp
ViewVC logotype

Contents of /slime/swank-source-path-parser.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (show annotations)
Tue May 19 10:51:38 2009 UTC (4 years, 10 months ago) by nsiivola
Branch: MAIN
CVS Tags: SLIME-2-3, SLIME-2-2, byte-stream, FAIRLY-STABLE
Changes since 1.21: +1 -1 lines
guard agains source path mapping hitting reader errors

  Example: compile (defun foo () (bar)) in a file. Edit
  the definition to look like (defun foo () (nopackage:bar)),
  close the file and hit M-. foo. Prior to this an error shows
  in the minibuffer, and nothing else happens.
1 ;;;; Source-paths
2
3 ;;; CMUCL/SBCL use a data structure called "source-path" to locate
4 ;;; subforms. The compiler assigns a source-path to each form in a
5 ;;; compilation unit. Compiler notes usually contain the source-path
6 ;;; of the error location.
7 ;;;
8 ;;; Compiled code objects don't contain source paths, only the
9 ;;; "toplevel-form-number" and the (sub-) "form-number". To get from
10 ;;; the form-number to the source-path we need the entire toplevel-form
11 ;;; (i.e. we have to read the source code). CMUCL has already some
12 ;;; utilities to do this translation, but we use some extended
13 ;;; versions, because we need more exact position info. Apparently
14 ;;; Hemlock is happy with the position of the toplevel-form; we also
15 ;;; need the position of subforms.
16 ;;;
17 ;;; We use a special readtable to get the positions of the subforms.
18 ;;; The readtable stores the start and end position for each subform in
19 ;;; hashtable for later retrieval.
20 ;;;
21 ;;; This code has been placed in the Public Domain. All warranties
22 ;;; are disclaimed.
23
24 ;;; Taken from swank-cmucl.lisp, by Helmut Eller
25
26 (in-package :swank-backend)
27
28 ;; Some test to ensure the required conformance
29 (let ((rt (copy-readtable nil)))
30 (assert (or (not (get-macro-character #\space rt))
31 (nth-value 1 (get-macro-character #\space rt))))
32 (assert (not (get-macro-character #\\ rt))))
33
34 (defun make-sharpdot-reader (orig-sharpdot-reader)
35 #'(lambda (s c n)
36 ;; We want things like M-. to work regardless of any #.-fu in
37 ;; the source file that is to be visited. (For instance, when a
38 ;; file contains #. forms referencing constants that do not
39 ;; currently exist in the image.)
40 (ignore-errors (funcall orig-sharpdot-reader s c n))))
41
42 (defun make-source-recorder (fn source-map)
43 "Return a macro character function that does the same as FN, but
44 additionally stores the result together with the stream positions
45 before and after of calling FN in the hashtable SOURCE-MAP."
46 (declare (type function fn))
47 (lambda (stream char)
48 (let ((start (1- (file-position stream)))
49 (values (multiple-value-list (funcall fn stream char)))
50 (end (file-position stream)))
51 ;(format t "[~D \"~{~A~^, ~}\" ~D ~D ~S]~%" start values end (char-code char) char)
52 (unless (null values)
53 (push (cons start end) (gethash (car values) source-map)))
54 (values-list values))))
55
56 (defun make-source-recording-readtable (readtable source-map)
57 "Return a source position recording copy of READTABLE.
58 The source locations are stored in SOURCE-MAP."
59 (flet ((install-special-sharpdot-reader (*readtable*)
60 (let ((old-reader (ignore-errors
61 (get-dispatch-macro-character #\# #\.))))
62 (when old-reader
63 (set-dispatch-macro-character #\# #\.
64 (make-sharpdot-reader old-reader))))))
65 (let* ((tab (copy-readtable readtable))
66 (*readtable* tab))
67 (dotimes (code 128)
68 (let ((char (code-char code)))
69 (multiple-value-bind (fn term) (get-macro-character char tab)
70 (when fn
71 (set-macro-character char (make-source-recorder fn source-map)
72 term tab)))))
73 (install-special-sharpdot-reader tab)
74 tab)))
75
76 (defun read-and-record-source-map (stream)
77 "Read the next object from STREAM.
78 Return the object together with a hashtable that maps
79 subexpressions of the object to stream positions."
80 (let* ((source-map (make-hash-table :test #'eq))
81 (*readtable* (make-source-recording-readtable *readtable* source-map))
82 (start (file-position stream))
83 (form (ignore-errors (read stream)))
84 (end (file-position stream)))
85 ;; ensure that at least FORM is in the source-map
86 (unless (gethash form source-map)
87 (push (cons start end) (gethash form source-map)))
88 (values form source-map)))
89
90 (defun skip-toplevel-forms (n stream)
91 (let ((*read-suppress* t))
92 (dotimes (i n)
93 (read stream))))
94
95 (defun read-source-form (n stream)
96 "Read the Nth toplevel form number with source location recording.
97 Return the form and the source-map."
98 (skip-toplevel-forms n stream)
99 (let ((*read-suppress* nil))
100 (read-and-record-source-map stream)))
101
102 (defun source-path-stream-position (path stream)
103 "Search the source-path PATH in STREAM and return its position."
104 (check-source-path path)
105 (destructuring-bind (tlf-number . path) path
106 (multiple-value-bind (form source-map) (read-source-form tlf-number stream)
107 (source-path-source-position (cons 0 path) form source-map))))
108
109 (defun check-source-path (path)
110 (unless (and (consp path)
111 (every #'integerp path))
112 (error "The source-path ~S is not valid." path)))
113
114 (defun source-path-string-position (path string)
115 (with-input-from-string (s string)
116 (source-path-stream-position path s)))
117
118 (defun source-path-file-position (path filename)
119 ;; We go this long way round, and don't directly operate on the file
120 ;; stream because FILE-POSITION (used above) is not totally savy even
121 ;; on file character streams; on SBCL, FILE-POSITION returns the binary
122 ;; offset, and not the character offset---screwing up on Unicode.
123 (let ((toplevel-number (first path))
124 (buffer))
125 (with-open-file (file filename)
126 (skip-toplevel-forms (1+ toplevel-number) file)
127 (let ((endpos (file-position file)))
128 (setq buffer (make-array (list endpos) :element-type 'character
129 :initial-element #\Space))
130 (assert (file-position file 0))
131 (read-sequence buffer file :end endpos)))
132 (source-path-string-position path buffer)))
133
134 (defun source-path-source-position (path form source-map)
135 "Return the start position of PATH from FORM and SOURCE-MAP. All
136 subforms along the path are considered and the start and end position
137 of the deepest (i.e. smallest) possible form is returned."
138 ;; compute all subforms along path
139 (let ((forms (loop for n in path
140 for f = form then (nth n f)
141 collect f)))
142 ;; select the first subform present in source-map
143 (loop for form in (reverse forms)
144 for positions = (gethash form source-map)
145 until (and positions (null (cdr positions)))
146 finally (destructuring-bind ((start . end)) positions
147 (return (values start end))))))
148

  ViewVC Help
Powered by ViewVC 1.1.5