From: Vladimir Sedach Date: Fri, 7 Aug 2009 04:21:11 +0000 (-0600) Subject: Fixed nary comparison operators (ex: (< 1 2 3) should translate to (1 X-Git-Url: https://git.hcoop.net/clinton/parenscript.git/commitdiff_plain/a14fb2cb9bce1d6956cc9be3a7e7b67451b7032f Fixed nary comparison operators (ex: (< 1 2 3) should translate to (1 < 2) && (2 < 3) instead of 1 < 2 < 3). --- diff --git a/docs/reference.lisp b/docs/reference.lisp index ee01716..9af69c9 100644 --- a/docs/reference.lisp +++ b/docs/reference.lisp @@ -349,16 +349,12 @@ a-variable => aVariable; ;;; operator as function name. ;;; ;;; Please note that `=' is converted to `==' in JavaScript. The `=' -;;; Parenscript operator is not the assignment operator. Unlike -;;; JavaScript, Parenscript supports multiple arguments to the -;;; operators. +;;; Parenscript operator is not the assignment operator. (* 1 2) => 1 * 2; (= 1 2) => 1 == 2; -(eql 1 2) => 1 == 2; - ;;; Note that the resulting expression is correctly parenthesized, ;;; according to the JavaScript operator precedence that can be found ;;; in table form at: @@ -384,14 +380,11 @@ a-variable => aVariable; (1+ i) => i + 1; -;;; The `not' operator actually optimizes the code a bit. If `not' is -;;; used on another boolean-returning operator, the operator is -;;; reversed. +;;; If `not' is used on another boolean-returning operator, the +;;; operator is reversed. (not (< i 2)) => i >= 2; -(not (eql i 2)) => i != 2; - ;;;# Body forms ;;;t \index{body form} ;;;t \index{PROGN} @@ -775,7 +768,7 @@ a-variable => aVariable; (do* ((a) b (c (array "a" "b" "c" "d" "e")) (d 0 (1+ d)) (e (aref c d) (aref c d))) - ((or (= d (@ c length)) (eql e "x"))) + ((or (= d (@ c length)) (== e "x"))) (setf a d b e) ((@ document write) (+ "a: " a " b: " b "
"))) => for (var a = null, b = null, c = ['a', 'b', 'c', 'd', 'e'], d = 0, e = c[d]; !(d == c.length || e == 'x'); d += 1, e = c[d]) { diff --git a/src/compiler.lisp b/src/compiler.lisp index 9c912a1..9933be1 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -65,6 +65,9 @@ lexical block.") ;;; form predicates +(defun comparison-form-p (form) + (member (car form) '(< > <= >= == != === !==))) + (defun op-form-p (form) (and (listp form) (not (ps-special-form-p form)) @@ -225,6 +228,28 @@ the form cannot be compiled to a symbol." (error "Attempting to use Parenscript special form ~a as variable" symbol))) (t `(js:variable ,symbol)))) +;;; operators + +(defun op-precedence (op) + (position op + '((js:new js:slot-value js:aref) + (postfix++ postfix--) + (delete void typeof ++ -- unary+ unary- ~ !) + (* / %) + (+ -) + (<< >> >>>) + (< > <= >= js:instanceof js:in) + (== != === !==) + (&) + (^) + (\|) + (\&\& and) + (\|\| or) + (js:?) + (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|=) + (comma)) + :test #'member)) + (defun ps-convert-op-name (op) (case op (and '\&\&) @@ -234,28 +259,59 @@ the form cannot be compiled to a symbol." (= '\=\=) (t op))) +(defun maybe-fix-nary-comparison-form (form) + (if (< 2 (length (cdr form))) + (values + (let* ((operator (car form)) + (tmp-var-forms (butlast (cddr form))) + (tmp-vars (loop repeat (length tmp-var-forms) + collect (ps-gensym "_cmp"))) + (all-comparisons (append (list (cadr form)) + tmp-vars + (last form)))) + `(let ,(mapcar #'list tmp-vars tmp-var-forms) + (and ,@(loop for x1 in all-comparisons + for x2 in (cdr all-comparisons) + collect (list operator x1 x2))))) + t) + form)) + +(defun compile-op-form (form) + `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) + ,@(mapcar (lambda (form) + (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) + (cdr form)))) + +(defun compile-funcall-form (form) + `(js:funcall + ,(compile-parenscript-form (if (symbolp (car form)) + (maybe-rename-local-function (car form)) + (ps-macroexpand (car form))) + :expecting :expression) + ,@(mapcar (lambda (arg) + (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) + (cdr form)))) + (defmethod compile-parenscript-form ((form cons) &key (expecting :statement)) (multiple-value-bind (form expanded-p) (ps-macroexpand form) - (let ((*ps-compilation-level* (if expanded-p - *ps-compilation-level* - (adjust-ps-compilation-level form *ps-compilation-level*)))) - (cond (expanded-p (compile-parenscript-form form :expecting expecting)) - ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) - ((op-form-p form) - `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) - ,@(mapcar (lambda (form) - (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) - (cdr form)))) - ((funcall-form-p form) - `(js:funcall ,(compile-parenscript-form (if (symbolp (car form)) - (maybe-rename-local-function (car form)) - (ps-macroexpand (car form))) - :expecting :expression) - ,@(mapcar (lambda (arg) - (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) - (cdr form)))) - (t (error "Cannot compile ~S to a ParenScript form." form)))))) + (let ((*ps-compilation-level* + (if expanded-p + *ps-compilation-level* + (adjust-ps-compilation-level form *ps-compilation-level*)))) + (cond (expanded-p + (compile-parenscript-form form :expecting expecting)) + ((ps-special-form-p form) + (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) + ((comparison-form-p form) + (multiple-value-bind (form fixed?) + (maybe-fix-nary-comparison-form form) + (if fixed? + (compile-parenscript-form form :expecting expecting) + (compile-op-form form)))) + ((op-form-p form) (compile-op-form form)) + ((funcall-form-p form) (compile-funcall-form form)) + (t (error "Cannot compile ~S to a ParenScript form." form)))))) (defvar *ps-gensym-counter* 0) diff --git a/src/package.lisp b/src/package.lisp index b31fbe6..4920538 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -32,7 +32,7 @@ #:>>> #:< #:> #:<= #:>= #:in - #:eql #:== #:!= #:= + #:== #:!= #:= #:=== #:!== #:& #:^ diff --git a/src/printer.lisp b/src/printer.lisp index f5cd41a..edaa39d 100644 --- a/src/printer.lisp +++ b/src/printer.lisp @@ -88,35 +88,8 @@ arguments, defines a printer for that form using the given body." (js:? (op-precedence 'js:?)) (js:unary-operator (op-precedence (second expr))) (operator (op-precedence (second expr))) - (otherwise 0)) - 0)) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *op-precedence-hash* (make-hash-table :test 'eq)) - - (let ((precedence 1)) - (dolist (ops '((js:new js:slot-value js:aref) - (postfix++ postfix--) - (delete void typeof ++ -- unary+ unary- ~ !) - (* / %) - (+ -) - (<< >> >>>) - (< > <= >= js:instanceof js:in) - (== != === !== eql) - (&) - (^) - (\|) - (\&\& and) - (\|\| or) - (js:?) - (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|=) - (comma))) - (dolist (op ops) - (setf (gethash op *op-precedence-hash*) precedence)) - (incf precedence))) - - (defun op-precedence (op) - (gethash op *op-precedence-hash*))) + (otherwise -1)) + -1)) (defprinter js:literal (str) (psw str)) @@ -129,7 +102,7 @@ arguments, defines a printer for that form using the given body." (psw #\[) (print-comma-delimited-list initial-contents) (psw #\])) (defprinter js:aref (array indices) - (if (>= (expression-precedence array) #.(op-precedence 'js:aref)) + (if (>= (expression-precedence array) (op-precedence 'js:aref)) (parenthesize-print array) (ps-print array)) (loop for idx in indices do @@ -208,7 +181,7 @@ arguments, defines a printer for that form using the given body." (psw " }")) (defprinter js:slot-value (obj slot) - (if (or (> (expression-precedence obj) #.(op-precedence 'js:slot-value)) + (if (or (> (expression-precedence obj) (op-precedence 'js:slot-value)) (numberp obj) (and (listp obj) (member (car obj) '(js:lambda js:object)))) (parenthesize-print obj) diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index 32ab88c..264db66 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -516,9 +516,16 @@ __setf_someThing(_js1, _js2, _js3);") };") (test-ps-js cond-expression-final-t-clause - (defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)) ((= a b) (+ c d)) ((< 1 2 3 4 5) x) (t "foo")))) + (defun foo () + (return (cond ((< 1 2) (bar "foo") (* 4 5)) + ((= a b) (+ c d)) + ((< 1 2 3 4 5) x) + (t "foo")))) "function foo() { - return 1 < 2 ? (bar('foo'), 4 * 5) : (a == b ? c + d : (1 < 2 < 3 < 4 < 5 ? x : 'foo')); + var _cmp3; + var _cmp2; + var _cmp1; + return 1 < 2 ? (bar('foo'), 4 * 5) : (a == b ? c + d : ((_cmp1 = 2, _cmp2 = 3, _cmp3 = 4, 1 < _cmp1 && _cmp1 < _cmp2 && _cmp2 < _cmp3 && _cmp3 < 5) ? x : 'foo')); };") (test-ps-js cond-expression-middle-t-clause ;; should this signal a warning? @@ -1179,3 +1186,10 @@ x1 - x1; (test-ps-js slot-value-keyword (slot-value foo :bar) "foo['bar'];") + +(test-ps-js nary-comparison1 + (lambda () (return (< 1 2 3))) + "function () { + var _cmp1; + return (_cmp1 = 2, 1 < _cmp1 && _cmp1 < 3); +};") diff --git a/t/reference-tests.lisp b/t/reference-tests.lisp index 3f1c06a..6dc23b1 100644 --- a/t/reference-tests.lisp +++ b/t/reference-tests.lisp @@ -184,37 +184,29 @@ "1 == 2;") (test-ps-js operator-expressions-3 - (eql 1 2) - "1 == 2;") - -(test-ps-js operator-expressions-4 (* 1 (+ 2 3 4) 4 (/ 6 7)) "1 * (2 + 3 + 4) * 4 * (6 / 7);") -(test-ps-js operator-expressions-5 +(test-ps-js operator-expressions-4 (incf i) "++i;") -(test-ps-js operator-expressions-6 +(test-ps-js operator-expressions-5 (decf i) "--i;") -(test-ps-js operator-expressions-7 +(test-ps-js operator-expressions-6 (1- i) "i - 1;") -(test-ps-js operator-expressions-8 +(test-ps-js operator-expressions-7 (1+ i) "i + 1;") -(test-ps-js operator-expressions-9 +(test-ps-js operator-expressions-8 (not (< i 2)) "i >= 2;") -(test-ps-js operator-expressions-10 - (not (eql i 2)) - "i != 2;") - (test-ps-js body-forms-1 (progn (blorg i) (blafoo i)) "blorg(i); @@ -382,7 +374,7 @@ try { (do* ((a) b (c (array "a" "b" "c" "d" "e")) (d 0 (1+ d)) (e (aref c d) (aref c d))) - ((or (= d (@ c length)) (eql e "x"))) + ((or (= d (@ c length)) (== e "x"))) (setf a d b e) ((@ document write) (+ "a: " a " b: " b "
"))) "for (var a = null, b = null, c = ['a', 'b', 'c', 'd', 'e'], d = 0, e = c[d]; !(d == c.length || e == 'x'); d += 1, e = c[d]) {