lib/sod-hosted.c (sod_makev): Use two statements rather than tricky expression.

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

diff --git a/src/parser/parser-expr-proto.lisp b/src/parser/parser-expr-proto.lisp
index 326f3e5..c4b433f 100644 (file)
--- a/src/parser/parser-expr-proto.lisp
+++ b/src/parser/parser-expr-proto.lisp
@@ -28,29 +28,6 @@
 ;;;--------------------------------------------------------------------------
 ;;; Basic protocol.
 
-(export 'push-operator)
-(defgeneric push-operator (operator state)
-  (:documentation
-   "Push an OPERATOR onto the STATE's operator stack.
-
-   This should apply existing stacked operators as necessary to obey the
-   language's precedence rules."))
-
-(export 'push-value)
-(defgeneric push-value (value state)
-  (:documentation
-   "Push VALUE onto the STATE's value stack.
-
-   The default method just does that without any fuss.  It's unlikely that
-   this will need changing unless you invent some really weird values."))
-
-(export 'apply-operator)
-(defgeneric apply-operator (operator state)
-  (:documentation
-   "Apply the OPERATOR to argument on the STATE's value stack.
-
-   This should pop any necessary arguments, and push the result."))
-
 (export 'operator-push-action)
 (defgeneric operator-push-action (left right)
   (:documentation
@@ -87,16 +64,55 @@
    protocol.  The final output of the `expr' parse is the result of
    evaluating the parsed expression.  (Of course, the definition of
    `evaluation' here is determined entirely by the methods on
-   `apply-operator', so the final value may be a parse tree, for example.)"
+   `apply-operator', so the final value may be a parse tree, for example.)
+
+   Alternatively, the BINOP, PREOP, and POSTOP parsers may be /lists/ of
+   parsers (distinguished because the head of a parser form is expected to be
+   an atom).  These are implicitly `or'red together.  Within such a list, a
+   parser form beginning `:op' is given special interpretation.  The syntax
+   is expected to be
+
+       (:op MAKE-OP RECOG &rest ARGS)
+
+   which has the following effects:
+
+     * around the expression parser, the expression
+
+       (MAKE-OP . ARGS)
+
+      is evaluated once and the result stashed away; and
+
+    * a parser of the form
+
+       (seq (RECOG) OP)
+
+      is added as one of the alternatives of the disjunction, where OP is the
+      cached operator built in the first step."
 
   (flet ((wrap (parser)
           `(parser (,nestedp)
              (declare (ignorable ,nestedp))
-             ,parser)))
-    `(parse-expression ,(wrap operand)
-                      ,(wrap binop)
-                      ,(wrap preop)
-                      ,(wrap postop))))
+             ,parser))
+        (hack-oplist (oplist)
+          (if (or (atom oplist) (atom (car oplist))) (values nil oplist)
+              (let ((binds nil) (ops nil))
+                (dolist (op oplist)
+                  (if (and (consp op) (eq (car op) :op))
+                      (destructuring-bind
+                          (recog make-op &rest args) (cdr op)
+                        (with-gensyms (var)
+                          (push `(,var (,make-op ,@args)) binds)
+                          (push `(seq ((nil ,recog)) ,var) ops)))
+                      (push op ops)))
+                (values (nreverse binds) `(or ,@(nreverse ops)))))))
+    (multiple-value-bind (binvars binops) (hack-oplist binop)
+      (multiple-value-bind (prevars preops) (hack-oplist preop)
+       (multiple-value-bind (postvars postops) (hack-oplist postop)
+         `(let (,@binvars ,@prevars ,@postvars)
+            (parse-expression ,(wrap operand)
+                              ,(wrap binops)
+                              ,(wrap preops)
+                              ,(wrap postops))))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Numerical precedence.
@@ -149,9 +165,7 @@
    Prefix operators are special because they are pushed at a time when the
    existing topmost operator on the stack may not have its operand
    available.  It is therefore incorrect to attempt to apply any existing
-   operators without careful checking.  This class provides a method on
-   `push-operator' which immediately pushes the new operator without
-   inspecting the existing stack."))
+   operators without careful checking."))
 
 (export 'simple-operator)
 (defclass simple-operator ()