X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3dca7758421664a838c54b273bd9221f02072045..refs/heads/master:/src/parser/parser-expr-proto.lisp

diff --git a/src/parser/parser-expr-proto.lisp b/src/parser/parser-expr-proto.lisp
index ec35445..c4b433f 100644
--- a/src/parser/parser-expr-proto.lisp
+++ b/src/parser/parser-expr-proto.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -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 message 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,21 +64,61 @@
    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.
 
-(export '(operator-left-precedence operator-right-precedence))
+(export '(operator-left-precedence operator-right-precedence
+	  operator-associativity))
 (defgeneric operator-left-precedence (operator)
   (:documentation
    "Return the OPERATOR's left-precedence.
@@ -148,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 ()