From: Mark Wooding <mdw@distorted.org.uk>
Date: Thu, 26 May 2016 08:26:09 +0000 (+0100)
Subject: src/lexer-proto.lisp: New parser `must'.
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/commitdiff_plain/ae7a3c8fb42e457933efbbb9127d5a745096825a

src/lexer-proto.lisp: New parser `must'.

This is a simple wrapper around `error' for mandatory delimiters.  If it
doesn't find the delimiter, it reports the error and continues, possibly
producing a default value.
---

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 909f993..c506fcf 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -464,6 +464,7 @@ lexer-proto.lisp
   define-indicator                              function
   cl:error                                      function class parser
   lexer-error                                   function
+  must                                          parser
   scan-comment                                  function
   skip-until                                    function parser
   sod-token-scanner                             class
@@ -1913,6 +1914,7 @@ expand-parser-form
   list-parser (eql cl:type) t
   token-parser-context (eql token) t
   token-scanner-context (eql cl:error) t
+  token-scanner-context (eql sod:must) t
   token-scanner-context (eql sod:skip-until) t
 expand-parser-spec
   t (eql :eof)
diff --git a/doc/parsing.tex b/doc/parsing.tex
index 439d6d9..0d3487d 100644
--- a/doc/parsing.tex
+++ b/doc/parsing.tex
@@ -797,6 +797,9 @@ file-location protocols.
       @<sub-parser> @<recover-parser>}
 \end{describe}
 
+\begin{describe}{parseform}{must @<sub-parser> @[@<default>@]}
+\end{describe}
+
 \begin{describe}{fun}
     {scan-comment @<char-scanner>
       @> @<result> @<success-flag> @<consumed-flag>}
diff --git a/src/lexer-proto.lisp b/src/lexer-proto.lisp
index 122da75..b045be7 100644
--- a/src/lexer-proto.lisp
+++ b/src/lexer-proto.lisp
@@ -141,6 +141,14 @@ (defparse error (:context (context token-scanner-context)
 			:ignore-unconsumed ,ignore-unconsumed
 			:force-progress ,force-progress))
 
+(export 'must)
+(defparse must (:context (context token-scanner-context)
+		sub &optional default)
+  "Try to parse SUB; if it fails, report an error, and return DEFAULT.
+
+   This parser can't actually fail."
+  `(parse (error () ,sub (t ,default))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Lexical analysis utilities.