`(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)
"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.
`(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.