From 2b8759bf0239b0a98ac830952ed69572580826c1 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Thu, 26 May 2016 09:26:09 +0100
Subject: [PATCH] src/parser/: Allow parsers to commit to a parse while
 peeking.

There is a new parser macro `commit' which may be used lexically within
the body of `peek' to commit to the current parse: if a failure is
encountered once the parse is committed, then the entire `peek' fails
having consumed input, rather than rewinding to the start.  This allows
parsers to limit the amount of lookahead they use once the ambiguity is
resolved.

Technically, the changes are as follows.

  * The `peek' parser macro introduces a new lexically-scoped macro into
    its body which releases its captured place and sets the
    corresponding variable to `nil'.

  * The `with-parser-place' and `with-scanner-place' macros don't try to
    release their captured places on unwind if they've been set to
    `nil'.  (It's not necessary to have changed `with-scanner-place'
    here, but it improves symmetry.)

  * There's a new `commit' parser macro which just invokes the magic
    macro introduced by `peek' and succeeds.

  * There's a top-level function with the same name as the local macro,
    to report errors in a slightly less confusing way.
---
 doc/SYMBOLS                   |  2 ++
 doc/parsing.tex               |  3 +++
 src/parser/parser-proto.lisp  | 33 ++++++++++++++++++++++++++-------
 src/parser/scanner-proto.lisp |  2 +-
 4 files changed, 32 insertions(+), 8 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index e19df8b..9df1bd9 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -1467,6 +1467,7 @@ parser-proto.lisp
   cl:char                                       function setf c-type parser
   character-parser-context                      class
   combine-parser-failures                       function
+  commit                                        parser
   cond-parse                                    macro
   define-pluggable-parser                       macro
   defparse                                      macro
@@ -1672,6 +1673,7 @@ expand-parser-form
   t (eql cl:t) t
   t (eql cl:when) t
   t (eql ?) t
+  t (eql commit) t
   t (eql expr) t
   t (eql label) t
   t (eql lisp) t
diff --git a/doc/parsing.tex b/doc/parsing.tex
index 28a747b..ec1667f 100644
--- a/doc/parsing.tex
+++ b/doc/parsing.tex
@@ -601,6 +601,9 @@ file-location protocols.
 \begin{describe}{parseform}{peek @<parser>}
 \end{describe}
 
+\begin{describe}{parseform}{commit}
+\end{describe}
+
 \begin{describe}{cls}{character-parser-context () \&key}
 \end{describe}
 
diff --git a/src/parser/parser-proto.lisp b/src/parser/parser-proto.lisp
index b97cd4b..189e503 100644
--- a/src/parser/parser-proto.lisp
+++ b/src/parser/parser-proto.lisp
@@ -646,7 +646,8 @@
 	   `(let ((,,place ,(parser-capture-place ,context)))
 	      ,(if (parser-places-must-be-released-p ,context)
 		   `(unwind-protect ,(,bodyfunc)
-			,(parser-release-place ,context ,place))
+		      (when ,,place
+			,(parser-release-place ,context ,place)))
 		   (,bodyfunc))))))))
 
 (export 'peek)
@@ -654,12 +655,30 @@
   "Attempt to run PARSER, but rewind the underlying source if it fails."
   (with-gensyms (value win consumedp)
     (with-parser-place (place context)
-      `(multiple-value-bind (,value ,win ,consumedp) (parse ,parser)
-	 (cond (,win
-		(values ,value ,win ,consumedp))
-	       (t
-		,(parser-restore-place context place)
-		(values ,value ,win nil)))))))
+      `(macrolet ((commit-peeked-place ()
+		    `(progn
+		       ,',(parser-release-place context place)
+		       (setf ,',place nil))))
+	 (multiple-value-bind (,value ,win ,consumedp) (parse ,parser)
+	   (cond ((or ,win (null ,place))
+		  (values ,value ,win ,consumedp))
+		 (t
+		  ,(parser-restore-place context place)
+		  (values ,value ,win nil))))))))
+
+(defun commit-peeked-place ()
+  "Called by `commit' not lexically within `peek'."
+  (error "`commit' is not within `peek'."))
+
+(export 'commit)
+(defparse commit ()
+  "Commit to the current parse.
+
+   This releases the place captured by the innermost lexically enclosing
+  `peek'."
+  '(progn
+     (commit-peeked-place)
+     (values nil t nil)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Character parser context protocol.
diff --git a/src/parser/scanner-proto.lisp b/src/parser/scanner-proto.lisp
index 8f27f89..c6236c5 100644
--- a/src/parser/scanner-proto.lisp
+++ b/src/parser/scanner-proto.lisp
@@ -104,7 +104,7 @@
       `(let ((,place (scanner-capture-place ,scanner)))
 	 ,@decls
 	 (unwind-protect (progn ,@body)
-	   (scanner-release-place ,scanner ,place))))))
+	   (when ,place (scanner-release-place ,scanner ,place)))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Character scanner protocol.
-- 
2.11.0