[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Sat Jan 5 14:23:16 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv8577/Drei
Modified Files:
lisp-syntax.lisp
Log Message:
Handle more noncharacters in the Lisp lexer.
Fix dumb bug in `find-list-parent'.
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/05 11:55:18 1.50
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/05 14:23:16 1.51
@@ -354,99 +354,103 @@
(t
(let ((prefix 0))
(loop until (end-of-buffer-p scan)
- while (digit-char-p (object-after scan))
+ while (and (characterp (object-after scan))
+ (digit-char-p (object-after scan)))
do (setf prefix
(+ (* 10 prefix)
(digit-char-p (object-after scan))))
(fo))
- (if (end-of-buffer-p scan)
- (make-instance 'incomplete-lexeme)
- (case (object-after scan)
- ((#\Backspace #\Tab #\Newline #\Linefeed
- #\Page #\Return #\Space #\))
- (fo)
- (make-instance 'error-lexeme))
- (#\\ (fo)
- (cond ((end-of-buffer-p scan)
- (make-instance 'incomplete-character-lexeme))
- ((not (constituentp (object-after scan)))
- (fo) (make-instance 'complete-character-lexeme))
- (t (loop until (end-of-buffer-p scan)
- while (constituentp (object-after scan))
- do (fo))
- (make-instance 'complete-character-lexeme))))
- (#\' (fo)
- (make-instance 'function-lexeme))
- (#\( (fo)
- (make-instance 'simple-vector-start-lexeme))
- (#\* (fo)
- (loop until (end-of-buffer-p scan)
- while (or (eql (object-after scan) #\1)
- (eql (object-after scan) #\0))
- do (fo))
- (if (and (not (end-of-buffer-p scan))
- (constituentp (object-after scan)))
- (make-instance 'error-lexeme)
- (make-instance 'bit-vector-form)))
- (#\: (fo)
- (make-instance 'uninterned-symbol-lexeme))
- (#\. (fo)
- (make-instance 'readtime-evaluation-lexeme))
- ((#\B #\b #\O #\o #\X #\x)
- (let ((radix
- (ecase (object-after scan)
- ((#\B #\b) 2)
- ((#\O #\o) 8)
- ((#\X #\x) 16))))
- (fo)
+ (if (or (end-of-buffer-p scan)
+ (not (characterp (object-after scan))))
+ (make-instance 'incomplete-lexeme)
+ (case (object-after scan)
+ ((#\Backspace #\Tab #\Newline #\Linefeed
+ #\Page #\Return #\Space #\))
+ (fo)
+ (make-instance 'error-lexeme))
+ (#\\ (fo)
+ (cond ((or (end-of-buffer-p scan)
+ (not (characterp (object-after scan))))
+ (make-instance 'incomplete-character-lexeme))
+ ((not (constituentp (object-after scan)))
+ (fo) (make-instance 'complete-character-lexeme))
+ (t (loop until (end-of-buffer-p scan)
+ while (constituentp (object-after scan))
+ do (fo))
+ (make-instance 'complete-character-lexeme))))
+ (#\' (fo)
+ (make-instance 'function-lexeme))
+ (#\( (fo)
+ (make-instance 'simple-vector-start-lexeme))
+ (#\* (fo)
+ (loop until (end-of-buffer-p scan)
+ while (or (eql (object-after scan) #\1)
+ (eql (object-after scan) #\0))
+ do (fo))
+ (if (and (not (end-of-buffer-p scan))
+ (constituentp (object-after scan)))
+ (make-instance 'error-lexeme)
+ (make-instance 'bit-vector-form)))
+ (#\: (fo)
+ (make-instance 'uninterned-symbol-lexeme))
+ (#\. (fo)
+ (make-instance 'readtime-evaluation-lexeme))
+ ((#\B #\b #\O #\o #\X #\x)
+ (let ((radix
+ (ecase (object-after scan)
+ ((#\B #\b) 2)
+ ((#\O #\o) 8)
+ ((#\X #\x) 16))))
+ (fo)
(when (char= (object-after scan)
#\-)
(fo))
- (loop until (end-of-buffer-p scan)
- while (digit-char-p (object-after scan) radix)
- do (fo)))
- (if (and (not (end-of-buffer-p scan))
- (constituentp (object-after scan)))
- (make-instance 'error-lexeme)
- (make-instance 'number-lexeme)))
- ((#\R #\r)
- (fo)
- (cond
- ((<= 2 prefix 36)
- (loop until (end-of-buffer-p scan)
- while (digit-char-p (object-after scan) prefix)
- do (fo))
- (if (and (not (end-of-buffer-p scan))
- (constituentp (object-after scan)))
- (make-instance 'error-lexeme)
- (make-instance 'number-lexeme)))
- (t (make-instance 'error-lexeme))))
- ;((#\C #\c) )
- ((#\A #\a) (fo)
- (make-instance 'array-start-lexeme))
- ((#\S #\s) (fo)
- (cond ((and (not (end-of-buffer-p scan))
- (eql (object-after scan) #\())
- (fo)
- (make-instance 'structure-start-lexeme))
- ((end-of-buffer-p scan)
- (make-instance 'incomplete-lexeme))
- (t (make-instance 'error-lexeme))))
- ((#\P #\p) (fo)
- (make-instance 'pathname-start-lexeme))
- (#\= (fo)
- (make-instance 'sharpsign-equals-lexeme))
- (#\# (fo)
- (make-instance 'sharpsign-sharpsign-form))
- (#\+ (fo)
- (make-instance 'reader-conditional-positive-lexeme))
- (#\- (fo)
- (make-instance 'reader-conditional-negative-lexeme))
- (#\| (fo)
- (make-instance 'long-comment-start-lexeme))
- (#\< (fo)
- (make-instance 'error-lexeme))
- (t (fo) (make-instance 'undefined-reader-macro-lexeme))))))))
+ (loop until (end-of-buffer-p scan)
+ while (digit-char-p (object-after scan) radix)
+ do (fo)))
+ (if (and (not (end-of-buffer-p scan))
+ (constituentp (object-after scan)))
+ (make-instance 'error-lexeme)
+ (make-instance 'number-lexeme)))
+ ((#\R #\r)
+ (fo)
+ (cond
+ ((<= 2 prefix 36)
+ (loop until (end-of-buffer-p scan)
+ while (and (characterp (object-after scan))
+ (digit-char-p (object-after scan) prefix))
+ do (fo))
+ (if (and (not (end-of-buffer-p scan))
+ (constituentp (object-after scan)))
+ (make-instance 'error-lexeme)
+ (make-instance 'number-lexeme)))
+ (t (make-instance 'error-lexeme))))
+ ;((#\C #\c) )
+ ((#\A #\a) (fo)
+ (make-instance 'array-start-lexeme))
+ ((#\S #\s) (fo)
+ (cond ((and (not (end-of-buffer-p scan))
+ (eql (object-after scan) #\())
+ (fo)
+ (make-instance 'structure-start-lexeme))
+ ((end-of-buffer-p scan)
+ (make-instance 'incomplete-lexeme))
+ (t (make-instance 'error-lexeme))))
+ ((#\P #\p) (fo)
+ (make-instance 'pathname-start-lexeme))
+ (#\= (fo)
+ (make-instance 'sharpsign-equals-lexeme))
+ (#\# (fo)
+ (make-instance 'sharpsign-sharpsign-form))
+ (#\+ (fo)
+ (make-instance 'reader-conditional-positive-lexeme))
+ (#\- (fo)
+ (make-instance 'reader-conditional-negative-lexeme))
+ (#\| (fo)
+ (make-instance 'long-comment-start-lexeme))
+ (#\< (fo)
+ (make-instance 'error-lexeme))
+ (t (fo) (make-instance 'undefined-reader-macro-lexeme))))))))
(#\| (fo) (make-instance 'multiple-escape-start-lexeme))
(t (cond ((or (constituentp object)
(eql object #\\))
@@ -1975,7 +1979,7 @@
(typecase parent
(list-form parent)
((or form* null) nil)
- (t (find-list-parent-offset parent)))))
+ (t (find-list-parent parent)))))
(defun find-list-parent-offset (form fn)
"Find a list parent of `form' and return `fn' applied to this
More information about the Mcclim-cvs
mailing list