Overhauled operator precedence handling.

In particular the changes here cleaned up unary operator handling,
which was badly broken.

diff --git a/src/printer.lisp b/src/printer.lisp
index c1ec4a8..9205789 100644 (file)
--- a/src/printer.lisp
+++ b/src/printer.lisp
@@ -88,8 +88,7 @@ vice-versa.")
 (defun expression-precedence (expr)
   (if (consp expr)
       (case (car expr)
-        (js-aref (op-precedence 'js-aref))
-        (js-slot-value (op-precedence 'js-slot-value))
+        ((js-slot-value js-aref) (op-precedence (car expr)))
         (js-assign (op-precedence '=))
         (js-expression-if (op-precedence 'js-expression-if))
         (unary-operator (op-precedence (second expr)))
@@ -102,23 +101,21 @@ vice-versa.")
 
   ;;; generate the operator precedences from *OP-PRECEDENCES*
   (let ((precedence 1))
-    (dolist (ops '((js-aref)
-                   (js-slot-value)
-                   (! not ~)
+    (dolist (ops '((new js-slot-value js-aref)
+                   (postfix++ postfix--)
+                   (delete void typeof ++ -- unary+ unary- ~ !)
                    (* / %)
                    (+ -)
-                   (<< >>)
-                   (>>>)
-                   (< > <= >=)
-                   (in js-expression-if)
-                   (eql == != =)
-                   (=== !==)
+                   (<< >> >>>)
+                   (< > <= >= js-instance-of in)
+                   (== != === !== eql)
                    (&)
                    (^)
                    (\|)
                    (\&\& and)
                    (\|\| or)
-                   (js-assign *= /= %= += -= <<= >>= >>>= \&= ^= \|=)
+                   (js-expression-if)
+                   (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|= js-assign)
                    (comma)))
       (dolist (op ops)
         (let ((op-name (symbol-name op)))
@@ -176,12 +173,16 @@ vice-versa.")
             (ps-print arg))
         (when remaining (format *ps-output-stream* " ~(~A~) " op))))
 
-(defprinter unary-operator (op arg &key prefix)
-  (when prefix (psw op))
-  (if (and (listp arg) (eql 'operator (car arg)))
+(defprinter unary-operator (op arg &key prefix space)
+  (when prefix (format *ps-output-stream* "~(~a~)~:[~; ~]" op space))
+  (if (> (expression-precedence arg)
+         (op-precedence (case op
+                          (+ 'unary+)
+                          (- 'unary-)
+                          (t op))))
       (parenthesize-print arg)
       (ps-print arg))
-  (unless prefix (psw op)))
+  (unless prefix (format *ps-output-stream* "~(~a~)" op)))
 
 ;;; function and method calls
 (defprinter js-funcall (fun-designator args)
@@ -322,7 +323,11 @@ vice-versa.")
   (ps-print body-block))
 
 (defprinter js-for-in (var object body-block)
-  (psw "for (") (ps-print var) (psw " in ") (ps-print object) (psw ") ")
+  (psw "for (") (ps-print var) (psw " in ")
+  (if (> (expression-precedence object) (op-precedence 'in))
+      (parenthesize-print object)
+      (ps-print object))
+  (psw ") ")
   (ps-print body-block))
 
 (defprinter js-while (test body-block)
@@ -371,9 +376,6 @@ vice-versa.")
     (let ((slash (unless (first-slash-p regex) "/")))
       (format *ps-output-stream* (concatenate 'string slash "~A" slash) regex))))
 
-(defprinter js-return (value)
-  (psw "return ") (ps-print value))
-
 ;;; conditional compilation
 (defprinter cc-if (test body-forms)
   (psw "/*@if ")
@@ -386,8 +388,22 @@ vice-versa.")
   (psw "@end @*/"))
 
 (defprinter js-instanceof (value type)
-  (psw #\() (ps-print value) (psw " instanceof ") (ps-print type) (psw #\)))
+  (psw #\()
+  (if (> (expression-precedence value) (op-precedence 'js-instance-of))
+      (parenthesize-print value)
+      (ps-print value))
+  (psw " instanceof ")
+  (if (> (expression-precedence type) (op-precedence 'js-instance-of))
+      (parenthesize-print type)
+      (ps-print type))
+  (psw #\)))
+
+;;; named statements
+(macrolet ((def-stmt-printer (&rest stmts)
+             `(progn ,@(mapcar (lambda (stmt)
+                                 `(defprinter ,(intern (format nil "JS-~a" stmt)) (expr)
+                                    (format *ps-output-stream* "~(~a~) " ',stmt)
+                                    (ps-print expr)))
+                               stmts))))
+  (def-stmt-printer throw return))
 
-(defprinter js-named-operator (op value)
-  (format *ps-output-stream* "~(~A~) " op)
-  (ps-print value))

diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index 71d1575..7395e9f 100644 (file)
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -28,15 +28,28 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; unary operators
-(mapcar (lambda (op) (eval `(define-ps-special-form ,op (expecting value)
-                             (declare (ignore expecting))
-                             (list 'js-named-operator ',op (compile-parenscript-form value :expecting :expression)))))
-        '(throw delete void typeof new))
+(macrolet ((def-unary-ops (&rest ops)
+             `(progn ,@(mapcar (lambda (op)
+                                 (let ((op (if (listp op) (car op) op))
+                                       (spacep (if (listp op) (second op) nil)))
+                                   `(define-ps-special-form ,op (expecting x)
+                                      (declare (ignore expecting))
+                                      (list 'unary-operator ',op
+                                            (compile-parenscript-form x :expecting :expression)
+                                            :prefix t :space ,spacep))))
+                               ops))))
+  (def-unary-ops ~ ! (new t) (delete t) (void t) (typeof t)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; statements
 (define-ps-special-form return (expecting &optional value)
   (declare (ignore expecting))
   (list 'js-return (compile-parenscript-form value :expecting :expression)))
 
+(define-ps-special-form throw (expecting value)
+  (declare (ignore expecting))
+  (list 'js-throw (compile-parenscript-form value :expecting :expression)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; arrays
 (define-ps-special-form array (expecting &rest values)
@@ -68,21 +81,21 @@
 (define-ps-special-form incf (expecting x &optional (delta 1))
   (declare (ignore expecting))
   (if (equal delta 1)
-      (list 'unary-operator "++" (compile-parenscript-form x :expecting :expression) :prefix t)
+      (list 'unary-operator '++ (compile-parenscript-form x :expecting :expression) :prefix t)
       (list 'operator '+= (list (compile-parenscript-form x :expecting :expression)
                                 (compile-parenscript-form delta :expecting :expression)))))
 
 (define-ps-special-form decf (expecting x &optional (delta 1))
   (declare (ignore expecting))
   (if (equal delta 1)
-      (list 'unary-operator "--" (compile-parenscript-form x :expecting :expression) :prefix t)
+      (list 'unary-operator '-- (compile-parenscript-form x :expecting :expression) :prefix t)
       (list 'operator '-= (list (compile-parenscript-form x :expecting :expression)
                                 (compile-parenscript-form delta :expecting :expression)))))
 
 (define-ps-special-form - (expecting first &rest rest)
   (declare (ignore expecting))
   (if (null rest)
-      (list 'unary-operator "-" (compile-parenscript-form first :expecting :expression) :prefix t)
+      (list 'unary-operator '- (compile-parenscript-form first :expecting :expression) :prefix t)
       (list 'operator '- (mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
                                  (cons first rest)))))
 
@@ -103,11 +116,7 @@
                             (!== '===)
                             (t nil))))
         (list 'operator not-op (third form))
-        (list 'unary-operator "!" form :prefix t))))
-
-(define-ps-special-form ~ (expecting x)
-  (declare (ignore expecting))
-  (list 'unary-operator "~" (compile-parenscript-form x :expecting :expression) :prefix t))
+        (list 'unary-operator '! form :prefix t))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; control structures