LET

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 0a01e5d..2da9fd2 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -573,11 +573,7 @@
     ((and (listp x) (eq (car x) 'lambda))
      (compile-lambda (cadr x) (cddr x)))
     ((and (listp x) (eq (car x) 'named-lambda))
-     ;; TODO: destructuring-bind now! Do error checking manually is
-     ;; very annoying.
-     (let ((name (cadr x))
-           (ll (caddr x))
-           (body (cdddr x)))
+     (destructuring-bind (name ll &rest body) (cdr x)
        (compile-lambda ll body
                        :name (symbol-name name)
                        :block name)))
@@ -609,11 +605,9 @@
           (extend-lexenv (mapcar #'make-function-binding fnames)
                          *environment*
                          'function)))
-    `(code "(function("
-           ,@(interleave (mapcar #'translate-function fnames) ",")
-           "){"
-           ,(ls-compile-block body t)
-           "})(" ,@(interleave cfuncs ",") ")")))
+    `(call (function ,(mapcar #'make-symbol (mapcar #'translate-function fnames))
+                ,(ls-compile-block body t))
+           ,@cfuncs)))
 
 (define-compilation labels (definitions &rest body)
   (let* ((fnames (mapcar #'car definitions))
@@ -621,13 +615,13 @@
           (extend-lexenv (mapcar #'make-function-binding fnames)
                          *environment*
                          'function)))
-    (js!selfcall
-      `(code ,@(mapcar (lambda (func)
-                         `(code "var " ,(translate-function (car func))
-                                " = " ,(compile-lambda (cadr func)
-                                                       `((block ,(car func) ,@(cddr func))))
-                                ";" ))
-                       definitions))
+    (js!selfcall*
+      `(progn
+         ,@(mapcar (lambda (func)
+                     `(var (,(make-symbol (translate-function (car func)))
+                             ,(compile-lambda (cadr func)
+                                              `((block ,(car func) ,@(cddr func)))))))
+                   definitions))
       (ls-compile-block body t))))
 
 
@@ -701,20 +695,16 @@
          (cvalues (mapcar #'ls-compile (mapcar #'second bindings)))
          (*environment* (extend-local-env (remove-if #'special-variable-p variables)))
          (dynamic-bindings))
-    `(code "(function("
-           ,@(interleave
-              (mapcar (lambda (x)
-                        (if (special-variable-p x)
-                            (let ((v (gvarname x)))
-                              (push (cons x v) dynamic-bindings)
-                              v)
-                            (translate-variable x)))
-                      variables)
-              ",")
-           "){"
-           ,(let ((body (ls-compile-block body t t)))
-             `(code ,(let-binding-wrapper dynamic-bindings body)))
-           "})(" ,@(interleave cvalues ",") ")")))
+    `(call (function ,(mapcar (lambda (x)
+                                (if (special-variable-p x)
+                                    (let ((v (gvarname x)))
+                                      (push (cons x 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))))
+           ,@cvalues)))
 
 
 ;;; Return the code to initialize BINDING, and push it extending the
@@ -1293,14 +1283,13 @@
 
 (define-builtin values-array (array)
   (if *multiple-value-p*
-      `(code "values.apply(this, " ,array ")")
-      `(code "pv.apply(this, " ,array ")")))
+      `(call (get |values| "apply") this ,array)
+      `(call (get |pv| "apply") this ,array)))
 
 (define-raw-builtin values (&rest args)
   (if *multiple-value-p*
-      `(code "values(" ,@(interleave (mapcar #'ls-compile args) ",") ")")
-      `(code "pv(" ,@(interleave (mapcar #'ls-compile args) ", ") ")")))
-
+      `(call |values| ,@(mapcar #'ls-compile args))
+      `(call |pv| ,@(mapcar #'ls-compile args))))
 
 ;;; Javascript FFI