Move lexical binding renaming to JS:VARIABLE printer (part one)

[clinton/parenscript.git] / src / special-forms.lisp

diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index 0a2e59b..d7eeac5 100644 (file)
--- 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