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

[sod] / src / lexer-proto.lisp

diff --git a/src/lexer-proto.lisp b/src/lexer-proto.lisp
index 7ed7924c8590fe970db50a27afeb235c523e8749..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)
-(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,12 +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 consumedp)
+(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/~
-           ~@[ at ~A~]"
+  (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))
@@ -96,8 +97,7 @@ (defun lexer-error (char-scanner expected consumedp)
                       (t (format nil "<? ~S>" exp))))
                   expected)
           (and (not (scanner-at-eof-p char-scanner))
-               (scanner-current-char char-scanner))
-          (and consumedp (file-location char-scanner))))
+               (scanner-current-char char-scanner))))
 
 (export 'skip-until)
 (defparse skip-until (:context (context token-scanner-context)
@@ -116,7 +116,8 @@ (defparse skip-until (:context (context token-scanner-context)
 
 (export 'error)
 (defparse error (:context (context token-scanner-context)
-                (&key) sub &optional (recover t))
+                (&key ignore-unconsumed)
+                sub &optional (recover t))
   "Try to parse SUB; if it fails then report an error, and parse RECOVER.
 
    This is the main way to recover from errors and continue parsing.  Even
@@ -126,10 +127,15 @@ (defparse error (:context (context token-scanner-context)
    were never here.  Otherwise, try to recover in a sensible way so we can
    continue parsing.  The details of this recovery are subject to change, but
    the final action is generally to invoke the RECOVER parser and return its
-   result."
+   result.
+
+   If IGNORE-UNCONSUMED evaluates non-nil, then just propagate a failure of
+   SUB if it didn't consume input.  (This makes it suitable for use where the
+   parser containing `error' might be optional.)"
   `(parse-error-recover ,(parser-scanner context)
                        (parser () ,sub)
-                       (parser () ,recover)))
+                       (parser () ,recover)
+                       :ignore-unconsumed ,ignore-unconsumed))
 
 ;;;--------------------------------------------------------------------------
 ;;; Lexical analysis utilities.