From 43a1d5c3aecf79d64971b751a62c285e631b003a Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vsedach@gmail.com>
Date: Thu, 11 Oct 2007 02:27:40 +0000
Subject: [PATCH] Fixed a bug in how symbol-macros were defined, expanded, and
 used by 'with-slots'.

---
 src/compiler.lisp     | 19 ++++---------------
 src/ps-macrology.lisp |  6 +++---
 t/ps-tests.lisp       | 10 ++++++++++
 3 files changed, 17 insertions(+), 18 deletions(-)

diff --git a/src/compiler.lisp b/src/compiler.lisp
index b108c53..c4cc3b1 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -162,22 +162,11 @@ whether any expansion was performed on the form or not."
   (if (consp form)
       (let ((op (car form))
             (args (cdr form)))
-        (cond ((equal op 'quote)
-	       (values 
-		(if (equalp '(nil) args) nil form) ;; leave quotes alone, unless it's a quoted nil
-		nil))
-              ((script-macro-p op) ;; recursively expand parenscript macros in parent env.
-               (values (ps-macroexpand (funcall (lookup-macro-expansion-function op) form)) t))
+        (cond ((equal op 'quote) (values (if (equalp '(nil) args) nil form) ;; leave quotes alone, unless it's a quoted nil
+                                         nil))
+              ((script-macro-p op) (values (ps-macroexpand (funcall (lookup-macro-expansion-function op) form)) t))
               (t (values form nil))))
-      (cond ((script-symbol-macro-p form)
-	     ;; recursively expand symbol macros in parent env.
-	     (multiple-value-bind (expansion-function macro-env)
-		 (lookup-macro-expansion-function form)
-	       (values
-		(ps-macroexpand (let ((*script-macro-env* macro-env))
-				      (funcall expansion-function)))
-		t)))
-	    ;; leave anything else alone
+      (cond ((script-symbol-macro-p form) (values (ps-macroexpand (funcall (lookup-macro-expansion-function form))) t))
             (t (values form nil)))))
 
 ;;;; compiler interface
diff --git a/src/ps-macrology.lisp b/src/ps-macrology.lisp
index 0d5ac9f..8a7246c 100644
--- a/src/ps-macrology.lisp
+++ b/src/ps-macrology.lisp
@@ -51,7 +51,7 @@ gensym-prefix-string)."
   (flet ((slot-var (slot) (if (listp slot) (first slot) slot))
 	 (slot-symbol (slot) (if (listp slot) (second slot) slot)))
     `(symbol-macrolet ,(mapcar #'(lambda (slot)
-				   `(,(slot-var slot) '(slot-value ,object ',(slot-symbol slot))))
+				   `(,(slot-var slot) (slot-value ,object ',(slot-symbol slot))))
 			       slots)
       ,@body)))
 
@@ -114,10 +114,10 @@ gensym-prefix-string)."
 (define-ps-special-form symbol-macrolet (expecting symbol-macros &body body)
   (with-temp-macro-environment (macro-env-dict)
     (dolist (macro symbol-macros)
-      (destructuring-bind (name &body expansion)
+      (destructuring-bind (name expansion)
           macro
 	(setf (get-macro-spec name macro-env-dict)
-	      (cons t (compile nil `(lambda () ,@expansion))))))
+	      (cons t (compile nil `(lambda () ',expansion))))))
     (compile-parenscript-form `(progn ,@body))))
 
 (define-ps-special-form defmacro (expecting name args &body body)
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 1de7017..61bf3eb 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -426,3 +426,13 @@ x = 2 + sideEffect() + x + 5;")
 (test-ps-js keyword-consistent
   :x
   "x")
+
+(test-ps-js simple-symbol-macrolet
+  (symbol-macrolet ((x 1)) x)
+  "1;")
+
+(test-ps-js compound-symbol-macrolet
+  (symbol-macrolet ((x 123)
+                    (y (* 2 x)))
+     y)
+  "2 * 123;")
-- 
2.20.1