Dear Parenscripters,<br><br>I found an inconsistency in how symbols are translated into Javascript. The issue is similar to an earlier issue:<br><br>CL-USER> (ps:ps <br>
(let ((sym :my-function)) <br> (slot-value object sym) <br>
(slot-value object :my-function)))<br>"var sym = 'my-function'; <br>
object[sym]; <br>object.myFunction;"<br>
<br>One would expect object[sym] and object.myFunction to evaluate to the same value, but right now they do not. This bug only affects keywords:<br><br>CL-USER> (ps:ps <br>
(let ((sym 'my-function)) <br> (slot-value object sym) <br>
(slot-value object 'my-function)))<br>"var sym = 'myFunction'; <br>
object[sym]; <br>object.myFunction;" <br>
<br>The above output is sensible. A patch is attached to fix this issue. A few test cases have also been added to prevent future breakage.<br><br>The old DEFUN-KEYWORD4 test function failed with this patch because it expected a keyword to translate to 'my-name-key'. I patched it to expect 'myNameKey'<br>
<br>Best,<br>Red<br><br>From 904be1cc2eee598491557132e8ed1569a90f27a3 Mon Sep 17 00:00:00 2001<br>From: Red Daly <<a href="mailto:reddaly@gmail.com">reddaly@gmail.com</a>><br>Date: Sun, 26 Jul 2009 20:22:54 +0000<br>
Subject: [PATCH] Fixed eval-when special form and added tests to prevent future breakage.<br><br>---<br> src/compiler.lisp | 50 ++++++++++++++++++++++++++++----------------------<br> t/ps-tests.lisp | 40 ++++++++++++++++++++++++++++++++++++++++<br>
2 files changed, 68 insertions(+), 22 deletions(-)<br><br>diff --git a/src/compiler.lisp b/src/compiler.lisp<br>index 4fed094..e72fb4e 100644<br>--- a/src/compiler.lisp<br>+++ b/src/compiler.lisp<br>@@ -162,17 +162,20 @@ compiled to an :expression (the default), a :statement, or a<br>
:symbol."))<br> <br> (defun adjust-ps-compilation-level (form level)<br>- (cond ((or (and (consp form) (eq 'progn (car form)))<br>- (and (symbolp form) (eq :toplevel level)))<br>- level)<br>
- ((eq :toplevel level) :inside-toplevel-form)))<br>+ "Given the current *ps-compilation-level*, LEVEL, and the fully macroexpanded<br>+form, FORM, returns the new value for *ps-compilation-level*."<br>+ (cond ((or (and (consp form) (member (car form)<br>
+ '(progn locally macrolet symbol-macrolet compile-file)))<br>+ (and (symbolp form) (eq :toplevel level)))<br>+ level)<br>+ ((eq :toplevel level) :inside-toplevel-form)))<br>+<br> <br>
(defmethod compile-parenscript-form :around (form &key expecting)<br> (assert (if expecting (member expecting '(:expression :statement :symbol)) t))<br> (if (eq expecting :symbol)<br> (compile-to-symbol form)<br>
- (let ((*ps-compilation-level* (adjust-ps-compilation-level form *ps-compilation-level*)))<br>- (call-next-method))))<br>+ (call-next-method)))<br> <br> (defun compile-to-symbol (form)<br> "Compiles the given Parenscript form and guarantees that the<br>
@@ -226,22 +229,25 @@ the form cannot be compiled to a symbol."<br> (defmethod compile-parenscript-form ((form cons) &key (expecting :statement))<br> (multiple-value-bind (form expanded-p)<br> (ps-macroexpand form)<br>
- (cond (expanded-p (compile-parenscript-form form :expecting expecting))<br>- ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form))))<br>- ((op-form-p form)<br>
- `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol))<br>- ,@(mapcar (lambda (form)<br>- (compile-parenscript-form (ps-macroexpand form) :expecting :expression))<br>
- (cdr form))))<br>- ((funcall-form-p form)<br>- `(js:funcall ,(compile-parenscript-form (if (symbolp (car form))<br>- (maybe-rename-local-function (car form))<br>
- (ps-macroexpand (car form)))<br>- :expecting :expression)<br>- ,@(mapcar (lambda (arg)<br>- (compile-parenscript-form (ps-macroexpand arg) :expecting :expression))<br>
- (cdr form))))<br>- (t (error "Cannot compile ~S to a ParenScript form." form)))))<br>+ (let ((*ps-compilation-level* (if expanded-p<br>+ *ps-compilation-level*<br>
+ (adjust-ps-compilation-level form *ps-compilation-level*))))<br>+ (cond (expanded-p (compile-parenscript-form form :expecting expecting))<br>+ ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form))))<br>
+ ((op-form-p form)<br>+ `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol))<br>+ ,@(mapcar (lambda (form)<br>+ (compile-parenscript-form (ps-macroexpand form) :expecting :expression))<br>
+ (cdr form))))<br>+ ((funcall-form-p form)<br>+ `(js:funcall ,(compile-parenscript-form (if (symbolp (car form))<br>+ (maybe-rename-local-function (car form))<br>
+ (ps-macroexpand (car form)))<br>+ :expecting :expression)<br>+ ,@(mapcar (lambda (arg)<br>+ (compile-parenscript-form (ps-macroexpand arg) :expecting :expression))<br>
+ (cdr form))))<br>+ (t (error "Cannot compile ~S to a ParenScript form." form))))))<br> <br> (defvar *ps-gensym-counter* 0)<br> <br>diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp<br>index cd9d4f2..0324c09 100644<br>
--- a/t/ps-tests.lisp<br>+++ b/t/ps-tests.lisp<br>@@ -1129,3 +1129,43 @@ x1 - x1;<br> --x1;<br> ++x1;")<br> <br>+(test-ps-js eval-when-ps-side<br>+ (eval-when (:execute)<br>+ 5)<br>+ "5;")<br>+<br>+(defvar *lisp-output* nil)<br>
+<br>+(test eval-when-lisp-side ()<br>+ (setf *lisp-output* 'original-value)<br>+ (let ((js-output (normalize-js-code <br>+ (ps-doc* `(eval-when (:compile-toplevel)<br>+ (setf *lisp-output* 'it-works))))))<br>
+ (is (eql 'it-works *lisp-output*))<br>+ (is (string= "" js-output))))<br>+<br>+(defpsmacro my-in-package (package-name)<br>+ `(eval-when (:compile-toplevel)<br>+ (setf *lisp-output* ,package-name)))<br>
+<br>+(test eval-when-macro-expansion ()<br>+ (setf *lisp-output* 'original-value)<br>+ (let ((js-output (normalize-js-code <br>+ (ps-doc* `(progn<br>+ (my-in-package :cl-user)<br>+ 3)))))<br>
+ (declare (ignore js-output))<br>+ (is (eql :cl-user *lisp-output*))))<br>+ ;(is (string= "" js-output))))<br>+<br>+(test eval-when-macrolet-expansion ()<br>+ (setf *lisp-output* 'original-value)<br>
+ (let ((js-output (normalize-js-code <br>+ (ps-doc* `(macrolet ((my-in-package2 (package-name)<br>+ `(eval-when (:compile-toplevel)<br>+ (setf *lisp-output* ,package-name))))<br>
+ (my-in-package2 :cl-user)<br>+ 3)))))<br>+ (declare (ignore js-output))<br>+ (is (eql :cl-user *lisp-output*))))<br>+ ;(is (string= "" js-output))))<br>-- <br>1.5.4.3<br>
<br><br>From d6748a5cfc8c4b9300884e9e5061db19cb0407cd Mon Sep 17 00:00:00 2001<br>From: Red Daly <<a href="mailto:reddaly@gmail.com">reddaly@gmail.com</a>><br>Date: Sun, 26 Jul 2009 20:49:59 +0000<br>Subject: [PATCH] Fixed keyword translation inconsistency between (slot-value object :key-thing) and :key-thing.<br>
<br>---<br> src/printer.lisp | 2 +-<br> src/special-forms.lisp | 2 +-<br> t/ps-tests.lisp | 18 +++++++++++++++++-<br> 3 files changed, 19 insertions(+), 3 deletions(-)<br><br>diff --git a/src/printer.lisp b/src/printer.lisp<br>
index b649dae..edf74b2 100644<br>--- a/src/printer.lisp<br>+++ b/src/printer.lisp<br>@@ -43,7 +43,7 @@ arguments, defines a printer for that form using the given body."<br> <br> (defmethod ps-print ((s symbol))<br> (assert (keywordp s))<br>
- (ps-print (string-downcase s)))<br>+ (ps-print (symbol-to-js-string s)))<br> <br> (defmethod ps-print ((compiled-form cons))<br> (ps-print% (car compiled-form) (cdr compiled-form)))<br>diff --git a/src/special-forms.lisp b/src/special-forms.lisp<br>
index 802dc28..e96a6d4 100644<br>--- a/src/special-forms.lisp<br>+++ b/src/special-forms.lisp<br>@@ -34,7 +34,7 @@<br> (typecase x<br> (cons `(array ,@(mapcar (lambda (x) (when x `',x)) x)))<br> (null '(array))<br>
- (keyword x)<br>+ (keyword (symbol-to-js-string x))<br> (symbol (symbol-to-js-string x))<br> (number x)<br> (string x))<br>diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp<br>index 0324c09..540d1a6 100644<br>
--- a/t/ps-tests.lisp<br>+++ b/t/ps-tests.lisp<br>@@ -455,7 +455,7 @@ __setf_someThing(_js1, _js2, _js3);")<br> var _js2 = arguments.length;<br> for (var n1 = 0; n1 < _js2; n1 += 2) {<br> switch (arguments[n1]) {<br>
- case 'my-name-key':<br>+ case 'myNameKey':<br> {<br> myName = arguments[n1 + 1];<br> };<br>@@ -1169,3 +1169,19 @@ x1 - x1;<br> (declare (ignore js-output))<br>
(is (eql :cl-user *lisp-output*))))<br> ;(is (string= "" js-output))))<br>+<br>+(test-ps-js keyword-conversion1<br>+ :alpha-omega<br>+ "'alphaOmega';")<br>+<br>+(test-ps-js keyword-conversion2<br>
+ (slot-value object :alpha-omega)<br>+ "object.alphaOmega;")<br>+<br>+(test keyword-conversion2 ()<br>+ (let ((js-output1 (normalize-js-code <br>+ (ps-doc* '(slot-value object :alpha-omega))))<br>
+ (js-output2 (normalize-js-code<br>+ (ps-doc* :alpha-omega)))<br>+ (declare (ignore js-output))<br>+ (is (eql :cl-user *lisp-output*))))<br>-- <br>1.5.4.3<br><br>