src/lexer-proto.lisp (syntax-error, lexer-error): Improve location handling.

The functions now provide a `:location' keyword argument, and use their
scanner argument as a default location if the keyword is omitted.

Nothing is currently using the optional arguments, but it might happen
later.

diff --git a/doc/parsing.tex b/doc/parsing.tex
index a83f26bbc722f802626ef6cf4fa2ac57fe8fb39c..ac878b41825c6d79695b71dca761b6866dfede1f 100644 (file)
--- a/doc/parsing.tex
+++ b/doc/parsing.tex
@@ -764,11 +764,12 @@ file-location protocols.
 \begin{describe}{fun}{define-indicator @<indicator> @<description>}
 \end{describe}
 
 \begin{describe}{fun}{define-indicator @<indicator> @<description>}
 \end{describe}
 

-\begin{describe}{fun}{syntax-error @<scanner> @<expected> \&key :continuep}
+\begin{describe}{fun}
+    {syntax-error @<scanner> @<expected> \&key :continuep :location}

 \end{describe}
 
 \begin{describe}{fun}
 \end{describe}
 
 \begin{describe}{fun}

-    {lexer-error @<char-scanner> @<expected>}
+    {lexer-error @<char-scanner> @<expected> \&key :location}

 \end{describe}
 
 \begin{describe}{parseform}
 \end{describe}
 
 \begin{describe}{parseform}

diff --git a/src/lexer-proto.lisp b/src/lexer-proto.lisp
index a70addc853d5fed9ce74c627df574e7e46e7cef7..c6d6f2889d774049d4a43434369e7445e3435923 100644 (file)
--- a/src/lexer-proto.lisp
+++ b/src/lexer-proto.lisp
@@ -52,7 +52,7 @@ (defun define-indicator (indicator description)
   indicator)
 
 (export 'syntax-error)
   indicator)
 
 (export 'syntax-error)

-(defun syntax-error (scanner expected &key (continuep t))
+(defun syntax-error (scanner expected &key (continuep t) location)

   "Signal a (maybe) continuable syntax error."
   (labels ((show-token (type value)
             (if (characterp type)
   "Signal a (maybe) continuable syntax error."
   (labels ((show-token (type value)
             (if (characterp type)


@@ -71,7 +71,8 @@ (defun syntax-error (scanner expected &key (continuep t))
                    ((eq (car thing) :id)
                     (format nil "`~A'" (cadr thing)))
                    (t (format nil "<? ~S>" thing)))))
                    ((eq (car thing) :id)
                     (format nil "`~A'" (cadr thing)))
                    (t (format nil "<? ~S>" thing)))))

-    (funcall (if continuep #'cerror* #'error)
+    (funcall (if continuep #'cerror*-with-location #'error-with-location)
+            (or location scanner)

             "Syntax error: ~
              expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
              but found ~A"
             "Syntax error: ~
              expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
              but found ~A"


@@ -79,11 +80,12 @@ (defun syntax-error (scanner expected &key (continuep t))
             (show-token (token-type scanner) (token-value scanner)))))
 
 (export 'lexer-error)
             (show-token (token-type scanner) (token-value scanner)))))
 
 (export 'lexer-error)

-(defun lexer-error (char-scanner expected)
+(defun lexer-error (char-scanner expected &key location)

   "Signal a continuable lexical error."
   "Signal a continuable lexical error."

-  (cerror* "Lexical error: ~
-           expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
-           but found ~/sod::show-char/"
+  (cerror*-with-location (or location char-scanner)
+                        "Lexical error: ~
+                         expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
+                         but found ~/sod::show-char/"

           (mapcar (lambda (exp)
                     (typecase exp
                       (character (format nil "~/sod::show-char/" exp))
           (mapcar (lambda (exp)
                     (typecase exp
                       (character (format nil "~/sod::show-char/" exp))