From d63df20adbac17c905f711af54d7c94b9079209b Mon Sep 17 00:00:00 2001
Message-Id: <d63df20adbac17c905f711af54d7c94b9079209b.1718943403.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Thu, 26 May 2016 09:26:09 +0100
Subject: [PATCH] src/lexer-proto.lisp (syntax-error, lexer-error): Improve
 location handling.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

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.
---
 doc/parsing.tex      |  5 +++--
 src/lexer-proto.lisp | 14 ++++++++------
 2 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/doc/parsing.tex b/doc/parsing.tex
index a83f26b..ac878b4 100644
--- 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}{syntax-error @<scanner> @<expected> \&key :continuep}
+\begin{describe}{fun}
+    {syntax-error @<scanner> @<expected> \&key :continuep :location}
 \end{describe}
 
 \begin{describe}{fun}
-    {lexer-error @<char-scanner> @<expected>}
+    {lexer-error @<char-scanner> @<expected> \&key :location}
 \end{describe}
 
 \begin{describe}{parseform}
diff --git a/src/lexer-proto.lisp b/src/lexer-proto.lisp
index a70addc..c6d6f28 100644
--- a/src/lexer-proto.lisp
+++ b/src/lexer-proto.lisp
@@ -52,7 +52,7 @@ (defun define-indicator (indicator description)
   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)
@@ -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)))))
-    (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"
@@ -79,11 +80,12 @@ (defun syntax-error (scanner expected &key (continuep t))
 	     (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."
-  (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))
-- 
[mdw]