X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/e0808c472145fc81e52898bc9ac289e10c4f4f41..388ca1cdcd263e6ad8731e9680d4097a6820e87a:/src/parser/parser-proto.lisp

diff --git a/src/parser/parser-proto.lisp b/src/parser/parser-proto.lisp
index b97cd4b..7aafe45 100644
--- a/src/parser/parser-proto.lisp
+++ b/src/parser/parser-proto.lisp
@@ -87,6 +87,21 @@
 	  failures
 	  :initial-value nil))
 
+(export 'parse-empty)
+(defun parse-empty (&optional value)
+  "Return a parser which parses nothing, successfully.
+
+   The parser returns VALUE and consumes nothing."
+  (lambda () (values value t nil)))
+
+(export 'parse-fail)
+(defun parse-fail (indicator &optional consumedp)
+  "Return a parser which fails.
+
+   The parser reports the INDICATOR and (falsely) claims to have consumed
+   input if CONSUMEDP is true."
+  (lambda () (values indicator nil consumedp)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Basic protocol.
 
@@ -646,7 +661,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 +670,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.