From 0c69cff0f464d6d62f5868027645235fbd425ef9 Mon Sep 17 00:00:00 2001
From: Clinton Ebadi <clinton@unknownlamer.org>
Date: Thu, 8 Oct 2009 14:11:16 -0400
Subject: [PATCH] Move lexical binding renaming to JS:VARIABLE printer (part
 one) This moves lexical binding renaming into the printer for `js:variable'
 (where it belongs -- using symbol-macros for this makes the compiler a lot
 messier than it need be). Right now a new block is unnecessarily introduced
 for every `let' expression.

* Rewrite `let' special form
* Enclose variable name in `js:variable' when expanding `var' special
  form
* Maintain lexical binding stack in printer for `js:let'
* Perform renaming for all `js:variable' forms at print time
---
 src/printer.lisp       | 19 ++++++++++++++--
 src/special-forms.lisp | 50 +++++++-----------------------------------
 2 files changed, 25 insertions(+), 44 deletions(-)

diff --git a/src/printer.lisp b/src/printer.lisp
index db34da6..66c07ff 100644
--- a/src/printer.lisp
+++ b/src/printer.lisp
@@ -125,8 +125,23 @@ arguments, defines a printer for that form using the given body."
   (loop for idx in indices do
         (psw #\[) (ps-print idx) (psw #\])))
 
+(defvar *lexical-bindings* nil)
+
+(defun rename-js-variable (name)
+  (or (cdr (assoc name *lexical-bindings*))
+      name))
+
+(defprinter js:let (variables expression)
+  (let ((*lexical-bindings*
+	 (append (mapcar (lambda (var)
+			   (cons var (if (assoc var *lexical-bindings*)
+					 (ps-gensym var)
+					 var)))
+			 variables))))
+    (ps-print expression)))
+
 (defprinter js:variable (var)
-  (psw (symbol-to-js-string var)))
+  (psw (symbol-to-js-string (rename-js-variable var))))
 
 ;;; arithmetic operators
 (defun parenthesize-print (ps-form)
@@ -233,7 +248,7 @@ arguments, defines a printer for that form using the given body."
 
 (defprinter js:var (var-name &rest var-value)
   (psw "var ")
-  (psw (symbol-to-js-string var-name))
+  (ps-print var-name)
   (when var-value
     (psw " = ")
     (ps-print (car var-value))))
diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index 0a2e59b..d7eeac5 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -581,8 +581,8 @@ lambda-list::=
         (progn (push name *enclosing-lexical-block-declarations*)
                (when value-provided?
                  (ps-compile-expression `(setf ,name ,value))))
-        `(js:var ,name ,@(when value-provided?
-                               (list (ps-compile-expression (ps-macroexpand value))))))))
+        `(js:var (js:variable ,name) ,@(when value-provided?
+					   (list (ps-compile-expression (ps-macroexpand value))))))))
 
 (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.
@@ -591,46 +591,12 @@ lambda-list::=
   `(var ,name ,@(when value-provided? (list value))))
 
 (define-ps-special-form let (bindings &body body)
-  (let* (lexical-bindings-introduced-here
-         (normalized-bindings (mapcar (lambda (x)
-                                        (if (symbolp x)
-                                            (list x nil)
-                                            (list (car x) (ps-macroexpand (cadr x)))))
-                                      bindings))
-         (free-variables-in-binding-value-expressions (mapcan (lambda (x) (flatten (cadr x)))
-                                                              normalized-bindings)))
-    (flet ((maybe-rename-lexical-var (x)
-             (if (or (member x *vars-bound-in-enclosing-lexical-scopes*)
-                     (member x free-variables-in-binding-value-expressions))
-                 (ps-gensym x)
-                 (progn (push x lexical-bindings-introduced-here) nil)))
-           (rename (x) (first x))
-           (var (x) (second x))
-           (val (x) (third x)))
-      (let* ((lexical-bindings (loop for x in normalized-bindings
-                                  unless (ps-special-variable-p (car x))
-                                  collect (cons (maybe-rename-lexical-var (car x)) x)))
-             (dynamic-bindings (loop for x in normalized-bindings
-                                  when (ps-special-variable-p (car x))
-                                  collect (cons (ps-gensym (format nil "~A_~A" (car x) 'tmp-stack)) x)))
-             (renamed-body `(symbol-macrolet ,(loop for x in lexical-bindings
-                                                 when (rename x) collect
-                                                 `(,(var x) ,(rename x)))
-                              ,@body))
-             (*vars-bound-in-enclosing-lexical-scopes* (append lexical-bindings-introduced-here
-                                                               *vars-bound-in-enclosing-lexical-scopes*)))
-        (ps-compile
-         `(progn
-            ,@(mapcar (lambda (x) `(var ,(or (rename x) (var x)) ,(val x))) lexical-bindings)
-            ,(if dynamic-bindings
-                 `(progn ,@(mapcar (lambda (x) `(var ,(rename x))) dynamic-bindings)
-                         (try (progn (setf ,@(loop for x in dynamic-bindings append
-                                                  `(,(rename x) ,(var x)
-                                                     ,(var x) ,(val x))))
-                                     ,renamed-body)
-                              (:finally
-                               (setf ,@(mapcan (lambda (x) `(,(var x) ,(rename x))) dynamic-bindings)))))
-                 renamed-body)))))))
+  `(js:let ,(mapcar #'car bindings) 
+     ,(ps-compile `(progn
+		     ,@(mapcar (lambda (bind)
+				 `(var ,(car bind) ,(cadr bind)))
+			       bindings)
+		     ,@body))))
 
 (defpsmacro let* (bindings &body body)
   (if bindings
-- 
2.20.1