[parenscript-devel] eval-when bug fix patch

[Vladimir Sedach]

Pushed. Thanks for the patch!

Vladimir

On Sun, Jul 26, 2009 at 2:28 PM, Red Daly<reddaly at gmail.com> wrote:
> 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 at 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))))
> --
> 1.5.4.3
>
>
>
> _______________________________________________
> parenscript-devel mailing list
> parenscript-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/parenscript-devel
>
>