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 ec35445..c4b433f 100644 (file)
--- a/src/parser/parser-expr-proto.lisp
+++ b/src/parser/parser-expr-proto.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
 
 ;;;----- 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
 ;;;
 ;;; 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.
 
 ;;;--------------------------------------------------------------------------
 ;;; 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
 (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
    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))
 
   (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.
 
 
 ;;;--------------------------------------------------------------------------
 ;;; 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.
 (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
    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 ()
 
 (export 'simple-operator)
 (defclass simple-operator ()