Work in progress, recovered from old crybaby.

[sod] / src / parser / proto-parser.lisp

diff --git a/src/parser/proto-parser.lisp b/src/parser/proto-parser.lisp
index f32a30451125e2a1a44b018e34937451ffda6833..5a10b77780d129142273619fcef4608295404d86 100644 (file)
--- a/src/parser/proto-parser.lisp
+++ b/src/parser/proto-parser.lisp
@@ -58,18 +58,19 @@
 ;;; The functions and macros here are simply ways of gluing together
 ;;; expressions which obey this protocol.
 ;;;
 ;;; The functions and macros here are simply ways of gluing together
 ;;; expressions which obey this protocol.
 ;;;

-;;; The main contribution of this file is a macro WITH-PARSER-CONTEXT which
+;;; The main contribution of this file is a macro `with-parser-context' which

 ;;; embeds a parsing-specific S-expressions language entered using the new
 ;;; embeds a parsing-specific S-expressions language entered using the new

-;;; macro PARSE.  The behaviour of this macro is controlled by a pair of
-;;; compile-time generic functions EXPAND-PARSER-SPEC and EXPAND-PARSER-FORM.
-;;; As well as the parser expression they're meant to process, these
-;;; functions dispatch on a `context' argument, which is intended to help
-;;; `leaf' parsers find the terminal symbols which they're meant to process.
+;;; macro `parse'.  The behaviour of this macro is controlled by a pair of
+;;; compile-time generic functions `expand-parser-spec' and
+;;; `expand-parser-form'.  As well as the parser expression they're meant to
+;;; process, these functions dispatch on a `context' argument, which is
+;;; intended to help `leaf' parsers find the terminal symbols which they're
+;;; meant to process.

 ;;;
 ;;;

-;;; Note that the context is a compile-time object, constructed by the PARSE
-;;; macro expansion function, though the idea is that it will contain the
-;;; name or names of variables holding the run-time parser state (which will
-;;; typically be a lexical analyser or an input stream or suchlike).
+;;; Note that the context is a compile-time object, constructed by the
+;;; `parse' macro expansion function, though the idea is that it will contain
+;;; the name or names of variables holding the run-time parser state (which
+;;; will typically be a lexical analyser or an input stream or suchlike).

 
 (cl:in-package #:sod-parser)
 
 
 (cl:in-package #:sod-parser)
 


@@ -324,6 +325,10 @@ (defparse t (value)
   "Succeed, without consuming input, with result VALUE."
   `(values ,value t nil))
 
   "Succeed, without consuming input, with result VALUE."
   `(values ,value t nil))
 

+(defparse nil (indicator)
+  "Fail, without consuming input, with indicator VALUE."
+  `(values (list ,indicator) nil nil))
+

 (defparse when (cond &body parser)
   "If CONDITION is true, then match PARSER; otherwise fail."
   `(if ,cond (parse ,@parser) (values nil nil nil)))
 (defparse when (cond &body parser)
   "If CONDITION is true, then match PARSER; otherwise fail."
   `(if ,cond (parse ,@parser) (values nil nil nil)))


@@ -332,6 +337,10 @@ (defmethod expand-parser-spec (context (spec (eql t)))
   "Always matches without consuming input."
   '(values t t nil))
 
   "Always matches without consuming input."
   '(values t t nil))
 

+(defmethod expand-parser-spec (context (spec (eql nil)))
+  "Always fails without consuming input.  The failure indicator is `:fail'."
+  '(values '(:fail) nil nil))
+

 (export 'seq)
 (defparse seq (binds &body body)
   "Parse a sequence of heterogeneous items.
 (export 'seq)
 (defparse seq (binds &body body)
   "Parse a sequence of heterogeneous items.


@@ -557,7 +566,7 @@ (defmacro define-pluggable-parser (symbol tag (&rest bvl) &body body)
    The pluggable parser itself is denoted by SYMBOL; the TAG is any `eql'-
    comparable object which identifies the element.  Neither SYMBOL nor TAG is
    evaluated.  The BODY is a parser expression; the BVL is a lambda list
    The pluggable parser itself is denoted by SYMBOL; the TAG is any `eql'-
    comparable object which identifies the element.  Neither SYMBOL nor TAG is
    evaluated.  The BODY is a parser expression; the BVL is a lambda list

-   describing how to bind the argumens supplied via `pluggable-parser'.
+   describing how to bind the arguments supplied via `pluggable-parser'.

 
    If a parser with the given TAG is already attached to SYMBOL then the new
    parser replaces the old one; otherwise it is added to the collection."
 
    If a parser with the given TAG is already attached to SYMBOL then the new
    parser replaces the old one; otherwise it is added to the collection."


@@ -661,23 +670,25 @@ (defgeneric parser-current-char (context)
    you must check this first.  Be careful: all of this is happening at
    macro-expansion time."))
 
    you must check this first.  Be careful: all of this is happening at
    macro-expansion time."))
 

+(export 'if-char)

 (defparse if-char (:context (context character-parser-context)
                   (&optional (char 'it)) condition consequent alternative)
   "Basic character-testing parser.
 
    If there is a current character, bind it to CHAR and evaluate the
 (defparse if-char (:context (context character-parser-context)
                   (&optional (char 'it)) condition consequent alternative)
   "Basic character-testing parser.
 
    If there is a current character, bind it to CHAR and evaluate the

-   CONDITION; if that is true, then step the parser and evaluate CONSEQUENT;
-   otherwise, if either we're at EOF or the CONDITION returns false, evaluate
-   ALTERNATIVE.  The result of `if-char' are the values returned by
-   CONSEQUENT or ALTERNATIVE."
+   CONDITION; if that is true, then evaluate CONSEQUENT and step the parser
+   (in that order); otherwise, if either we're at EOF or the CONDITION
+   returns false, evaluate ALTERNATIVE.  The result of `if-char' are the
+   values returned by CONSEQUENT or ALTERNATIVE."

 
   (with-gensyms (block)
     `(block ,block
        (unless ,(parser-at-eof-p context)
         (let ((,char ,(parser-current-char context)))
           (when ,condition
 
   (with-gensyms (block)
     `(block ,block
        (unless ,(parser-at-eof-p context)
         (let ((,char ,(parser-current-char context)))
           (when ,condition

-            ,(parser-step context)
-            (return-from ,block ,consequent))))
+            (return-from ,block
+              (multiple-value-prog1 ,consequent
+                ,(parser-step context))))))

        ,alternative)))
 
 (defmethod expand-parser-spec
        ,alternative)))
 
 (defmethod expand-parser-spec