It looks like that the current transformation will reinitialize the initializers on every iteration.
You can try it with this test case:
(js-on-cl::js-to-paren "for(var i = 0, len = cols.length; i < len; i++){ c = cols[i];}")
Below is a simple patch for that.
@@ -143,11 +143,10 @@ (condition (for-condition js-form)) (step (for-step js-form)) (body (for-body js-form)) ) - `(while t + `(progn ,(as-paren initializer) - (if (not ,(as-paren condition)) - (break)) - ,(as-paren step) ,(as-paren body)))) + (while ,(as-paren condition) + ,(as-paren body) ,(as-paren step)))))
Also, I notice that the operator ++ is not recognized by parenscript and it becomes a invalid function call Plus(...)
(ps* '(PROGN (PROGN (DEFVAR I 0) (DEFVAR LEN (SLOT-VALUE COLS "length"))) (WHILE (< I LEN) (++ I) (PROGN (= C (SLOT-VALUE COLS I))))))
=>
var i = 0 ; var len = cols['length']; while (i < len) { Plus(i); c == cols[i]; };
I'm not sure if we should fix js-to-paren to translate ++ to incf or patch parenscript to recognize ++.
Thanks
I also notice that parenscript will read (= x 3) as (== x 3). We probably need to translate = to setf
Here's a patch
==== js-on-cl/src/js-to-parenscript.lisp ==== @@ -1,5 +1,30 @@ (in-package :js-on-cl)
+(defparameter *symbols-to-paren-tokens* + (let ((ht (make-hash-table :test 'eq))) + (maphash #'(lambda (k v) + (setf (gethash k ht) v)) + *symbols-to-tokens*) + (loop for (k v) in '(;; where do these appears? + ;;(:COLON ":") + ;;(:HOOK "?") + (:LOGICAL-OR "or") + (:ASSIGN "setf") + (:BAR2 "or") + (:BANG "not") + (:POST-INCR "incf") + (:MINUS2 "decf") + (:POST-DECR "decf") + (:PLUS2 "incf") + (:PRE-INCR "incf") + (:PRE-DECR "decf") + (:LOGICAL-NOT "not")) + do (setf (gethash k ht) v)) + ht) + "Map from token symbol to parenscript token.") + + + (defun js-intern (js-literal-string) "interns a camel-cased js string to an appropriate lispy symbol" (intern @@ -56,7 +81,7 @@ (defun token-to-paren (tok) (js-intern (or - (gethash tok *symbols-to-tokens*) + (gethash tok *symbols-to-paren-tokens*) (string-downcase (string tok)))))
(defmethod as-paren ((js-form unary-operator)) @@ -143,11 +168,10 @@ (condition (for-condition js-form)) (step (for-step js-form)) (body (for-body js-form)) ) - `(while t + `(progn ,(as-paren initializer) - (if (not ,(as-paren condition)) - (break)) - ,(as-paren step) ,(as-paren body)))) + (while ,(as-paren condition) + ,(as-paren body) ,(as-paren step)))))
(defmethod as-paren ((js-form comma-expr)) ==== end patch ====
Another problem is that the pre/post increment operation needs to be handled differently. Currently
(js-to-paren "while (i++ > 3) { --j }") => (PROGN (WHILE (> (INCF I) 3) (PROGN (DECF J))))
But it's incorrect.
It should probably be something like (PROGN (WHILE (> I 3) (PROGN (INCF I) (DECF J))))
But I don't know how to make it right, since the translation is done in a bottom-up style.
Thanks
Sorry for spamming the list. I'm just fixing stuff as I test it with different sample javascript codes.
I've added support for try catch block and also factor out the code that eliminates extra progn construct when it is not necessary.
(js-on-cl::js-to-paren "try { win.loc = url; win.foc(); } catch (e) {msg();recover();} finally {alert()}")
(js-on-cl::js-to-paren "try { win.loc = url; } catch (e) {msg();recover();} finally {alert()}")
=>
(parenscript::ps* '(TRY (PROGN (SETF (SLOT-VALUE WIN "loc") URL) ((SLOT-VALUE WIN "foc"))) (:CATCH (E) (PROGN (MSG) (RECOVER))) (:FINALLY (PROGN (ALERT)))) )
Thanks.
==== js-on-cl/src/js-to-parenscript.lisp === @@ -1,5 +1,28 @@ (in-package :js-on-cl)
+(defparameter *symbols-to-paren-tokens* + (let ((ht (make-hash-table :test 'eq))) + (maphash #'(lambda (k v) + (setf (gethash k ht) v)) + *symbols-to-tokens*) + (loop for (k v) in '(;; where do these appears? + ;;(:COLON ":") + ;;(:HOOK "?") + (:LOGICAL-OR "or") + (:ASSIGN "setf") + (:BAR2 "or") + (:BANG "not") + (:POST-INCR "incf") + (:MINUS2 "decf") + (:POST-DECR "decf") + (:PLUS2 "incf") + (:PRE-INCR "incf") + (:PRE-DECR "decf") + (:LOGICAL-NOT "not")) + do (setf (gethash k ht) v)) + ht) + "Map from token symbol to parenscript token.") + (defun js-intern (js-literal-string) "interns a camel-cased js string to an appropriate lispy symbol" (intern @@ -16,6 +39,20 @@ (format nil "-~A" (string-downcase match))) :simple-calls t))
+(defmacro once-only ((&rest names) &body body) + (let ((gensyms (loop repeat (length names) collect (gensym)))) + `(let (,@(loop for g in gensyms collect `(,g (gensym)))) + `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n))) + ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g))) + ,@body))))) + +(defmacro expand-progn-subexp (subexp) + (once-only (subexp) + `(if (eql 1 (length ,subexp)) + (as-paren (first ,subexp)) + `(progn + ,@(mapcar #'as-paren ,subexp))))) + (defgeneric as-paren (js-elem) (:documentation "converts a javascript element to a parenscript element. Input is an abstract javascript form and output is a parenscript form.")) @@ -27,11 +64,7 @@ (defmethod as-paren ((lengthy-decl var-decl-statement)) "Converts a var declaration statement like var x = 3, y = 34; to a series of (defvar x 3) (defvar y 34) forms." - (let ((statements (var-decl-statement-var-decls lengthy-decl))) - (if (eql 1 (length statements)) - (as-paren (first statements)) - `(progn - ,@(mapcar #'as-paren statements))))) + (expand-progn-subexp (var-decl-statement-var-decls lengthy-decl)))
(defmethod as-paren ((decl var-decl)) (let ((name (js-intern @@ -56,7 +89,7 @@ (defun token-to-paren (tok) (js-intern (or - (gethash tok *symbols-to-tokens*) + (gethash tok *symbols-to-paren-tokens*) (string-downcase (string tok)))))
(defmethod as-paren ((js-form unary-operator)) @@ -122,7 +155,7 @@ (then-arg (if-statement-then-statement js-form)) (else-arg (if-statement-else-statement js-form))) (if (not else-arg) - `(if ,(as-paren condition) ,(as-paren then-arg)) + `(when ,(as-paren condition) ,(as-paren then-arg)) `(if ,(as-paren condition) ,(as-paren then-arg) ,(as-paren else-arg)))))
(defmethod as-paren ((js-form do-statement)) @@ -143,20 +176,17 @@ (condition (for-condition js-form)) (step (for-step js-form)) (body (for-body js-form)) ) - `(while t + `(progn ,(as-paren initializer) - (if (not ,(as-paren condition)) - (break)) - ,(as-paren step) ,(as-paren body)))) + (while ,(as-paren condition) + ,(as-paren body) ,(as-paren step)))))
(defmethod as-paren ((js-form comma-expr)) - (let ((expressions (comma-expr-exprs js-form))) - `(progn ,@(mapcar #'as-paren expressions)))) + (expand-progn-subexp (comma-expr-exprs js-form)))
(defmethod as-paren ((js-form statement-block)) - (let ((statements (statement-block-statements js-form))) - `(progn ,@(mapcar #'as-paren statements)))) + (expand-progn-subexp (statement-block-statements js-form)))
(defmethod as-paren ((js-form function-expression)) (let ((name (function-expression-name js-form)) @@ -177,6 +207,21 @@ (defmethod as-paren ((js-form return-statement)) `(return ,(as-paren (return-statement-arg js-form))))
+(defmethod as-paren ((js-form try)) + (let* ((body (try-body js-form)) + (catch-clause (try-catch-clause js-form)) + (binding (catch-clause-binding catch-clause)) + (catch-body (catch-clause-body catch-clause)) + (finally (try-finally-clause js-form))) + `(try + ,(expand-progn-subexp body) + (:catch (,(js-intern binding)) + ,(expand-progn-subexp catch-body)) + ,@(when finally + `((:finally + ,(expand-progn-subexp + (finally-clause-body finally)))))))) + (defun js-to-paren (js-text) (apply #'list 'progn (mapcar #'as-paren (parse js-text))))
-
Lui Fungsin