From 058f137f675cd287a83ee28b97d088af98d3e939 Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vsedach@gmail.com>
Date: Sun, 3 May 2009 15:31:16 -0600
Subject: [PATCH] Reimplemented flet and labels to use the same renaming tricks
 as the let/let* patch to correctly implement lexical scoping.

---
 src/special-forms.lisp | 28 +++++++++---------
 t/ps-tests.lisp        | 67 ++++++++++++++++++++++++++++++++++++++----
 2 files changed, 75 insertions(+), 20 deletions(-)

diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index 62d3864..1125b8a 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -362,14 +362,13 @@ lambda-list::=
       ,@effective-body)))
 
 (defpsmacro flet (fn-defs &rest body)
-  (flet ((process-fn-def (def)
-           `(var ,(car def) (lambda ,@(cdr def)))))
-    `(progn ,@(mapcar #'process-fn-def fn-defs) ,@body)))
+  `(let ,(mapcar (lambda (def) `(,(car def) (lambda ,@(cdr def)))) fn-defs)
+     ,@body))
 
 (defpsmacro labels (fn-defs &rest body)
-  (flet ((process-fn-def (def)
-           `(var ,(car def) (defun ,(car def) ,@(cdr def)))))
-    `(progn ,@(mapcar #'process-fn-def fn-defs) ,@body)))
+  `(symbol-macrolet ,(mapcar (lambda (x) (list (car x) (ps-gensym (car x)))) fn-defs)
+     ,@(mapcar (lambda (def) `(var ,(car def) (lambda ,@(cdr def)))) fn-defs)
+     ,@body))
 
 (defpsmacro defsetf-long (access-fn lambda-list (store-var) form)
   (setf (get-macro-spec access-fn *ps-setf-expanders*)
@@ -539,14 +538,15 @@ lambda-list::=
 
 (define-ps-special-form var (name &optional (value (values) value-provided?) documentation)
   (declare (ignore documentation))
-  (ecase expecting
-    (:statement
-     `(js:var ,name ,@(when value-provided?
-                            (list (compile-parenscript-form value :expecting :expression)))))
-    (:expression
-     (push name *enclosing-lexical-block-declarations*)
-     (when value-provided?
-       (compile-parenscript-form `(setf ,name ,value) :expecting :expression)))))
+  (let ((name (ps-macroexpand name)))
+    (ecase expecting
+      (:statement
+       `(js:var ,name ,@(when value-provided?
+                              (list (compile-parenscript-form value :expecting :expression)))))
+      (:expression
+       (push name *enclosing-lexical-block-declarations*)
+       (when value-provided?
+         (compile-parenscript-form `(setf ,name ,value) :expecting :expression))))))
 
 (defpsmacro defvar (name &optional (value (values) value-provided?) documentation)
   ;; this must be used as a top-level form, otherwise the resulting behavior will be undefined.
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 69f1564..fe2898a 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -743,14 +743,40 @@ try {
   "'<SPAN CLASS=\"ticker-symbol\" TICKER-SYMBOL=\"' + symbol + '\"><A HREF=\"http://foo.com\">' + symbol + '</A><SPAN CLASS=\"ticker-symbol-popup\"></SPAN></SPAN>'")
 
 (test-ps-js flet1
-  ((lambda () (flet ((foo (x) (return (1+ x)))) (return (foo 1)))))
+  ((lambda () (flet ((foo (x)
+                       (return (1+ x))))
+                (return (foo 1)))))
   "(function () {
-    var foo = function (x) {
+    var foo1 = function (x) {
         return x + 1;
     };
-    return foo(1);
+    return foo1(1);
 })()")
 
+(test-ps-js flet2
+  (flet ((foo (x) (return (1+ x)))
+         (bar (y) (return (+ 2 y))))
+    (bar (foo 1)))
+"var foo1 = function (x) {
+    return x + 1;
+};
+var bar2 = function (y) {
+    return 2 + y;
+};
+bar2(foo1(1));")
+
+(test-ps-js flet3
+  (flet ((foo (x) (return (1+ x)))
+         (bar (y) (return (+ 2 (foo y)))))
+    (bar (foo 1)))
+  "var foo1 = function (x) {
+    return x + 1;
+};
+var bar2 = function (y) {
+    return 2 + foo(y);
+};
+bar2(foo1(1));")
+
 (test-ps-js labels1
   ((lambda () (labels ((foo (x) 
                          (return (if (=== 0 x)
@@ -758,12 +784,36 @@ try {
                                      (+ x (foo (1- x)))))))
                 (return (foo 3)))))
   "(function () {
-    var foo = function foo(x) {
-        return 0 === x ? 0 : x + foo(x - 1);
+    var foo1 = function (x) {
+        return 0 === x ? 0 : x + foo1(x - 1);
     };
-    return foo(3);
+    return foo1(3);
 })()")
 
+(test-ps-js labels2
+  (labels ((foo (x) (return (1+ (bar x))))
+           (bar (y) (return (+ 2 (foo y)))))
+    (bar (foo 1)))
+  "var foo1 = function (x) {
+    return bar2(x) + 1;
+};
+var bar2 = function (y) {
+    return 2 + foo1(y);
+};
+bar2(foo1(1));")
+
+(test-ps-js labels3
+  (labels ((foo (x) (return (1+ x)))
+           (bar (y) (return (+ 2 (foo y)))))
+    (bar (foo 1)))
+  "var foo1 = function (x) {
+    return x + 1;
+};
+var bar2 = function (y) {
+    return 2 + foo1(y);
+};
+bar2(foo1(1));")
+
 (test-ps-js for-loop-var-init-exp
   ((lambda (x)
      (return (do* ((y (if x 0 1) (1+ y))
@@ -910,3 +960,8 @@ x2 + y3;")
 var y2 = x1 + 2;
 var x3 = 1;
 x3 + y2;")
+
+(test-ps-js symbol-macrolet-var
+  (symbol-macrolet ((x y))
+    (var x))
+  "var y;")
\ No newline at end of file
-- 
2.20.1