basic error reporting to character and string literalsHEADmaster

1 files changed, 45 insertions, 25 deletions

diff --git a/cl-forth.lisp b/cl-forth.lisp
index b0bcdbd..5b50f2a 100644
--- a/cl-forth.lisp
+++ b/cl-forth.lisp
@@ -14,32 +14,51 @@
   (car token))
 
 ;;; LEXER
-(defun read-string (stream)
-  ;; TODO: Handle unmatched " and give proper error message
-  (with-output-to-string (str)
-    (iter (for ch = (read-char stream))
-          (cond ((char= ch #\")
-                 (finish))
-                ((char= ch #\\)
-                 (case (peek-char nil stream)
-                   (#\n (write-char #\Newline str))
-                   (#\0 (write-char (code-char 0) str))
-                   (#\\ (write-char #\\ str))
-                   (#\" (write-char #\" str)))
-                 (read-char stream))
-                (t (write-char ch str))))))
+(defun read-string (stream line-num line col)
+  "This function is called when a #\" (double quote) is read from the STREAM."
+  (let ((i 0))
+    (values
+     (with-output-to-string (str)
+       (iter (for ch = (read-char stream nil 'eof))
+             (cond ((eq 'eof ch)
+                    (error (cond-string-not-closed
+                            line-num line col
+                            (get-output-stream-string str))))
+                   ((char= ch #\")
+                    (if (> i 0)
+                        (finish)
+                        (error (cond-empty-string line-num line col))))
+                   ((char= ch #\\)
+                    (case (peek-char nil stream)
+                      (#\n (write-char #\Newline str))
+                      (#\0 (write-char (code-char 0) str))
+                      (#\\ (write-char #\\ str))
+                      (#\" (write-char #\" str)))
+                    (read-char stream))
+                   (t (write-char ch str)))
+             (incf i)))
+     i)))
 
 (defun read-character (stream line-num line col)
-  (let ((ch? (read-char stream)))
-    (if (not (char-equal ch? #\\))
-        (if (char-equal #\' (peek-char nil stream))
-            (progn (read-char stream) ch?)
-            (error (handle-char-not-closed line-num line col)))
-        (progn (case (read-char stream)
-                 (#\n (setf ch? #\Newline)))
-               (if (char-equal #\' (peek-char nil stream))
-                   (progn (read-char stream) ch?)
-                   (error (handle-char-not-closed line-num line col)))))))
+  "This function is called when a #\' (single quote) is read from the STREAM."
+  (let ((ch? (read-char stream nil 'eof)))
+    (cond ((eq 'eof ch?)
+           (error (cond-char-not-closed line-num line col 'yok)))
+          ((char-equal ch? #\\)
+           (let ((escaped-ch (read-char stream nil 'eof)))
+             (case escaped-ch
+               (eof (error (cond-char-not-closed line-num line col 'yok)))
+               (#\n (setf ch? #\Newline))
+               (#\0 (setf ch? (code-char 0)))
+               (otherwise (setf ch? escaped-ch)))))
+          ((char-equal ch? #\')
+           (error (cond-empty-char line-num line col)))
+          (t nil))
+    (let ((closing-ch (read-char stream nil 'eof)))
+      (if (or (eq 'eof closing-ch)
+              (not (char-equal #\' closing-ch)))
+          (error (cond-char-not-closed line-num line col ch?))
+          ch?))))
 
 (defun lex-line (line &optional (line-num 0))
   (let ((*package* (find-package "KEYWORD")))
@@ -61,7 +80,8 @@
                    (finish))
                   ((char= #\" next-char)
                    (read-char line-stream)
-                   (collect (make-token (read-string line-stream)
+                   (collect (make-token (read-string
+                                         line-stream line-num line col)
                                         line-num col :string)
                      into tokens))
                   ((char= #\' next-char)