/[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.13 - (hide annotations)
Fri Apr 1 13:59:48 2005 UTC (9 years ago) by lgorrie
Branch: MAIN
CVS Tags: SLIME-1-2, SLIME-1-2-1
Changes since 1.12: +6 -0 lines
(check-source-path): Signal an error if a source path is malformed.
SBCL sometimes gives (NIL).

(source-path-stream-position): Use it.
1 dbarlow 1.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     ;;; Taken from swank-cmucl.lisp, by Helmut Eller
22    
23 heller 1.3 (in-package :swank-backend)
24 dbarlow 1.1
25 heller 1.8 ;; Some test to ensure the required conformance
26     (let ((rt (copy-readtable nil)))
27     (assert (or (not (get-macro-character #\space rt))
28     (nth-value 1 (get-macro-character #\space rt))))
29     (assert (not (get-macro-character #\\ rt))))
30    
31 dbarlow 1.1 (defun make-source-recorder (fn source-map)
32     "Return a macro character function that does the same as FN, but
33     additionally stores the result together with the stream positions
34     before and after of calling FN in the hashtable SOURCE-MAP."
35 heller 1.2 (declare (type function fn))
36 dbarlow 1.1 (lambda (stream char)
37     (let ((start (file-position stream))
38     (values (multiple-value-list (funcall fn stream char)))
39     (end (file-position stream)))
40 heller 1.2 ;;(format t "[~D ~{~A~^, ~} ~D ~D]~%" start values end (char-code char))
41 heller 1.10 (unless (null values)
42 dbarlow 1.1 (push (cons start end) (gethash (car values) source-map)))
43     (values-list values))))
44    
45     (defun make-source-recording-readtable (readtable source-map)
46     "Return a source position recording copy of READTABLE.
47     The source locations are stored in SOURCE-MAP."
48     (let* ((tab (copy-readtable readtable))
49 heller 1.4 (*readtable* tab))
50 heller 1.12 (dotimes (code 128)
51 dbarlow 1.1 (let ((char (code-char code)))
52 heller 1.8 (multiple-value-bind (fn term) (get-macro-character char tab)
53 heller 1.4 (when fn
54 dbarlow 1.1 (set-macro-character char (make-source-recorder fn source-map)
55     term tab)))))
56     tab))
57    
58 lgorrie 1.7 (defvar *source-map* nil
59 dbarlow 1.1 "The hashtable table used for source position recording.")
60    
61     (defun read-and-record-source-map (stream)
62     "Read the next object from STREAM.
63     Return the object together with a hashtable that maps
64     subexpressions of the object to stream positions."
65 lgorrie 1.7 (let* ((*source-map* (make-hash-table :test #'eq))
66 heller 1.9 (*readtable* (make-source-recording-readtable *readtable*
67     *source-map*)))
68 dbarlow 1.1 (values (read stream) *source-map*)))
69 lgorrie 1.7
70 heller 1.11 (defun read-source-form (n stream)
71     "Read the Nth toplevel form number with source location recording.
72     Return the form and the source-map."
73 heller 1.12 (let ((*read-suppress* t))
74 heller 1.11 (dotimes (i n)
75     (read stream)))
76     (let ((*read-suppress* nil))
77     (read-and-record-source-map stream)))
78    
79 dbarlow 1.1 (defun source-path-stream-position (path stream)
80     "Search the source-path PATH in STREAM and return its position."
81 lgorrie 1.13 (check-source-path path)
82 dbarlow 1.1 (destructuring-bind (tlf-number . path) path
83 heller 1.11 (multiple-value-bind (form source-map) (read-source-form tlf-number stream)
84 heller 1.9 (source-path-source-position (cons 0 path) form source-map))))
85 lgorrie 1.13
86     (defun check-source-path (path)
87     (unless (and (consp path)
88     (every #'integerp path))
89     (error "The source-path ~S is not valid." path)))
90 dbarlow 1.1
91     (defun source-path-string-position (path string)
92     (with-input-from-string (s string)
93     (source-path-stream-position path s)))
94    
95     (defun source-path-file-position (path filename)
96     (with-open-file (file filename)
97     (source-path-stream-position path file)))
98    
99     (defun source-path-source-position (path form source-map)
100     "Return the start position of PATH from FORM and SOURCE-MAP. All
101     subforms along the path are considered and the start and end position
102 heller 1.11 of the deepest (i.e. smallest) possible form is returned."
103 dbarlow 1.1 ;; compute all subforms along path
104     (let ((forms (loop for n in path
105     for f = form then (nth n f)
106     collect f)))
107     ;; select the first subform present in source-map
108     (loop for form in (reverse forms)
109     for positions = (gethash form source-map)
110     until (and positions (null (cdr positions)))
111     finally (destructuring-bind ((start . end)) positions
112     (return (values (1- start) end))))))
113    

  ViewVC Help
Powered by ViewVC 1.1.5