(let ((*indent-level* 0)
(*print-accumulator* ()))
(if (and (listp form) (eq 'js:block (car form))) ; ignore top-level block
- (loop for (statement . remaining) on (third form) do
+ (loop for (statement . remaining) on (cdr form) do
(ps-print statement) (psw ";") (when remaining (psw #\Newline)))
(ps-print form))
(nreverse *print-accumulator*)))
fun-designator)
(psw #\() (print-comma-delimited-list args) (psw #\)))
-(defprinter js:block (block-type statements)
- (case block-type
- (:statement
- (psw #\{)
- (incf *indent-level*)
- (dolist (statement statements)
- (newline-and-indent) (ps-print statement) (psw #\;))
- (decf *indent-level*)
- (newline-and-indent)
- (psw #\}))
- (:expression
- (psw #\()
- (loop for (statement . remaining) on statements do
- (ps-print statement) (when remaining (psw ", ")))
- (psw #\)))))
+(defprinter js:|,| (&rest expressions)
+ (psw #\()
+ (loop for (exp . remaining) on expressions do
+ (ps-print exp) (when remaining (psw ", ")))
+ (psw #\)))
+
+(defprinter js:block (&rest statements)
+ (psw #\{)
+ (incf *indent-level*)
+ (dolist (statement statements)
+ (newline-and-indent) (ps-print statement) (psw #\;))
+ (decf *indent-level*)
+ (newline-and-indent)
+ (psw #\}))
(defprinter js:lambda (args body)
(print-fun-def nil args body))
(progn (psw #\.) (psw (js-translate-symbol slot)))
(progn (psw #\[) (ps-print slot) (psw #\]))))
-(defprinter js:cond (clauses)
- (loop for (test body-block) in clauses
- for start = "if (" then " else if (" do
- (if (equalp test "true")
- (psw " else ")
- (progn (psw start)
- (ps-print test)
- (psw ") ")))
- (ps-print body-block)))
-
-(defprinter js:if (test then-block else-block)
+(defprinter js:if (test consequent &rest clauses)
(psw "if (") (ps-print test) (psw ") ")
- (ps-print then-block)
- (when else-block
- (psw " else ")
- (ps-print else-block)))
+ (ps-print consequent)
+ (loop while clauses do
+ (ecase (car clauses)
+ (:else-if (psw " else if (") (ps-print (cadr clauses)) (psw ") ")
+ (ps-print (caddr clauses))
+ (setf clauses (cdddr clauses)))
+ (:else (psw " else ")
+ (ps-print (cadr clauses))
+ (return)))))
(defprinter js:? (test then else)
(ps-print test)
(when body
(if (and (listp (car body))
(eq 'js:block (caar body)))
- (append (third (car body)) (flatten-blocks (cdr body)))
+ (append (cdr (car body)) (flatten-blocks (cdr body)))
(cons (car body) (flatten-blocks (cdr body))))))
(defun constant-literal-form-p (form)
(define-ps-special-form progn (&rest body)
(if (and (eq expecting :expression) (= 1 (length body)))
(compile-parenscript-form (car body) :expecting :expression)
- `(js:block
- ,expecting
- ,(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
- (compile-parenscript-form form :expecting expecting))
- body)))))
+ `(,(if (eq expecting :expression) 'js:|,| 'js:block)
+ ,@(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
+ (compile-parenscript-form form :expecting expecting))
+ body)))))
(append (remove-if #'constant-literal-form-p (butlast block)) (last block))))))
(define-ps-special-form cond (&rest clauses)
(ecase expecting
- (:statement `(js:cond ,(mapcar (lambda (clause)
- (destructuring-bind (test &rest body)
- clause
- (list (compile-parenscript-form test :expecting :expression)
- (compile-parenscript-form `(progn ,@body) :expecting :statement))))
- clauses)))
+ (:statement `(js:if ,(compile-parenscript-form (caar clauses) :expecting :expression)
+ ,(compile-parenscript-form `(progn ,@(cdar clauses)))
+ ,@(loop for (test . body) in (cdr clauses) appending
+ (if (eq t test)
+ `(:else ,(compile-parenscript-form `(progn ,@body) :expecting :statement))
+ `(:else-if ,(compile-parenscript-form test :expecting :expression)
+ ,(compile-parenscript-form `(progn ,@body) :expecting :statement))))))
(:expression (make-cond-clauses-into-nested-ifs clauses))))
(defun make-cond-clauses-into-nested-ifs (clauses)
(ecase expecting
(:statement `(js:if ,(compile-parenscript-form test :expecting :expression)
,(compile-parenscript-form `(progn ,then))
- ,(when else (compile-parenscript-form `(progn ,else)))))
+ ,@(when else `(:else ,(compile-parenscript-form `(progn ,else))))))
(:expression `(js:? ,(compile-parenscript-form test :expecting :expression)
,(compile-parenscript-form then :expecting :expression)
,(compile-parenscript-form else :expecting :expression)))))