/[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.1 - (show annotations)
Fri Dec 12 04:54:41 2003 UTC (10 years, 4 months ago) by dbarlow
Branch: MAIN
CVS Tags: STATELESS-EMACS, SLIME-0-10
Branch point for: stateless-emacs
it might work better if this file were actually committed
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 (in-package :swank)
24
25 (defun make-source-recorder (fn source-map)
26 "Return a macro character function that does the same as FN, but
27 additionally stores the result together with the stream positions
28 before and after of calling FN in the hashtable SOURCE-MAP."
29 (lambda (stream char)
30 (let ((start (file-position stream))
31 (values (multiple-value-list (funcall fn stream char)))
32 (end (file-position stream)))
33 ;;(format t "~&[~D ~{~A~^, ~} ~D ~D]~%" start values end (char-code char))
34 (unless (null values)
35 (push (cons start end) (gethash (car values) source-map)))
36 (values-list values))))
37
38 (defun make-source-recording-readtable (readtable source-map)
39 "Return a source position recording copy of READTABLE.
40 The source locations are stored in SOURCE-MAP."
41 (let* ((tab (copy-readtable readtable))
42 (*readtable* tab)
43 (undefined-macro (get-macro-character #\Space tab)))
44 ;; not sure why this should be the case, but SBCL 0.8.6 returns
45 ;; #<FUNCTION "top level local call SB!IMPL::UNDEFINED-MACRO-CHAR">
46 ;; for (get-macro-character) on characters that aren't macros.
47 ;; As there's no way to detect the syntax of a character (only
48 ;; to set it from another character) we have to compare against
49 ;; this undefined-macro function to avoid turning everything into
50 ;; a macro
51 (dotimes (code char-code-limit)
52 (let ((char (code-char code)))
53 (multiple-value-bind (fn term) (get-macro-character char tab)
54 (when (and fn (not (eq fn undefined-macro)))
55 (set-macro-character char (make-source-recorder fn source-map)
56 term tab)))))
57 tab))
58
59 (defun make-source-map ()
60 (make-hash-table :test #'eq))
61
62 (defvar *source-map* (make-source-map)
63 "The hashtable table used for source position recording.")
64
65 (defvar *recording-readtable-cache* '()
66 "An alist of (READTABLE . RECORDING-READTABLE) pairs.")
67
68 (defun lookup-recording-readtable (readtable)
69 "Find a cached or create a new recording readtable for READTABLE."
70 (or (cdr (assoc readtable *recording-readtable-cache*))
71 (let ((table (make-source-recording-readtable readtable *source-map*)))
72 (push (cons readtable table) *recording-readtable-cache*)
73 table)))
74
75 (defun read-and-record-source-map (stream)
76 "Read the next object from STREAM.
77 Return the object together with a hashtable that maps
78 subexpressions of the object to stream positions."
79 (let ((*readtable* (lookup-recording-readtable *readtable*)))
80 (clrhash *source-map*)
81 (values (read stream) *source-map*)))
82
83 (defun source-path-stream-position (path stream)
84 "Search the source-path PATH in STREAM and return its position."
85 (destructuring-bind (tlf-number . path) path
86 (let ((*read-suppress* t))
87 (dotimes (i tlf-number) (read stream))
88 (multiple-value-bind (form source-map)
89 (read-and-record-source-map stream)
90 (source-path-source-position (cons 0 path) form source-map)))))
91
92 (defun source-path-string-position (path string)
93 (with-input-from-string (s string)
94 (source-path-stream-position path s)))
95
96 (defun source-path-file-position (path filename)
97 (with-open-file (file filename)
98 (source-path-stream-position path file)))
99
100 (defun source-path-source-position (path form source-map)
101 "Return the start position of PATH from FORM and SOURCE-MAP. All
102 subforms along the path are considered and the start and end position
103 of deepest (i.e. smallest) possible form is returned."
104 ;; compute all subforms along path
105 (let ((forms (loop for n in path
106 for f = form then (nth n f)
107 collect f)))
108 ;; select the first subform present in source-map
109 (loop for form in (reverse forms)
110 for positions = (gethash form source-map)
111 until (and positions (null (cdr positions)))
112 finally (destructuring-bind ((start . end)) positions
113 (return (values (1- start) end))))))
114

  ViewVC Help
Powered by ViewVC 1.1.5