src/class-{finalize,layout}-*.lisp: Relocate layout interface code.

[sod] / src / lexer-impl.lisp

diff --git a/src/lexer-impl.lisp b/src/lexer-impl.lisp
index b579278086bef90d92c2f61ccb4715a0d3aa0f75..48109b18154a8b353f7b3f97a1ed4940bd26d4bb 100644 (file)
--- a/src/lexer-impl.lisp
+++ b/src/lexer-impl.lisp
@@ -59,7 +59,8 @@ (defun skip-until (scanner token-types &key keep-end)
       (return (values token-types nil consumedp)))
     (scanner-step scanner)))
 
-(defun parse-error-recover (scanner parser recover &key ignore-unconsumed)
+(defun parse-error-recover (scanner parser recover
+                           &key ignore-unconsumed force-progress)
   "This is the implementation of the `error' parser."
   (multiple-value-bind (result win consumedp) (funcall parser)
     (cond ((or win
@@ -84,8 +85,8 @@ (defun parse-error-recover (scanner parser recover &key ignore-unconsumed)
           ;; current token.  Finally, if we are at EOF then our best bet is
           ;; simply to propagate the current failure back to the caller, but
           ;; we handled that case above.
-          (syntax-error scanner result :continuep t)
-          (unless consumedp (scanner-step scanner))
+          (syntax-error scanner result)
+          (when (and force-progress (not consumedp)) (scanner-step scanner))
           (funcall recover)))))
 
 ;;;--------------------------------------------------------------------------
@@ -100,7 +101,18 @@ (defmethod scanner-token ((scanner sod-token-scanner))
               (parse (many (acc init (+ (* acc radix) it) :min min)
                        (label (list :digit radix)
                               (filter (lambda (ch)
-                                        (digit-char-p ch radix))))))))
+                                        (digit-char-p ch radix)))))))
+            (start-floc ()
+              ;; This is a little nasty.  We scan the first token during
+              ;; instance initialization, as a result of `shared-initialize'
+              ;; on `token-scanner'.  Unfortunately, this happens before
+              ;; we've had a chance to initialize our own `filename' slot.
+              ;; This means that we can't use the SCANNER as a file
+              ;; location, however tempting it might be.  So we have this
+              ;; hack.
+              (make-file-location (scanner-filename char-scanner)
+                                  (scanner-line scanner)
+                                  (scanner-column scanner))))
 
        ;; Skip initial junk, and remember the place.
        (loop
@@ -109,7 +121,7 @@ (defmethod scanner-token ((scanner sod-token-scanner))
          (cond-parse (:consumedp cp :expected exp)
            ((satisfies whitespace-char-p) (parse :whitespace))
            ((scan-comment char-scanner))
-           (t (if cp (lexer-error char-scanner exp cp) (return)))))
+           (t (if cp (lexer-error char-scanner exp) (return)))))
 
        ;; Now parse something.
        (cond-parse (:consumedp cp :expected exp)
@@ -127,13 +139,23 @@ (defmethod scanner-token ((scanner sod-token-scanner))
                                      (progn (write-char it out) out)
                                      :final (get-output-stream-string out))
                             (or (and #\\ :any) (not quote))))
-                (nil (char quote)))
+                (nil (or (char quote)
+                         (seq (:eof)
+                           (lexer-error char-scanner (list quote))
+                           (info-with-location
+                            (start-floc) "Literal started here")))))
             (ecase quote
               (#\" contents)
               (#\' (case (length contents)
                      (1 (char contents 0))
-                     (0 (cerror* "Empty character literal") #\?)
-                     (t (cerror* "Too many characters in literal")
+                     (0 (cerror*-with-location (start-floc)
+                                               "Lexical error: ~
+                                                empty character literal")
+                        #\?)
+                     (t (cerror*-with-location (start-floc)
+                                               "Lexical error: ~
+                                                too many characters ~
+                                                in literal")
                         (char contents 0))))))
           (values (etypecase it
                     (character :char)
@@ -168,7 +190,7 @@ (defmethod scanner-token ((scanner sod-token-scanner))
          ;; must make progress on every call.
          (t
           (assert cp)
-          (lexer-error char-scanner exp cp)
+          (lexer-error char-scanner exp)
           (scanner-token scanner)))))))
 
 ;;;----- That's all, folks --------------------------------------------------