Add DO-SOURCE macro for iterating over source files

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 6e26947..51fb547 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -20,6 +20,11 @@
 
 (/debug "loading compiler.lisp!")
 
+;;; Translate the Lisp code to Javascript. It will compile the special
+;;; forms. Some primitive functions are compiled as special forms
+;;; too. The respective real functions are defined in the target (see
+;;; the beginning of this file) as well as some primitive functions.
+
 (define-js-macro selfcall (&body body)
   `(call (function () ,@body)))
 
@@ -29,25 +34,6 @@
 (define-js-macro method-call (x method &rest args)
   `(call (get ,x ,method) ,@args))
 
-;;; Translate the Lisp code to Javascript. It will compile the special
-;;; forms. Some primitive functions are compiled as special forms
-;;; too. The respective real functions are defined in the target (see
-;;; the beginning of this file) as well as some primitive functions.
-
-(defun interleave (list element &optional after-last-p)
-  (unless (null list)
-    (with-collect
-      (collect (car list))
-      (dolist (x (cdr list))
-        (collect element)
-        (collect x))
-      (when after-last-p
-        (collect element)))))
-
-;;; Like CODE, but prefix each line with four spaces. Two versions
-;;; of this function are available, because the Ecmalisp version is
-;;; very slow and bootstraping was annoying.
-
 ;;; A Form can return a multiple values object calling VALUES, like
 ;;; values(arg1, arg2, ...). It will work in any context, as well as
 ;;; returning an individual object. However, if the special variable
@@ -759,12 +745,12 @@
 
 (define-compilation catch (id &rest body)
   `(selfcall
-    (var (|id| ,(convert id)))
+    (var (id ,(convert id)))
     (try
      ,(convert-block body t))
     (catch (|cf|)
       (if (and (== (get |cf| "type") "catch")
-               (== (get |cf| "id") |id|))
+               (== (get |cf| "id") id))
           ,(if *multiple-value-p*
                `(return (method-call |values| "apply" this (call |forcemv| (get |cf| "values"))))
                `(return (method-call |pv|     "apply" this (call |forcemv| (get |cf| "values")))))
@@ -774,10 +760,10 @@
   `(selfcall
     (var (|values| |mv|))
     (throw (object
-            |type| "catch"
-            |id| ,(convert id)
-            |values| ,(convert value t)
-            |message| "Throw uncatched."))))
+            "type" "catch"
+            "id" ,(convert id)
+            "values" ,(convert value t)
+            "message" "Throw uncatched."))))
 
 (defun go-tag-p (x)
   (or (integerp x) (symbolp x)))
@@ -848,12 +834,12 @@
 
 (define-compilation unwind-protect (form &rest clean-up)
   `(selfcall
-    (var (|ret| ,(convert nil)))
+    (var (ret ,(convert nil)))
     (try
-     (= |ret| ,(convert form)))
+     (= ret ,(convert form)))
     (finally
      ,(convert-block clean-up))
-    (return |ret|)))
+    (return ret)))
 
 (define-compilation multiple-value-call (func-form &rest forms)
   `(selfcall
@@ -1017,10 +1003,16 @@
                 (get tmp "cdr")))))
 
 (define-builtin rplaca (x new)
-  `(= (get ,x "car") ,new))
+  `(selfcall
+     (var (tmp ,x))
+     (= (get tmp "car") ,new)
+     (return tmp)))
 
 (define-builtin rplacd (x new)
-  `(= (get ,x "cdr") ,new))
+  `(selfcall
+     (var (tmp ,x))
+     (= (get tmp "cdr") ,new)
+     (return tmp)))
 
 (define-builtin symbolp (x)
   `(bool (instanceof ,x |Symbol|)))
@@ -1344,7 +1336,13 @@
       ((and (consp function) (eq (car function) 'lambda))
        `(call ,(convert `#',function) ,@arglist))
       ((and (consp function) (eq (car function) 'oget))
-       `(call ,(convert function) ,@arglist))
+       `(call |js_to_lisp|
+              (call ,(reduce (lambda (obj p)
+                               `(property ,obj (call |xstring| ,p)))
+                             (mapcar #'convert (cdr function)))
+                    ,@(mapcar (lambda (s)
+                                `(call |lisp_to_js| ,s))
+                              args))))
       (t
        (error "Bad function descriptor")))))