(/debug "loading compiler-codegen.lisp!")
+(defvar *js-macros* nil)
+(defmacro define-js-macro (name lambda-list &body body)
+ (let ((form (gensym)))
+ `(push (cons ',name
+ (lambda (,form)
+ (block ,name
+ (destructuring-bind ,lambda-list ,form
+ ,@body))))
+ *js-macros*)))
+
+(defun js-macroexpand (js)
+ (if (and (consp js) (assoc (car js) *js-macros*))
+ (let ((expander (cdr (assoc (car js) *js-macros*))))
+ (multiple-value-bind (expansion stop-expand-p)
+ (funcall expander (cdr js))
+ (if stop-expand-p
+ expansion
+ (js-macroexpand expansion))))
+ js))
+
+
(defconstant no-comma 12)
(defvar *js-output* t)
(reduce (lambda (x y) `(,(car form) ,x ,y)) (cdr form)))
((progn comma)
(reduce (lambda (x y) `(comma ,x ,y)) (cdr form) :from-end t))
- (t form))
+ (t
+ (js-macroexpand form)))
form))
(defun js-operator-expression (op args precedence associativity operand-order)
(let ((op1 (car args))
(op2 (cadr args)))
(case op
- ;; Transactional compatible operator
- (code
- (js-format "~a" (apply #'code args)))
;; Accessors
(property
(js-expr (car args) 0)
(t
`(group ,@(cdr form))))))
(t
- form)))
+ (js-macroexpand form))))
(defun js-stmt (form &optional parent)
(let ((form (js-expand-stmt form)))
(js-format ";")))
(t
(case (car form)
- (code
- (js-format "~a" (apply #'code (cdr form))))
(label
(destructuring-bind (label &body body) (cdr form)
(js-identifier label)
(js-expr value)
(js-format "){")
(dolist (case cases)
- (destructuring-bind (x &body body) case
- (if (eq x 'default)
- (js-format "default: ")
- (progn
- (unless (or (stringp x) (numberp x))
- (error "Non-constant switch case `~S'." (car cases)))
- (js-format "case ")
- (js-expr x)
- (js-format ":")))
- (mapc #'js-stmt body)))
+ (cond
+ ((and (consp case) (eq (car case) 'case))
+ (js-format "case ")
+ (let ((value (cadr case)))
+ (unless (or (stringp value) (integerp value))
+ (error "Non-constant switch case `~S'." value))
+ (js-expr value))
+ (js-format ":"))
+ ((eq case 'default)
+ (js-format "default:"))
+ (t
+ (js-stmt case))))
(js-format "}")))
(for
(destructuring-bind ((start condition step) &body body) (cdr form)