X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=1c0bad185aa31a748fb30af99995529d16cccd5b;hb=852666e17ad12f114ab5bb05a9d5ff065f8d72ff;hp=a662d4d2982ae84d511f8faaa581947e7bbb4650;hpb=91fd1e39d4f509e13fcab3ce3a2dd5a17ddcdcc5;p=jscl.git

diff --git a/src/compiler.lisp b/src/compiler.lisp
index a662d4d..1c0bad1 100644
--- 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
@@ -420,8 +406,6 @@
             (eq (binding-type b) 'variable)
             (not (member 'special (binding-declarations b)))
             (not (member 'constant (binding-declarations b))))
-       ;; TODO: Unnecesary make-symbol when codegen migration is
-       ;; finished.
        `(= ,(binding-value b) ,(convert val)))
       ((and b (eq (binding-type b) 'macro))
        (convert `(setf ,var ,val)))
@@ -505,9 +489,7 @@
   (cond
     ((integerp sexp) sexp)
     ((floatp sexp) sexp)
-    ((characterp sexp)
-     ;; TODO: Remove selfcall after migration
-     `(selfcall (return ,(string sexp))))
+    ((characterp sexp) (string sexp))
     (t
      (or (cdr (assoc sexp *literal-table* :test #'eql))
          (let ((dumped (typecase sexp
@@ -538,9 +520,6 @@
 (define-compilation %while (pred &rest body)
   `(selfcall
     (while (!== ,(convert pred) ,(convert nil))
-      0                                 ; TODO: Force
-                                        ; braces. Unnecesary when code
-                                        ; is gone
       ,(convert-block body))
     (return ,(convert nil))))
 
@@ -743,7 +722,6 @@
                        `(return (method-call |values| "apply" this (call |forcemv| (get cf "values"))))
                        `(return (get cf "values")))
                   (throw cf))))
-          ;; TODO: is selfcall necessary here?
           `(selfcall ,cbody)))))
 
 (define-compilation return-from (name &optional value)
@@ -767,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")))))
@@ -782,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)))
@@ -856,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
@@ -885,7 +863,6 @@
 (define-compilation multiple-value-prog1 (first-form &rest forms)
   `(selfcall
     (var (args ,(convert first-form *multiple-value-p*)))
-    ;; TODO: Interleave is temporal
     (progn ,@(mapcar #'convert forms))
     (return args)))
 
@@ -1353,7 +1330,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")))))
 
@@ -1367,10 +1350,10 @@
            (return ,(convert (car (last sexps)) *multiple-value-p*)))
         `(progn ,@(mapcar #'convert sexps)))))
 
-(defun convert* (sexp &optional multiple-value-p)
+(defun convert (sexp &optional multiple-value-p)
   (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp)
     (when expandedp
-      (return-from convert* (convert sexp multiple-value-p)))
+      (return-from convert (convert sexp multiple-value-p)))
     ;; The expression has been macroexpanded. Now compile it!
     (let ((*multiple-value-p* multiple-value-p))
       (cond
@@ -1404,9 +1387,6 @@
         (t
          (error "How should I compile `~S'?" sexp))))))
 
-(defun convert (sexp &optional multiple-value-p)
-  (convert* sexp multiple-value-p))
-
 
 (defvar *compile-print-toplevels* nil)