Variable-arity

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 866cea2..918aee8 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -857,11 +857,15 @@
                   (try
                    (switch ,(make-symbol branch)
                            ,@(with-collect
+                              (collect `(case ,initag))
                               (dolist (form (cdr body))
                                 (if (go-tag-p form)
                                     (let ((b (lookup-in-lexenv form *environment* 'gotag)))
                                       (collect `(case ,(second (binding-value b)))))
-                                    (collect (ls-compile form)))))
+                                    (progn
+                                      (collect (ls-compile form))
+                                      ;; TEMPORAL!
+                                      (collect '(code ";"))))))
                            default
                            (break tbloop)))
                   (catch (jump)
@@ -896,29 +900,32 @@
     `(return |ret|)))
 
 (define-compilation multiple-value-call (func-form &rest forms)
-  (js!selfcall
-    "var func = " (ls-compile func-form) ";"
-    "var args = [" (if *multiple-value-p* "values" "pv") ", 0];"
-    "return "
-    (js!selfcall
-      "var values = mv;"
-      "var vs;"
-      `(code
-        ,@(mapcar (lambda (form)
-                    `(code "vs = " ,(ls-compile form t) ";"
-                           "if (typeof vs === 'object' && 'multiple-value' in vs)"
-                           (code " args = args.concat(vs);" )
-                           " else "
-                           (code "args.push(vs);" )))
-                  forms))
-      "args[1] = args.length-2;"
-      "return func.apply(window, args);" ) ";" ))
+  (js!selfcall*
+    `(var (func ,(ls-compile func-form)))
+    `(var (args ,(vector (if *multiple-value-p* '|values| '|pv|) 0)))
+    `(return
+       ,(js!selfcall*
+         `(var (|values| |mv|))
+         `(var vs)
+         `(progn
+            ,@(with-collect
+               (dolist (form forms)
+                 (collect `(= vs ,(ls-compile form t)))
+                 (collect `(if (and (=== (typeof vs) "object")
+                                    (in "multiple-value" vs))
+                               (= args (call (get args "concat") vs))
+                               (call (get args "push") vs))))))
+         `(= (property args 1) (- (property args "length") 2))
+         `(return (call (get func "apply") |window| args))))))
 
 (define-compilation multiple-value-prog1 (first-form &rest forms)
-  (js!selfcall
-    "var args = " (ls-compile first-form *multiple-value-p*) ";"
-    (ls-compile-block forms)
-    "return args;" ))
+  (js!selfcall*
+    `(var (args ,(ls-compile first-form *multiple-value-p*)))
+    ;; TODO: Interleave is temporal
+    `(progn ,@(interleave (mapcar #'ls-compile forms)
+                          '(code ";")
+                          t))
+    `(return args)))
 
 (define-transformation backquote (form)
   (bq-completely-process form))
@@ -974,24 +981,24 @@
         (fargs '())
         (prelude '()))
     (dolist (x args)
-      (cond
-        ((or (floatp x) (numberp x)) (push x fargs))
-        (t (let ((v (make-symbol (code "x" (incf counter)))))
-             (push v fargs)
-             (push `(code "var " ,v " = " ,(ls-compile x) ";"
-                          "if (typeof " ,v " !== 'number') throw 'Not a number!';")
-                   prelude)))))
-    (js!selfcall
-      `(code ,@(reverse prelude))
+      (if (or (floatp x) (numberp x))
+          (push x fargs)
+          (let ((v (make-symbol (concat "x" (integer-to-string (incf counter))))))
+            (push v fargs)
+            (push `(var (,v ,(ls-compile x)))
+                  prelude)
+            (push `(if (!= (typeof ,v) "number")
+                       (throw "Not a number!"))
+                  prelude))))
+    (js!selfcall*
+      `(progn ,@(reverse prelude))
       (funcall function (reverse fargs)))))
 
 
 (defmacro variable-arity (args &body body)
   (unless (symbolp args)
     (error "`~S' is not a symbol." args))
-  `(variable-arity-call ,args
-                        (lambda (,args)
-                          `(code "return " ,,@body ";" ))))
+  `(variable-arity-call ,args (lambda (,args) `(return  ,,@body))))
 
 (defun num-op-num (x op y)
   (type-check (("x" "number" x) ("y" "number" y))
@@ -1067,9 +1074,10 @@
 
 (define-builtin consp (x)
   (js!bool
-   (js!selfcall
-     "var tmp = " x ";"
-     "return (typeof tmp == 'object' && 'car' in tmp);" )))
+   (js!selfcall*
+     `(var (tmp ,x))
+     `(return (and (== (typeof tmp) "object")
+                   (in "car" tmp))))))
 
 (define-builtin car (x)
   (js!selfcall*
@@ -1181,24 +1189,26 @@
 
 (define-raw-builtin apply (func &rest args)
   (if (null args)
-      `(code "(" ,(ls-compile func) ")()")
+      (ls-compile func)
       (let ((args (butlast args))
             (last (car (last args))))
-        (js!selfcall
-          "var f = " (ls-compile func) ";"
-          "var args = [" `(code
-                           ,@(interleave (list* (if *multiple-value-p* "values" "pv")
-                                                (integer-to-string (length args))
-                                                (mapcar #'ls-compile args))
-                                         ", "))
-          "];"
-          "var tail = (" (ls-compile last) ");"
-          "while (tail != " (ls-compile nil) "){"
-          "    args.push(tail.car);"
-          "    args[1] += 1;"
-          "    tail = tail.cdr;"
-          "}"
-          "return (typeof f === 'function'? f : f.fvalue).apply(this, args);" ))))
+        (js!selfcall*
+          `(var (f ,(ls-compile func)))
+          `(var (args ,(list-to-vector
+                        (list* (if *multiple-value-p* '|values| '|pv|)
+                               (length args)
+                               (mapcar #'ls-compile args)))))
+          `(var (tail ,(ls-compile last)))
+          `(while (!= tail ,(ls-compile nil))
+             (call (get args "push") (get tail "car"))
+             (post++ (property args 1))
+             (= tail (get tail "cdr")))
+          `(return (call (get (if (=== (typeof f) "function")
+                                  f
+                                  (get f "fvalue"))
+                              "apply")
+                         this
+                         args))))))
 
 (define-builtin js-eval (string)
   (if *multiple-value-p*