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