< 2) && (2 < 3) instead of 1 < 2 < 3).
;;; 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:
(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}
(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 "<br/>")))
=> 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]) {
;;; form predicates
+(defun comparison-form-p (form)
+ (member (car form) '(< > <= >= == != === !==)))
+
(defun op-form-p (form)
(and (listp form)
(not (ps-special-form-p form))
(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 '\&\&)
(= '\=\=)
(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)
#:>>>
#:< #:> #:<= #:>=
#:in
- #:eql #:== #:!= #:=
+ #:== #:!= #:=
#:=== #:!==
#:&
#:^
(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))
(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
(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)
};")
(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?
(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);
+};")
"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);
(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 "<br/>")))
"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]) {
HCoop / clinton / parenscript.git / commitdiff