-(defun make-for-vars (decls)
- (loop for decl in decls
- for var = (if (atom decl) decl (first decl))
- for init-value = (if (atom decl) nil (second decl))
- collect (cons (compile-parenscript-form var :expecting :symbol) (compile-parenscript-form init-value))))
-
-(defun make-for-steps (decls)
- (loop for decl in decls
- when (= (length decl) 3)
- collect (compile-parenscript-form (third decl) :expecting :expression)))
-
-(define-ps-special-form do (expecting decls termination-test &rest body)
- (declare (ignore expecting))
- (let ((vars (make-for-vars decls))
- (steps (make-for-steps decls))
- (test (compile-parenscript-form `(not ,(first termination-test)) :expecting :expression))
- (body (compile-parenscript-form `(progn ,@body))))
- (list 'js-for vars steps test body)))
-
-(define-ps-special-form doeach (expecting decl &rest body)
- (declare (ignore expecting))
- (list 'js-for-each
- (first decl)
- (compile-parenscript-form (second decl) :expecting :expression)
- (compile-parenscript-form `(progn ,@body))))
-
-(define-ps-special-form while (expecting test &rest body)
- (declare (ignore expecting))
- (list 'js-while (compile-parenscript-form test :expecting :expression)
- (compile-parenscript-form `(progn ,@body))))
-
-(defpsmacro dotimes (iter &rest body)
- (let ((var (first iter))
- (times (second iter)))
- `(do ((,var 0 (1+ ,var)))
- ((>= ,var ,times))
- ,@body)))
-
-(defpsmacro dolist (i-array &rest body)
- (let ((var (first i-array))
- (array (second i-array))
- (arrvar (ps-gensym "tmp-arr"))
- (idx (ps-gensym "tmp-i")))
- `(let* ((,arrvar ,array))
- (do ((,idx 0 (1+ ,idx)))
- ((>= ,idx (slot-value ,arrvar 'length)))
- (let* ((,var (aref ,arrvar ,idx)))
- ,@body)))))
+(defun make-for-vars/inits (init-forms)
+ (mapcar (lambda (x)
+ (cons (compile-parenscript-form (if (atom x) x (first x)) :expecting :symbol)
+ (compile-parenscript-form (if (atom x) nil (second x)) :expecting :expression)))
+ init-forms))
+
+(define-ps-special-form labeled-for (label init-forms cond-forms step-forms &rest body)
+ `(js:for ,label
+ ,(make-for-vars/inits init-forms)
+ ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) cond-forms)
+ ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) step-forms)
+ ,(compile-parenscript-form `(progn ,@body))))
+
+(defpsmacro for (init-forms cond-forms step-forms &body body)
+ `(labeled-for nil ,init-forms ,cond-forms ,step-forms ,@body))
+
+(defun do-make-let-bindings (decls)
+ (mapcar (lambda (x)
+ (if (atom x) x
+ (if (endp (cdr x)) (list (car x))
+ (subseq x 0 2))))
+ decls))
+
+(defun do-make-init-vars (decls)
+ (mapcar (lambda (x) (if (atom x) x (first x))) decls))
+
+(defun do-make-init-vals (decls)
+ (mapcar (lambda (x) (if (or (atom x) (endp (cdr x))) nil (second x))) decls))
+
+(defun do-make-for-vars/init (decls)
+ (mapcar (lambda (x)
+ (if (atom x) x
+ (if (endp (cdr x)) x
+ (subseq x 0 2))))
+ decls))
+
+(defun do-make-for-steps (decls)
+ (mapcar (lambda (x)
+ `(setf ,(first x) ,(third x)))
+ (remove-if (lambda (x) (or (atom x) (< (length x) 3))) decls)))
+
+(defun do-make-iter-psteps (decls)
+ `(psetq
+ ,@(mapcan (lambda (x) (list (first x) (third x)))
+ (remove-if (lambda (x) (or (atom x) (< (length x) 3))) decls))))
+
+(defpsmacro do* (decls (termination &optional (result nil result?)) &body body)
+ (if result?
+ `((lambda ()
+ (for ,(do-make-for-vars/init decls) ((not ,termination)) ,(do-make-for-steps decls)
+ ,@body)
+ (return ,result)))
+ `(progn
+ (for ,(do-make-for-vars/init decls) ((not ,termination)) ,(do-make-for-steps decls)
+ ,@body))))
+
+(defpsmacro do (decls (termination &optional (result nil result?)) &body body)
+ (if result?
+ `((lambda ,(do-make-init-vars decls)
+ (for () ((not ,termination)) ()
+ ,@body
+ ,(do-make-iter-psteps decls))
+ (return ,result))
+ ,@(do-make-init-vals decls))
+ `(let ,(do-make-let-bindings decls)
+ (for () ((not ,termination)) ()
+ ,@body
+ ,(do-make-iter-psteps decls)))))
+
+(define-ps-special-form for-in ((var object) &rest body)
+ `(js:for-in ,(compile-parenscript-form `(var ,var) :expecting :expression)
+ ,(compile-parenscript-form object :expecting :expression)
+ ,(compile-parenscript-form `(progn ,@body))))
+
+(define-ps-special-form while (test &rest body)
+ `(js:while ,(compile-parenscript-form test :expecting :expression)
+ ,(compile-parenscript-form `(progn ,@body))))
+
+(defpsmacro dotimes ((var count &optional (result nil result?)) &rest body)
+ `(do* ((,var 0 (1+ ,var)))
+ ((>= ,var ,count) ,@(when result? (list result)))
+ ,@body))
+
+(defpsmacro dolist ((var array &optional (result nil result?)) &body body)
+ (let ((idx (ps-gensym "_js_idx"))
+ (arrvar (ps-gensym "_js_arrvar")))
+ `(do* (,var
+ (,arrvar ,array)
+ (,idx 0 (1+ ,idx)))
+ ((>= ,idx (slot-value ,arrvar 'length))
+ ,@(when result? (list result)))
+ (setq ,var (aref ,arrvar ,idx))
+ ,@body)))