(defvar *js-operator-precedence* 1000)
(defvar *js-operator-associativity* 'left)
+;; Format an expression optionally wrapped with parenthesis if the
+;; precedence rules require it.
+(defmacro with-operator ((precedence associativity) &body body)
+ (let ((g!parens (gensym))
+ (g!precedence (gensym)))
+ `(let* ((,g!precedence ,precedence)
+ (,g!parens
+ (cond
+ ((> ,g!precedence *js-operator-precedence*))
+ ((< ,g!precedence *js-operator-precedence*) nil)
+ (t
+ t)))
+ (*js-operator-precedence* ,g!precedence)
+ (*js-operator-associativity* ,associativity))
+ (when ,g!parens (js-format "("))
+ (progn ,@body)
+ (when ,g!parens (js-format ")")))))
+
(defun js-operator-expression (op args)
- (macrolet (;; Format an expression optionally wrapped with
- ;; parenthesis if the precedence rules require it.
- (with-operator ((level associativity) &body body)
- (let ((g!parens (gensym))
- (g!level (gensym)))
- `(let* ((,g!level ,level)
- (,g!parens
- (cond
- ((> ,g!level *js-operator-precedence*))
- ((< ,g!level *js-operator-precedence*) nil)
- (t
- t)))
- (*js-operator-precedence* ,g!level)
- (*js-operator-associativity* ,associativity))
- (when ,g!parens (js-format "("))
- (progn ,@body)
- (when ,g!parens (js-format ")"))))))
- (let ((op1 (car args))
- (op2 (cadr args)))
- (case op
- ;; Comma (,)
- ((progn comma)
- (with-operator (14 'left)
- (js-expr (car args))
- (dolist (operand (cdr args))
+ (let ((op1 (car args))
+ (op2 (cadr args)))
+ (case op
+ ;; Comma (,)
+ ((progn comma)
+ (with-operator (14 'left)
+ (js-expr (car args))
+ (dolist (operand (cdr args))
+ (let ((*js-output* t))
+ (js-format ",")
+ (js-expr operand)))))
+ ;; Function call
+ (call
+ (js-expr (car args))
+ (js-format "(")
+ (when (cdr args)
+ (with-operator (13 'left)
+ (js-expr (cadr args))
+ (dolist (operand (cddr args))
(let ((*js-output* t))
(js-format ",")
(js-expr operand)))))
- ;; Function call
- (call
- (js-expr (car args))
- (js-format "(")
- (when (cdr args)
- (with-operator (13 'left)
- (js-expr (cadr args))
- (dolist (operand (cddr args))
- (let ((*js-output* t))
- (js-format ",")
- (js-expr operand)))))
- (js-format ")"))
- ;; Accessors
- (get
- (multiple-value-bind (identifier identifierp)
- (valid-js-identifier (car args))
- (multiple-value-bind (accessor accessorp)
- (valid-js-identifier (cadr args))
- (cond
- ((and identifierp accessorp)
- (js-identifier identifier)
- (js-format ".")
- (js-identifier accessor))
- (t
- (js-expr (car args))
- (js-format "[")
- (js-expr (cadr args))
- (js-format "]"))))))
- ;; Object syntax
- (object
- (js-object-initializer args))
- ;; Function expressions
- (function
- (js-format "(")
- (apply #'js-function args)
- (js-format ")"))
- (t
- (flet ((%unary-op (operator string precedence associativity post lvalue)
- (when (eq op operator)
- (with-operator (precedence associativity)
- (when lvalue (check-lvalue op1))
- (cond
- (post
- (js-expr op1)
- (js-format string))
- (t
- (js-format string)
- (js-expr op1))))
- (return-from js-operator-expression)))
- (%binary-op (operator string precedence associativity lvalue)
- (when (eq op operator)
+ (js-format ")"))
+ ;; Accessors
+ (get
+ (multiple-value-bind (identifier identifierp)
+ (valid-js-identifier (car args))
+ (multiple-value-bind (accessor accessorp)
+ (valid-js-identifier (cadr args))
+ (cond
+ ((and identifierp accessorp)
+ (js-identifier identifier)
+ (js-format ".")
+ (js-identifier accessor))
+ (t
+ (js-expr (car args))
+ (js-format "[")
+ (js-expr (cadr args))
+ (js-format "]"))))))
+ ;; Object syntax
+ (object
+ (js-object-initializer args))
+ ;; Function expressions
+ (function
+ (js-format "(")
+ (apply #'js-function args)
+ (js-format ")"))
+ (t
+ (flet ((%unary-op (operator string precedence associativity post lvalue)
+ (when (eq op operator)
+ (with-operator (precedence associativity)
(when lvalue (check-lvalue op1))
- (with-operator (precedence associativity)
- (js-expr op1)
- (js-format string)
- (js-expr op2))
- (return-from js-operator-expression))))
+ (cond
+ (post
+ (js-expr op1)
+ (js-format string))
+ (t
+ (js-format string)
+ (js-expr op1))))
+ (return-from js-operator-expression)))
+ (%binary-op (operator string precedence associativity lvalue)
+ (when (eq op operator)
+ (when lvalue (check-lvalue op1))
+ (with-operator (precedence associativity)
+ (js-expr op1)
+ (js-format string)
+ (js-expr op2))
+ (return-from js-operator-expression))))
- (macrolet ((unary-op (operator string precedence associativity &key post lvalue)
- `(%unary-op ',operator ',string ',precedence ',associativity ',post ',lvalue))
- (binary-op (operator string precedence associativity &key lvalue)
- `(%binary-op ',operator ',string ',precedence ',associativity ',lvalue)))
+ (macrolet ((unary-op (operator string precedence associativity &key post lvalue)
+ `(%unary-op ',operator ',string ',precedence ',associativity ',post ',lvalue))
+ (binary-op (operator string precedence associativity &key lvalue)
+ `(%binary-op ',operator ',string ',precedence ',associativity ',lvalue)))
- (unary-op pre++ "++" 1 right :lvalue t)
- (unary-op pre-- "--" 1 right :lvalue t)
- (unary-op post++ "++" 1 right :lvalue t :post t)
- (unary-op post-- "--" 1 right :lvalue t :post t)
- (unary-op not-- "!" 1 right)
- (unary-op unary+ "+" 1 right)
- (unary-op unary- "-" 1 right)
- (unary-op delete "delete " 1 right)
- (unary-op void "void " 1 right)
- (unary-op typeof "typeof " 1 right)
- (unary-op new "new " 1 right)
+ (unary-op pre++ "++" 1 right :lvalue t)
+ (unary-op pre-- "--" 1 right :lvalue t)
+ (unary-op post++ "++" 1 right :lvalue t :post t)
+ (unary-op post-- "--" 1 right :lvalue t :post t)
+ (unary-op not-- "!" 1 right)
+ (unary-op unary+ "+" 1 right)
+ (unary-op unary- "-" 1 right)
+ (unary-op delete "delete " 1 right)
+ (unary-op void "void " 1 right)
+ (unary-op typeof "typeof " 1 right)
+ (unary-op new "new " 1 right)
- (binary-op * "*" 2 left)
- (binary-op / "/" 2 left)
- (binary-op mod "%" 2 left)
- (binary-op % "%" 2 left)
- (binary-op + "+" 3 left)
- (binary-op - "-" 3 left)
- (binary-op << "<<" 4 left)
- (binary-op >> "<<" 4 left)
- (binary-op >>> ">>>" 4 left)
- (binary-op <= "<=" 5 left)
- (binary-op < "<" 5 left)
- (binary-op > ">" 5 left)
- (binary-op >= ">=" 5 left)
- (binary-op instanceof " instanceof " 5 left)
- (binary-op in " in " 5 left)
- (binary-op == "==" 6 left)
- (binary-op != "!=" 6 left)
- (binary-op === "===" 6 left)
- (binary-op !== "!==" 6 left)
- (binary-op bit-and "&" 7 left)
- (binary-op bit-xor "^" 8 left)
- (binary-op bit-or "|" 9 left)
- (binary-op and "&&" 10 left)
- (binary-op or "||" 11 left)
- (binary-op = "=" 13 right :lvalue t)
- (binary-op += "+=" 13 right :lvalue t)
- (binary-op incf "+=" 13 right :lvalue t)
- (binary-op -= "-=" 13 right :lvalue t)
- (binary-op decf "-=" 13 right :lvalue t)
- (binary-op *= "*=" 13 right :lvalue t)
- (binary-op /= "*=" 13 right :lvalue t)
- (binary-op bit-xor= "^=" 13 right :lvalue t)
- (binary-op bit-and= "&=" 13 right :lvalue t)
- (binary-op bit-or= "|=" 13 right :lvalue t)
- (binary-op <<= "<<=" 13 right :lvalue t)
- (binary-op >>= ">>=" 13 right :lvalue t)
- (binary-op >>>= ">>>=" 13 right :lvalue t)
+ (binary-op * "*" 2 left)
+ (binary-op / "/" 2 left)
+ (binary-op mod "%" 2 left)
+ (binary-op % "%" 2 left)
+ (binary-op + "+" 3 left)
+ (binary-op - "-" 3 left)
+ (binary-op << "<<" 4 left)
+ (binary-op >> "<<" 4 left)
+ (binary-op >>> ">>>" 4 left)
+ (binary-op <= "<=" 5 left)
+ (binary-op < "<" 5 left)
+ (binary-op > ">" 5 left)
+ (binary-op >= ">=" 5 left)
+ (binary-op instanceof " instanceof " 5 left)
+ (binary-op in " in " 5 left)
+ (binary-op == "==" 6 left)
+ (binary-op != "!=" 6 left)
+ (binary-op === "===" 6 left)
+ (binary-op !== "!==" 6 left)
+ (binary-op bit-and "&" 7 left)
+ (binary-op bit-xor "^" 8 left)
+ (binary-op bit-or "|" 9 left)
+ (binary-op and "&&" 10 left)
+ (binary-op or "||" 11 left)
+ (binary-op = "=" 13 right :lvalue t)
+ (binary-op += "+=" 13 right :lvalue t)
+ (binary-op incf "+=" 13 right :lvalue t)
+ (binary-op -= "-=" 13 right :lvalue t)
+ (binary-op decf "-=" 13 right :lvalue t)
+ (binary-op *= "*=" 13 right :lvalue t)
+ (binary-op /= "*=" 13 right :lvalue t)
+ (binary-op bit-xor= "^=" 13 right :lvalue t)
+ (binary-op bit-and= "&=" 13 right :lvalue t)
+ (binary-op bit-or= "|=" 13 right :lvalue t)
+ (binary-op <<= "<<=" 13 right :lvalue t)
+ (binary-op >>= ">>=" 13 right :lvalue t)
+ (binary-op >>>= ">>>=" 13 right :lvalue t)
- (when (member op '(? if))
- (with-operator (12 'right)
- (js-expr (first args))
- (js-format "?")
- (js-expr (second args))
- (js-format ":")
- (js-expr (third args)))))))))))
+ (when (member op '(? if))
+ (with-operator (12 'right)
+ (js-expr (first args))
+ (js-format "?")
+ (js-expr (second args))
+ (js-format ":")
+ (js-expr (third args))))))))))
(defun js-expr (form)
(js-format ";"))
(case (car form)
(label
- (js-identifier (cadr form))
- (js-format ":")
- (js-stmt `(progn ,@(cddr form))))
+ (destructuring-bind (label &body body) form
+ (js-identifier label)
+ (js-format ":")
+ (js-stmt `(progn ,@body))))
(break
- (js-format "break ")
- (js-identifier (second form))
- (js-format ";"))
+ (destructuring-bind (label) form
+ (js-format "break ")
+ (js-identifier label)
+ (js-format ";")))
(return
- (js-format "return ")
- (js-expr (cadr form))
- (js-format ";"))
+ (destructuring-bind (value) form
+ (js-format "return ")
+ (js-expr value)
+ (js-format ";")))
(var
(destructuring-bind (var &rest vars) (cdr form)
(js-format "var ")
projects / jscl.git / commitdiff