Fixed bug where (setf x (- x 1 2)) yielded x -= 1 - 2.

diff --git a/docs/reference.lisp b/docs/reference.lisp
index cd05acb..44093b2 100644 (file)
--- a/docs/reference.lisp
+++ b/docs/reference.lisp
@@ -499,8 +499,6 @@ a-variable  => aVariable
 ;;; operator expression using this variable into a more "efficient"
 ;;; assignment operator form. For example:
 
-(setf a (1+ a))          => a++;
-
 (setf a (+ a 2 3 4 a))   => a += 2 + 3 + 4 + a;
 
 (setf a (- 1 a))         => a = 1 - a;

diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index 9da9102..4f39744 100644 (file)
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -503,20 +503,12 @@ lambda-list::=
   (if (and (listp rhs)
            (eql 'operator (car rhs))
           (member lhs (third rhs) :test #'equalp))
-      (let ((args-without (remove lhs (third rhs) :count 1 :test #'equalp))
-           (args-without-first (remove lhs (third rhs) :count 1 :end 1 :test #'equalp)))
-       (cond ((and (equal (car args-without) 1) (eql (second rhs) '+))
-              (list 'unary-operator "++" lhs :prefix nil))
-             ((and (equal (second args-without-first) 1) (eql (second rhs) '-))
-              (list 'unary-operator "--" lhs :prefix nil))
-             ((and (assignment-op (second rhs))
+      (let ((args-without-first (remove lhs (third rhs) :count 1 :end 1 :test #'equalp)))
+       (cond ((and (assignment-op (second rhs))
                    (member (second rhs) '(+ *))
                     (equalp lhs (first (third rhs))))
               (list 'operator (assignment-op (second rhs))
                      (list lhs (list 'operator (second rhs) args-without-first))))
-             ((and (assignment-op (second rhs)) (equalp (first (third rhs)) lhs))
-              (list 'operator (assignment-op (second rhs))
-                     (list lhs (list 'operator (second rhs) (cdr (third rhs))))))
              (t (list 'js-assign lhs rhs))))
       (list 'js-assign lhs rhs)))
 

diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 4d5a7ec..715461b 100644 (file)
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -479,3 +479,11 @@ try {
 (test-ps-js literal2
   (aref this x)
   "this[x]")
+
+(test-ps-js setf-dec1
+  (setf x (- 1 x 2))
+  "x = 1 - x - 2;")
+
+(test-ps-js setf-dec2
+  (setf x (- x 1 2))
+  "x = x - 1 - 2;")

diff --git a/t/reference-tests.lisp b/t/reference-tests.lisp
index a90792e..33b4207 100644 (file)
--- a/t/reference-tests.lisp
+++ b/t/reference-tests.lisp
@@ -254,42 +254,38 @@ c = 4;
 x = a + b + c;")
 
 (test-ps-js assignment-3
-  (setf a (1+ a))
-  "a++;")
-
-(test-ps-js assignment-4
   (setf a (+ a 2 3 4 a))
   "a += 2 + 3 + 4 + a;")
 
-(test-ps-js assignment-5
+(test-ps-js assignment-4
   (setf a (- 1 a))
   "a = 1 - a;")
 
-(test-ps-js assignment-6
+(test-ps-js assignment-5
   (defun (setf color) (new-color el)
   (setf (slot-value (slot-value el 'style) 'color) new-color))
   "function __setf_color(newColor, el) {
   el.style.color = newColor;
 };")
 
-(test-ps-js assignment-7
+(test-ps-js assignment-6
   (setf (color some-div) (+ 23 "em"))
   "var _js2 = someDiv;
 var _js1 = 23 + 'em';
 __setf_color(_js1, _js2);")
 
-(test-ps-js assignment-8
+(test-ps-js assignment-7
   (defsetf left (el) (offset)
   `(setf (slot-value (slot-value ,el 'style) 'left) ,offset))
   "null")
 
-(test-ps-js assignment-9
+(test-ps-js assignment-8
   (setf (left some-div) (+ 123 "px"))
   "var _js2 = someDiv;
 var _js1 = 123 + 'px';
 _js2.style.left = _js1;")
 
-(test-ps-js assignment-10
+(test-ps-js assignment-9
   (progn (defmacro left (el)
          `(slot-value ,el 'offset-left))
        (left some-div))