Use destructuring-bind

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 4b0cd8d..10783e9 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -117,7 +117,8 @@
 
 (defun gvarname (symbol)
   (declare (ignore symbol))
-  (code "v" (incf *variable-counter*)))
+  (incf *variable-counter*)
+  (concat "v" (integer-to-string *variable-counter*)))
 
 (defun translate-variable (symbol)
   (awhen (lookup-in-lexenv symbol *environment* 'variable)
@@ -250,10 +251,10 @@
   (if (or name docstring)
       (js!selfcall*
         `(var (func ,code))
-        (when name      `(= (get func |fname|) ,name))
-        (when docstring `(= (get func |docstring|) ,docstring))
+        (when name      `(= (get func "fname") ,name))
+        (when docstring `(= (get func "docstring") ,docstring))
         `(return func))
-      `(code ,code)))
+      code))
 
 (defun lambda-check-argument-count
     (n-required-arguments n-optional-arguments rest-p)
@@ -495,7 +496,8 @@
 (defvar *literal-counter* 0)
 
 (defun genlit ()
-  (code "l" (incf *literal-counter*)))
+  (incf *literal-counter*)
+  (concat "l" (integer-to-string *literal-counter*)))
 
 (defun dump-symbol (symbol)
   #-jscl
@@ -571,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)))
@@ -817,15 +815,15 @@
     `(try
       ,(ls-compile-block body t))
     `(catch (|cf|)
-       (if (and (== (get |cf| |type|) "catch")
-                (== (get |cf| |id|) |id|))
+       (if (and (== (get |cf| "type") "catch")
+                (== (get |cf| "id") |id|))
            ,(if *multiple-value-p*
-                `(return (call (get |values| |apply|)
+                `(return (call (get |values| "apply")
                                this
-                               (call |forcemv| (get |cf| |values|))))
-                `(return (call (get |pv| |apply|)
+                               (call |forcemv| (get |cf| "values"))))
+                `(return (call (get |pv| "apply")
                                this
-                               (call |forcemv| (get |cf| |values|)))))
+                               (call |forcemv| (get |cf| "values")))))
            (throw |cf|)))))
 
 (define-compilation throw (id value)
@@ -1172,9 +1170,11 @@
 
 (define-builtin characterp (x)
   (js!bool
-   (js!selfcall
-     "var x = " x ";"
-     "return (typeof(" x ") == \"string\") && (x.length == 1 || x.length == 2);")))
+   (js!selfcall*
+     `(var (x ,x))
+     `(return (and (== (typeof x) "string")
+                   (or (== (get x "length") 1)
+                       (== (get x "length") 2)))))))
 
 (define-builtin char-upcase (x)
   `(call |safe_char_upcase| ,x))
@@ -1191,15 +1191,14 @@
                    (== (get x "stringp") 1))))))
 
 (define-raw-builtin funcall (func &rest args)
-  (js!selfcall
-    "var f = " (ls-compile func) ";"
-    "return (typeof f === 'function'? f: f.fvalue)("
-    `(code
-     ,@(interleave (list* (if *multiple-value-p* "values" "pv")
-                          (integer-to-string (length args))
-                          (mapcar #'ls-compile args))
-                   ", "))
-    ")"))
+  (js!selfcall*
+    `(var (f ,(ls-compile func)))
+    `(return (call (if (=== (typeof f) "function")
+                       f
+                       (get f "fvalue"))
+                   ,@(list* (if *multiple-value-p* '|values| '|pv|)
+                            (length args)
+                            (mapcar #'ls-compile args))))))
 
 (define-raw-builtin apply (func &rest args)
   (if (null args)
@@ -1265,7 +1264,7 @@
 
 (define-builtin storage-vector-ref (vector n)
   (js!selfcall*
-    `(var (x (get ,vector ,n)))
+    `(var (x (property ,vector ,n)))
     `(if (=== x undefined) (throw "Out of range."))
     `(return x)))
 
@@ -1286,18 +1285,17 @@
     `(return r)))
 
 (define-builtin get-internal-real-time ()
-  `(call (get (new (call Date)) "getTime")))
+  `(call (get (new (call |Date|)) "getTime")))
 
 (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
 
@@ -1307,11 +1305,11 @@
 (define-raw-builtin oget* (object key &rest keys)
   (js!selfcall*
     `(progn
-       (var (tmp (get ,(ls-compile object) (call |xstring| ,(ls-compile key)))))
+       (var (tmp (property ,(ls-compile object) (call |xstring| ,(ls-compile key)))))
        ,@(mapcar (lambda (key)
                    `(progn
                       (if (=== tmp undefined) (return ,(ls-compile nil)))
-                      (= tmp (get tmp (call |xstring| ,(ls-compile key))))))
+                      (= tmp (property tmp (call |xstring| ,(ls-compile key))))))
                  keys))
     `(return (if (=== tmp undefined) ,(ls-compile nil) tmp))))
 
@@ -1322,12 +1320,12 @@
          (var (obj ,(ls-compile object)))
          ,@(mapcar (lambda (key)
                      `(progn
-                        (= obj (get obj (call |xstring| ,(ls-compile key))))
+                        (= obj (property obj (call |xstring| ,(ls-compile key))))
                         (if (=== object undefined)
                             (throw "Impossible to set object property."))))
                    (butlast keys))
          (var (tmp
-               (= (get obj (call |xstring| ,(ls-compile (car (last keys)))))
+               (= (property obj (call |xstring| ,(ls-compile (car (last keys)))))
                   ,(ls-compile value))))
          (return (if (=== tmp undefined)
                      ,(ls-compile nil)
@@ -1359,10 +1357,10 @@
     `(return ,(ls-compile nil))))
 
 (define-compilation %js-vref (var)
-  `(code "js_to_lisp(" ,var ")"))
+  `(call |js_to_lisp| ,(make-symbol var)))
 
 (define-compilation %js-vset (var val)
-  `(code "(" ,var " = lisp_to_js(" ,(ls-compile val) "))"))
+  `(= ,(make-symbol var) (call |lisp_to_js| ,(ls-compile val))))
 
 (define-setf-expander %js-vref (var)
   (let ((new-value (gensym)))