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 f00994a4913afbf5e8dd854efe95cff97a5cf1ba..48109b18154a8b353f7b3f97a1ed4940bd26d4bb 100644 (file)
--- a/src/lexer-impl.lisp
+++ b/src/lexer-impl.lisp
@@ -101,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
@@ -128,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)