From: Mark Wooding <mdw@distorted.org.uk>
Date: Sun, 26 Mar 2017 14:16:18 +0000 (+0100)
Subject: src/lexer-{proto,impl}.lisp: Add explicit recovery action to `error'.
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/commitdiff_plain/b5911ce8da34bfdd5c4515b44fd2efce7c9c233f

src/lexer-{proto,impl}.lisp: Add explicit recovery action to `error'.

This ends up being an `:action' keyword argument to
`parse-error-recover', and a macro body to the `error' parser macro.
---

diff --git a/doc/parsing.tex b/doc/parsing.tex
index c91c74b..8ed8d65 100644
--- a/doc/parsing.tex
+++ b/doc/parsing.tex
@@ -836,8 +836,10 @@ file-location protocols.
 
 \begin{describe}{parseform}
     {error (@[[ :ignore-unconsumed @<flag> @!
-                :force-process @<flag> @]])                     \\ \ind
-      @<sub-parser> @<recover-parser>}
+                :force-process @<flag> @]])                     \\ \ind\ind
+        @<sub-parser> @<recover-parser>                       \-\\
+      @<declaration>^*                                          \\
+      @<form>^*}
 \end{describe}
 
 \begin{describe}{parseform}{must @<sub-parser> @[@<default>@]}
diff --git a/src/lexer-impl.lisp b/src/lexer-impl.lisp
index 1686179..de76371 100644
--- a/src/lexer-impl.lisp
+++ b/src/lexer-impl.lisp
@@ -67,7 +67,7 @@ (defun %skip-until (scanner token-types
     (scanner-step scanner)))
 
 (defun parse-error-recover (scanner parser recover
-			    &key ignore-unconsumed force-progress)
+			    &key ignore-unconsumed force-progress action)
   "This is the implementation of the `error' parser."
   (multiple-value-bind (result win consumedp) (funcall parser)
     (cond ((or win
@@ -93,6 +93,7 @@ (defun parse-error-recover (scanner parser recover
 	   ;; simply to propagate the current failure back to the caller, but
 	   ;; we handled that case above.
 	   (syntax-error scanner result)
+	   (when action (funcall action))
 	   (when (and force-progress (not consumedp)) (scanner-step scanner))
 	   (funcall recover)))))
 
diff --git a/src/lexer-proto.lisp b/src/lexer-proto.lisp
index 60235ff..a811298 100644
--- a/src/lexer-proto.lisp
+++ b/src/lexer-proto.lisp
@@ -129,7 +129,7 @@ (defparse skip-until (:context (context token-scanner-context)
 (export 'error)
 (defparse error (:context (context token-scanner-context)
 		 (&key ignore-unconsumed force-progress)
-		 sub &optional (recover t))
+		 sub &optional (recover t) &body body)
   "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
@@ -148,7 +148,8 @@ (defparse error (:context (context token-scanner-context)
 			(parser () ,sub)
 			(parser () ,recover)
 			:ignore-unconsumed ,ignore-unconsumed
-			:force-progress ,force-progress))
+			:force-progress ,force-progress
+			:action ,(and body `(lambda () ,@body))))
 
 (export 'must)
 (defparse must (:context (context token-scanner-context)