@@ 27,9 27,6 @@
#\Nul
(char (source l) (1+ (current-position l))))))
-(defun lex-error (msg)
- (error 'lexing-error :text (format nil "Lexing error: ~a~%" msg)))
-
(defgeneric skip-whitespace (lexer)
(:method ((l lexer))
;; nil primes the lexer; FIXME make this an :after method
@@ 69,24 66,30 @@
(#\/ (make-token :text c :kind :SLASH))
(#\Newline (make-token :text c :kind :NEWLINE))
(#\Nul (make-token :text c :kind :EOF))
+
(#\= (if (equal (peek l) #\=)
(progn (next-char l) (make-token :text "==" :kind :EQEQ))
(make-token :text "=" :kind :EQ)))
+
(#\> (if (equal (peek l) #\=)
(progn (next-char l) (make-token :text ">=" :kind :GTEQ))
(make-token :text ">" :kind :GT)))
+
(#\< (if (equal (peek l) #\=)
(progn (next-char l) (make-token :text "<=" :kind :LTEQ))
(make-token :text "<" :kind :LT)))
+
(#\! (if (equal (peek l) #\=)
(progn (next-char l) (make-token :text "!=" :kind :NOTEQ))
- (lex-error (format nil "Expected != instead got: ~a" c))))
+ (error 'lexing-error
+ :text (format nil "Expected != instead got: ~a" c))))
;; strings
(#\" (progn (next-char l)
(let ((start-position (current-position l)))
(loop until (equal #\" (current-char l))
if (member (current-char l) '(#\Return #\Newline #\Tab #\\ #\%) :test #'equal)
- do (lex-error (format nil "illegal character in string: ~a" (current-char l)))
+ do (error 'lexing-error
+ :text (format nil "illegal character in string: ~a" (current-char l)))
do (next-char l))
(make-token :text (subseq (source l) start-position (1+ (current-position l)))
:kind :STRING))))
@@ 102,7 105,8 @@
(if (digit-char-p (peek l))
(loop while (digit-char-p (peek l))
do (next-char l))
- (lex-error "illegal character in number"))))
+ (error 'lexing-error
+ :text "illegal character in number"))))
(make-token :text (subseq (source l) start-position (1+ (current-position l))) :kind :NUMBER)))
;; identifiers and keywords
@@ 115,7 119,8 @@
(if keyword
(make-token :text str :kind keyword)
(make-token :text str :kind :IDENTIFIER)))))
- (t (lex-error (format nil "unknown token: ~a" c))))))))
+ (t (error 'lexing-error
+ :text (format nil "unknown token: ~a" c))))))))
(next-char l)
token)))
@@ 177,6 182,7 @@
(if (check-token p :STRING)
(next-token p)
(expression p))))
+
((check-token p :IF) (progn
(next-token p)
(comparison p)
@@ 185,6 191,7 @@
(loop until (check-token p :ENDIF)
do (statement p))
(match p :ENDIF)))
+
((check-token p :WHILE) (progn
(next-token p)
(comparison p)
@@ 193,6 200,7 @@
(loop until (check-token p :ENDWHILE)
do (statement p))
(match p :ENDWHILE)))
+
((check-token p :LABEL) (progn
(next-token p)
(if (member (token-text (current-token p)) (labels-declared p) :test #'equal)
@@ 200,21 208,26 @@
:text (format nil "label already exists: ~a" (current-token p))))
(pushnew (token-text (current-token p)) (labels-declared p) :test #'equal)
(match p :IDENTIFIER)))
+
((check-token p :GOTO) (progn
(next-token p)
(pushnew (token-text (current-token p)) (labels-gotoed p) :test #'equal)
(match p :IDENTIFIER)))
+
((check-token p :LET) (progn
(next-token p)
(pushnew (token-text (current-token p)) (symbols p) :test #'equal)
(match p :IDENTIFIER)
(match p :EQ)
(expression p)))
+
((check-token p :INPUT) (progn
(next-token p)
(pushnew (token-text (current-token p)) (symbols p) :test #'equal)
(match p :IDENTIFIER)))
- (t (error 'parsing-error :text (format nil "Unknown token: ~a" (current-token p)))))
+
+ (t (error 'parsing-error
+ :text (format nil "Unknown token: ~a" (current-token p)))))
(newline p)))
(defgeneric newline (parser)
@@ 234,7 247,8 @@
(progn
(next-token p)
(expression p))
- (error 'parsing-error :text (format nil "Expected comparison, instead: ~a" (current-token p))))
+ (error 'parsing-error
+ :text (format nil "Expected comparison, instead: ~a" (current-token p))))
(loop while (comparison-operator?)
do (next-token p)
(expression p)))))
@@ 269,11 283,14 @@
(:method ((p parser))
(format t "primary~%")
(cond ((check-token p :NUMBER) (next-token p))
- ((check-token p :IDENTIFIER) (progn
- (unless (member (token-text (current-token p)) (symbols p) :test #'equal)
- (error 'parsing-error :text (format nil "referencing variable before assignment: ~a" (current-token p))))
- (next-token p)))
- (t (error 'parsing-error :text (format nil "Unexpected token: ~a" (current-token p)))))))
+ ((check-token p :IDENTIFIER)
+ (progn
+ (unless (member (token-text (current-token p)) (symbols p) :test #'equal)
+ (error 'parsing-error
+ :text (format nil "referencing variable before assignment: ~a" (current-token p))))
+ (next-token p)))
+ (t (error 'parsing-error
+ :text (format nil "Unexpected token: ~a" (current-token p)))))))
;;; "tests"
(let* ((l (make-instance 'lexer :source "
@@ 295,4 312,3 @@ ENDWHILE
"))
(p (make-instance 'parser :lexer l)))
(program p))
-