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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by lgorrie, Fri Aug 13 20:32:33 2004 UTC revision 1.8 by heller, Tue Oct 26 00:33:13 2004 UTC
# Line 22  Line 22 
22    
23  (in-package :swank-backend)  (in-package :swank-backend)
24    
25    ;; 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  (defun make-source-recorder (fn source-map)  (defun make-source-recorder (fn source-map)
32    "Return a macro character function that does the same as FN, but    "Return a macro character function that does the same as FN, but
33  additionally stores the result together with the stream positions  additionally stores the result together with the stream positions
# Line 36  before and after of calling FN in the ha Line 42  before and after of calling FN in the ha
42          (push (cons start end) (gethash (car values) source-map)))          (push (cons start end) (gethash (car values) source-map)))
43        (values-list values))))        (values-list values))))
44    
 #+sbcl  
 ;; not sure why this should be the case, but SBCL 0.8.6 returns  
 ;; #<FUNCTION "top level local call SB!IMPL::UNDEFINED-MACRO-CHAR">  
 ;; for (get-macro-character) on characters that aren't macros.  
 ;; As there's no way to detect the syntax of a character (only  
 ;; to set it from another character) we have to compare against  
 ;; this undefined-macro function to avoid turning everything into  
 ;; a macro  -- Dan Barlow  
 (if (not (get-macro-character #\space nil))  
     (defun cmucl-style-get-macro-character (char table)  
       (get-macro-character char table))  
     (defun cmucl-style-get-macro-character (char table)  
       (let ((rt (or table sb-impl::*standard-readtable*)))  
         (cond ((sb-impl::constituentp char)  
                (values (sb-impl::get-coerced-cmt-entry char rt) t))  
               ((sb-impl::terminating-macrop char)  
                (values (sb-impl::get-coerced-cmt-entry char rt) nil))  
               (t  
                (values nil nil))))))  
   
 #+cmu  
 (defun cmucl-style-get-macro-character (char table)  
   (get-macro-character char table))  
   
 ;; Unlike CMUCL, SBCL stores NIL values into the character-macro-table  
 ;; for constituent (in the CL sense) chars, and uses  
 ;; get-coerced-cmt-entry to convert those NILs to #'read-token.  In  
 ;; CMUCL all constituents are also macro-chars.  
 ;;  
 ;; CMUCL and SBCL use a somewhat strange encoding for CL's Character  
 ;; Syntax Types:  
 ;;  
 ;;  CL                    Implementation  
 ;;  ----------------      --------------  
 ;;  Constituent           (constituentp x) i.e. (<= +char-attr-constituent+ x)  
 ;;  Macro Char            (constituentp x) or +char-attr-terminating-macro+  
 ;;  Single Escape         +char-attr-escape+  
 ;;  Invalid               (constituentp x) with undefined-macro-char as fun  
 ;;  Multiple Escape       +char-attr-multiple-escape+  
 ;;  Whitespace            +char-attr-whitespace+  
 ;;  
 ;; One effect of this encoding is that invalid chars are not detected  
 ;; inside tokens and it seems that there's no good way to distinguish  
 ;; constituents from macro-chars.  
   
 (defun dump-readtable (rt)  
   (dotimes (code char-code-limit)  
     (let ((char (code-char code)))  
       (multiple-value-bind (fn terminatingp) (get-macro-character char rt)  
       (format t "~S[~D]: ~12,1T~A ~A~%"  
               char code fn terminatingp)))))  
   
 ;; (dump-readtable *readtable*)  
   
 (let ((rt (copy-readtable nil)))  
   ;; If #\space is a macro-char, it shouldn't terminate tokens.  
   (assert (or (not (cmucl-style-get-macro-character #\space rt))  
               (nth-value 1 (cmucl-style-get-macro-character #\space rt))))  
   ;; In SBCL (get-macro-character #\\) returns #'read-token, t.  And  
   ;; (set-macro-character #\\ #'read-token t) confuses #'read-string,  
   ;; because it uses the attributes in the readtable for parsing  
   ;; decisions.  
   (assert (not (cmucl-style-get-macro-character #\\ rt))))  
   
45  (defun make-source-recording-readtable (readtable source-map)  (defun make-source-recording-readtable (readtable source-map)
46    "Return a source position recording copy of READTABLE.    "Return a source position recording copy of READTABLE.
47  The source locations are stored in SOURCE-MAP."  The source locations are stored in SOURCE-MAP."
# Line 107  The source locations are stored in SOURC Line 49  The source locations are stored in SOURC
49           (*readtable* tab))           (*readtable* tab))
50      (dotimes (code char-code-limit)      (dotimes (code char-code-limit)
51        (let ((char (code-char code)))        (let ((char (code-char code)))
52          (multiple-value-bind (fn term)          (multiple-value-bind (fn term) (get-macro-character char tab)
             (cmucl-style-get-macro-character char tab)  
53            (when fn            (when fn
54              (set-macro-character char (make-source-recorder fn source-map)              (set-macro-character char (make-source-recorder fn source-map)
55                                   term tab)))))                                   term tab)))))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5