diff options
| -rw-r--r-- | cl-forth.lisp | 29 |
1 files changed, 24 insertions, 5 deletions
diff --git a/cl-forth.lisp b/cl-forth.lisp index 210b0ef..bad08ef 100644 --- a/cl-forth.lisp +++ b/cl-forth.lisp @@ -24,29 +24,45 @@ (write-char #\Newline str)) (t (write-char ch str)))))) +(defun read-character (stream) + (let ((ch? (read-char stream))) + (if (not (char-equal ch? #\\)) + (if (char-equal #\' (peek-char nil stream)) + (progn (read-char stream) ch?) + (error "Unterminated char.")) + (progn (case (read-char stream) + (#\n (setf ch? #\Newline))) + (if (char-equal #\' (peek-char nil stream)) + (progn (read-char stream) ch?) + (error "Unterminated char.")))))) + (defun lex-line (line &optional (line-num 0)) (let ((*package* (find-package "KEYWORD"))) (iter (with line-stream = (make-string-input-stream line)) (with col = 0) - (with has-err = nil) (for next-char = (peek-char nil line-stream nil nil)) (until (null next-char)) (let ((flag t)) (cond ((char= #\| next-char) (read-char line-stream) (collect (make-token :pipe line-num col :identifier) - into tokens)) + into tokens)) ((char= #\Space next-char) (read-char line-stream)) ((char= #\; next-char) ;; and not in string (finish)) ((char= #\" next-char) (read-char line-stream) (collect (make-token (read-string line-stream) - line-num col) - into tokens)) + line-num col :string) + into tokens)) + ((char= #\' next-char) + (read-char line-stream) + (collect (make-token (read-character line-stream) + line-num col :char) + into tokens)) (t (setf flag nil))) (when flag - (incf col) + (incf col) ;; TODO: currently this is wrong for char and strings (next-iteration))) (for next-sym in-stream line-stream using #'read-preserving-whitespace) @@ -100,6 +116,9 @@ (defmethod parse-token ((parser parser) (type (eql :number))) (add-op `(:push-int ,(car (read-token parser))) parser)) +(defmethod parse-token ((parser parser) (type (eql :char))) + (add-op `(:push-int ,(char-code (car (read-token parser)))) parser)) + (defmethod parse-token ((parser parser) (type (eql :string))) (let ((token (read-token parser))) (add-op `(:push-str ,(length (car token)) |