From: David Vázquez <davazp@gmail.com>
Date: Sun, 30 Jun 2013 14:27:42 +0000 (+0200)
Subject: let-binding-wrapper
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=31c8b1f2a15c4a1e38b470127b944dde30d9351b;p=jscl.git

let-binding-wrapper
---

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 2da9fd2..e6e441b 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -668,26 +668,20 @@
 (defun let-binding-wrapper (bindings body)
   (when (null bindings)
     (return-from let-binding-wrapper body))
-  `(code
-    "try {"
-    (code "var tmp;"
-          ,@(mapcar
-             (lambda (b)
-               (let ((s (ls-compile `(quote ,(car b)))))
-                 `(code "tmp = " ,s ".value;"
-                        ,s ".value = " ,(cdr b) ";"
-                        ,(cdr b) " = tmp;" )))
-             bindings)
-          ,body
-          )
-    "}"
-    "finally {"
-    (code
-     ,@(mapcar (lambda (b)
-                 (let ((s (ls-compile `(quote ,(car b)))))
-                   `(code ,s ".value" " = " ,(cdr b) ";" )))
-               bindings))
-    "}" ))
+  `(progn
+     (try (var tmp)
+          ,@(with-collect
+             (dolist (b bindings)
+               (let ((s (ls-compile `',(car b))))
+                 (collect `(= tmp (get ,s "value")))
+                 (collect `(= (get ,s "value") ,(cdr b)))
+                 (collect `(= ,(cdr b) tmp)))))
+          ,body)
+     (finally
+      ,@(with-collect
+         (dolist (b bindings)
+           (let ((s (ls-compile `(quote ,(car b)))))
+             (collect `(= (get ,s "value") ,(cdr b)))))))))
 
 (define-compilation let (bindings &rest body)
   (let* ((bindings (mapcar #'ensure-list bindings))
@@ -698,12 +692,12 @@
     `(call (function ,(mapcar (lambda (x)
                                 (if (special-variable-p x)
                                     (let ((v (gvarname x)))
-                                      (push (cons x v) dynamic-bindings)
+                                      (push (cons x (make-symbol v)) dynamic-bindings)
                                       (make-symbol v))
                                     (make-symbol (translate-variable x))))
                               variables)
                      ,(let ((body (ls-compile-block body t t)))
-                           `(code ,(let-binding-wrapper dynamic-bindings body))))
+                           `,(let-binding-wrapper dynamic-bindings body)))
            ,@cvalues)))