Commit 4398c08f2fe3bc3638e030f8af3927a45bcb82e2
2018-06-13T11:18:03
fix lexer
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
diff --git a/package.lisp b/package.lisp
index 566674d..5488f80 100644
--- a/package.lisp
+++ b/package.lisp
@@ -26,7 +26,11 @@
#:*buffer-size*
#:discard-token
#:lexer
- #:lexer-push
+ #:lexer-eof
+ #:lexer-input
+ #:lexer-input-n
+ #:lexer-match-char
+ #:lexer-match-start
#:lexer-token
#:make-token
#:match
@@ -35,5 +39,8 @@
#:match-sequence
#:match-times
#:match-until
+ #:pop-token
+ #:push-token
#:token
- #:token-stream))
+ #:token-stream
+ #:token-string))
diff --git a/token-stream.lisp b/token-stream.lisp
index fc93e3e..0afa0de 100644
--- a/token-stream.lisp
+++ b/token-stream.lisp
@@ -58,7 +58,7 @@
(eof :initform nil
:accessor lexer-eof)
(buffer :initform (make-buffer)
- :reader lexer-buffer
+ :accessor lexer-buffer
:type string)
(match :initform (make-instance 'lexer-token
:line 0
@@ -90,13 +90,6 @@ buffer for matching at index."))
(defgeneric (setf lexer-match-start) (value lexer)
(:documentation "Set token start for lexer match."))
-(defgeneric lexer-pop (lexer)
- (:documentation "Return the last token on lexer stack."))
-
-(defgeneric lexer-push (lexer)
- (:documentation "Push a copy of the lexer match onto the lexer
-stack."))
-
(defgeneric lexer-push-extend (lexer character)
(:documentation "Put a character into lexer buffer, extending it by
*BUFFER-SIZE* if necessary."))
@@ -119,6 +112,24 @@ lexer buffer."))
(:documentation "Advance lexer match start until THING is matched in
lexer buffer."))
+(defgeneric pop-token (lexer)
+ (:documentation "Return the last token on lexer stack."))
+
+(defgeneric push-token (lexer)
+ (:documentation "Push a copy of the lexer match onto the lexer
+stack."))
+
+;; Stream methods
+
+(defmethod stream-close ((lx lexer))
+ (stream-close (lexer-in lx)))
+
+(defmethod stream-element-type ((lx lexer))
+ 'token)
+
+(defmethod stream-open-p ((lx lexer))
+ (stream-open-p (lexer-in lx)))
+
;; Input
(defmethod lexer-push-extend ((lx lexer) (c character))
@@ -140,15 +151,14 @@ lexer buffer."))
(multiple-value-bind (c state) (stream-read in)
(ecase state
((nil) (let* ((pos (the fixnum (lexer-push-extend lx c)))
- (buf (lexer-buffer lx))
- (buf-char (char buf (the fixnum (1- pos)))))
- (declare (type (vector character) buf)
- (type character buf-char))
+ (buf (lexer-buffer lx)))
+ (declare (type (vector character) buf))
(cond ((or (and (char= #\Newline c)
- (not (and (< 0 pos)
- (char= #\Return buf-char))))
+ (or (not (< 0 pos))
+ (char/= #\Return
+ (char buf (1- pos)))))
(char= #\Return c))
- (setf (lexer-character lx) 0)
+ (setf (lexer-in-character lx) 0)
(incf (the fixnum (lexer-in-line lx))))
(t
(incf (the fixnum (lexer-in-character lx)))))
@@ -170,16 +180,22 @@ lexer buffer."))
(the fixnum (lexer-match-start lx)))
n)
(return))
+ (when (lexer-eof lx)
+ (return))
(lexer-input lx)))
(defmethod lexer-match-char ((lx lexer) (index fixnum))
(lexer-input-n lx (the fixnum (1+ index)))
- (char (lexer-buffer lx) (+ (the fixnum (lexer-match-start lx))
- index)))
+ (let ((buf (lexer-buffer lx))
+ (match-index (+ (the fixnum (lexer-match-start lx))
+ index)))
+ (declare (type (vector character) buf)
+ (type fixnum match-index))
+ (char buf match-index)))
;; Tokenizer
-(defmethod lexer-push ((lx lexer))
+(defmethod push-token ((lx lexer))
(let* ((match (lexer-match lx))
(line (token-line match))
(character (token-character match))
@@ -190,7 +206,7 @@ lexer buffer."))
:start start)))
(push token (lexer-stack lx))))
-(defmethod lexer-pop ((lx lexer))
+(defmethod pop-token ((lx lexer))
(assert (lexer-stack lx))
(let* ((buffer (lexer-buffer lx))
(fp (fill-pointer buffer))
@@ -205,7 +221,7 @@ lexer buffer."))
token))
(defmethod make-token ((lx lexer) (class symbol) &rest initargs)
- (let ((lt (lexer-pop lx)))
+ (let ((lt (pop-token lx)))
(apply #'make-instance class
:string (token-string lt)
:line (token-line lt)
@@ -213,7 +229,7 @@ lexer buffer."))
initargs)))
(defmethod discard-token ((lx lexer))
- (lexer-pop lx)
+ (pop-token lx)
nil)
;; Matcher