src/fragment-parse.lisp, src/lexer-{impl,proto}.lisp: Better errors.

[sod] / src / lexer-proto.lisp

diff --git a/src/lexer-proto.lisp b/src/lexer-proto.lisp
index 349e2a0ee5c325f181337ed4c461e55cd1310b96..122da753d99051275570d4f62ac457c32eefd169 100644 (file)
--- a/src/lexer-proto.lisp
+++ b/src/lexer-proto.lisp
@@ -84,8 +84,11 @@ (defun lexer-error (char-scanner expected &key location)
   "Signal a continuable lexical error."
   (cerror*-with-location (or location char-scanner)
                         "Lexical error: ~
-                         expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
-                         but found ~/sod::show-char/"
+                         ~:[unexpected~;~
+                            expected ~:*~{~#[~;~A~;~A or ~A~:;~
+                                             ~@{~A, ~#[~;or ~A~]~}~]~} ~
+                            but found~] ~
+                         ~/sod::show-char/"
           (mapcar (lambda (exp)
                     (typecase exp
                       (character (format nil "~/sod::show-char/" exp))
@@ -147,14 +150,31 @@ (defun scan-comment (char-scanner)
 
    The result isn't interesting."
   (with-parser-context (character-scanner-context :scanner char-scanner)
-    (parse (or (and "/*"
-                   (and (skip-many ()
-                          (and (skip-many () (not #\*))
-                               (label "*/" (skip-many (:min 1) #\*)))
-                          (not #\/))
-                        #\/))
-              (and "//"
-                   (skip-many () (not #\newline))
-                   (? #\newline))))))
+    (let ((start (file-location char-scanner)))
+      (parse (or (and "/*"
+                     (lisp (let ((state nil))
+                             (loop (cond ((scanner-at-eof-p char-scanner)
+                                          (lexer-error char-scanner
+                                                       (list "*/"))
+                                          (info-with-location
+                                           start "Comment started here")
+                                          (return (values nil t t)))
+                                         ((char= (scanner-current-char
+                                                  char-scanner)
+                                                 #\*)
+                                          (setf state '*)
+                                          (scanner-step char-scanner))
+                                         ((and (eq state '*)
+                                               (char= (scanner-current-char
+                                                       char-scanner)
+                                                      #\/))
+                                          (scanner-step char-scanner)
+                                          (return (values nil t t)))
+                                         (t
+                                          (setf state nil)
+                                          (scanner-step char-scanner)))))))
+                (and "//"
+                     (skip-many () (not #\newline))
+                     (? #\newline)))))))
 
 ;;;----- That's all, folks --------------------------------------------------