The parenscript form EVAL-WHEN was broken due to macroexpansion issues. I have attached a patch that should fix this issue:
From 904be1cc2eee598491557132e8ed1569a90f27a3 Mon Sep 17 00:00:00 2001
From: Red Daly reddaly@gmail.com Date: Sun, 26 Jul 2009 20:22:54 +0000 Subject: [PATCH] Fixed eval-when special form and added tests to prevent future breakage.
--- src/compiler.lisp | 50 ++++++++++++++++++++++++++++---------------------- t/ps-tests.lisp | 40 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+), 22 deletions(-)
diff --git a/src/compiler.lisp b/src/compiler.lisp index 4fed094..e72fb4e 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -162,17 +162,20 @@ compiled to an :expression (the default), a :statement, or a :symbol."))
(defun adjust-ps-compilation-level (form level) - (cond ((or (and (consp form) (eq 'progn (car form))) - (and (symbolp form) (eq :toplevel level))) - level) - ((eq :toplevel level) :inside-toplevel-form))) + "Given the current *ps-compilation-level*, LEVEL, and the fully macroexpanded +form, FORM, returns the new value for *ps-compilation-level*." + (cond ((or (and (consp form) (member (car form) + '(progn locally macrolet symbol-macrolet compile-file))) + (and (symbolp form) (eq :toplevel level))) + level) + ((eq :toplevel level) :inside-toplevel-form))) +
(defmethod compile-parenscript-form :around (form &key expecting) (assert (if expecting (member expecting '(:expression :statement :symbol)) t)) (if (eq expecting :symbol) (compile-to-symbol form) - (let ((*ps-compilation-level* (adjust-ps-compilation-level form *ps-compilation-level*))) - (call-next-method)))) + (call-next-method)))
(defun compile-to-symbol (form) "Compiles the given Parenscript form and guarantees that the @@ -226,22 +229,25 @@ the form cannot be compiled to a symbol." (defmethod compile-parenscript-form ((form cons) &key (expecting :statement)) (multiple-value-bind (form expanded-p) (ps-macroexpand form) - (cond (expanded-p (compile-parenscript-form form :expecting expecting)) - ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) - ((op-form-p form) - `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) - ,@(mapcar (lambda (form) - (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) - (cdr form)))) - ((funcall-form-p form) - `(js:funcall ,(compile-parenscript-form (if (symbolp (car form)) - (maybe-rename-local-function (car form)) - (ps-macroexpand (car form))) - :expecting :expression) - ,@(mapcar (lambda (arg) - (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) - (cdr form)))) - (t (error "Cannot compile ~S to a ParenScript form." form))))) + (let ((*ps-compilation-level* (if expanded-p + *ps-compilation-level* + (adjust-ps-compilation-level form *ps-compilation-level*)))) + (cond (expanded-p (compile-parenscript-form form :expecting expecting)) + ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) + ((op-form-p form) + `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) + ,@(mapcar (lambda (form) + (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) + (cdr form)))) + ((funcall-form-p form) + `(js:funcall ,(compile-parenscript-form (if (symbolp (car form)) + (maybe-rename-local-function (car form)) + (ps-macroexpand (car form))) + :expecting :expression) + ,@(mapcar (lambda (arg) + (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) + (cdr form)))) + (t (error "Cannot compile ~S to a ParenScript form." form))))))
(defvar *ps-gensym-counter* 0)
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index cd9d4f2..0324c09 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -1129,3 +1129,43 @@ x1 - x1; --x1; ++x1;")
+(test-ps-js eval-when-ps-side + (eval-when (:execute) + 5) + "5;") + +(defvar *lisp-output* nil) + +(test eval-when-lisp-side () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(eval-when (:compile-toplevel) + (setf *lisp-output* 'it-works)))))) + (is (eql 'it-works *lisp-output*)) + (is (string= "" js-output)))) + +(defpsmacro my-in-package (package-name) + `(eval-when (:compile-toplevel) + (setf *lisp-output* ,package-name))) + +(test eval-when-macro-expansion () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(progn + (my-in-package :cl-user) + 3))))) + (declare (ignore js-output)) + (is (eql :cl-user *lisp-output*)))) + ;(is (string= "" js-output)))) + +(test eval-when-macrolet-expansion () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(macrolet ((my-in-package2 (package-name) + `(eval-when (:compile-toplevel) + (setf *lisp-output* ,package-name)))) + (my-in-package2 :cl-user) + 3))))) + (declare (ignore js-output)) + (is (eql :cl-user *lisp-output*)))) + ;(is (string= "" js-output))))