added character literals

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))