Remove CONVERT*
[jscl.git] / src / compiler.lisp
index 0ce17c3..6e26947 100644 (file)
   `(call (function () ,@body)))
 
 (define-js-macro bool (expr)
   `(call (function () ,@body)))
 
 (define-js-macro bool (expr)
-  `(if ,expr ,(ls-compile t) ,(ls-compile nil)))
+  `(if ,expr ,(convert t) ,(convert nil)))
+
+(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
 
 ;;; Translate the Lisp code to Javascript. It will compile the special
 ;;; forms. Some primitive functions are compiled as special forms
       (when after-last-p
         (collect element)))))
 
       (when after-last-p
         (collect element)))))
 
-(defun code (&rest args)
-  (mapconcat (lambda (arg)
-               (cond
-                 ((null arg) "")
-                 ((integerp arg) (integer-to-string arg))
-                 ((floatp arg) (float-to-string arg))
-                 ((stringp arg) arg)
-                 (t
-                  (with-output-to-string (*standard-output*)
-                    (js-expr arg)))))
-             args))
-
-;;; Concatenate the arguments and wrap them with a self-calling
-;;; Javascript anonymous function. It is used to make some Javascript
-;;; statements valid expressions and provide a private scope as well.
-;;; It could be defined as function, but we could do some
-;;; preprocessing in the future.
-(defmacro js!selfcall (&body body)
-  ``(call (function nil (code ,,@body))))
-
-
 ;;; 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.
 ;;; 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.
 (defun gvarname (symbol)
   (declare (ignore symbol))
   (incf *variable-counter*)
 (defun gvarname (symbol)
   (declare (ignore symbol))
   (incf *variable-counter*)
-  (concat "v" (integer-to-string *variable-counter*)))
+  (make-symbol (concat "v" (integer-to-string *variable-counter*))))
 
 (defun translate-variable (symbol)
   (awhen (lookup-in-lexenv symbol *environment* 'variable)
 
 (defun translate-variable (symbol)
   (awhen (lookup-in-lexenv symbol *environment* 'variable)
   (reverse *toplevel-compilations*))
 
 (defun %compile-defmacro (name lambda)
   (reverse *toplevel-compilations*))
 
 (defun %compile-defmacro (name lambda)
-  (toplevel-compilation (ls-compile `',name))
+  (toplevel-compilation (convert `',name))
   (let ((binding (make-binding :name name :type 'macro :value lambda)))
     (push-to-lexenv binding  *environment* 'function))
   name)
   (let ((binding (make-binding :name name :type 'macro :value lambda)))
     (push-to-lexenv binding  *environment* 'function))
   name)
          *compilations*))
 
 (define-compilation if (condition true &optional false)
          *compilations*))
 
 (define-compilation if (condition true &optional false)
-  `(if (!== ,(ls-compile condition) ,(ls-compile nil))
-       ,(ls-compile true *multiple-value-p*)
-       ,(ls-compile false *multiple-value-p*)))
+  `(if (!== ,(convert condition) ,(convert nil))
+       ,(convert true *multiple-value-p*)
+       ,(convert false *multiple-value-p*)))
 
 (defvar *ll-keywords* '(&optional &rest &key))
 
 
 (defvar *ll-keywords* '(&optional &rest &key))
 
                   (dotimes (idx n-optional-arguments)
                     (let ((arg (nth idx optional-arguments)))
                       (collect `(case ,(+ idx n-required-arguments)))
                   (dotimes (idx n-optional-arguments)
                     (let ((arg (nth idx optional-arguments)))
                       (collect `(case ,(+ idx n-required-arguments)))
-                      (collect `(= ,(make-symbol (translate-variable (car arg)))
-                                   ,(ls-compile (cadr arg))))
+                      (collect `(= ,(translate-variable (car arg))
+                                   ,(convert (cadr arg))))
                       (collect (when (third arg)
                       (collect (when (third arg)
-                                 `(= ,(make-symbol (translate-variable (third arg)))
-                                     ,(ls-compile nil))))))
+                                 `(= ,(translate-variable (third arg))
+                                     ,(convert nil))))))
                   (collect 'default)
                   (collect '(break)))))))
 
                   (collect 'default)
                   (collect '(break)))))))
 
        (n-optional-arguments (length (ll-optional-arguments ll)))
        (rest-argument (ll-rest-argument ll)))
     (when rest-argument
        (n-optional-arguments (length (ll-optional-arguments ll)))
        (rest-argument (ll-rest-argument ll)))
     (when rest-argument
-      (let ((js!rest (make-symbol (translate-variable rest-argument))))
+      (let ((js!rest (translate-variable rest-argument)))
         `(progn
         `(progn
-           (var (,js!rest ,(ls-compile nil)))
+           (var (,js!rest ,(convert nil)))
            (var i)
            (for ((= i (- |nargs| 1))
                  (>= i ,(+ n-required-arguments n-optional-arguments))
            (var i)
            (for ((= i (- |nargs| 1))
                  (>= i ,(+ n-required-arguments n-optional-arguments))
             (destructuring-bind ((keyword-name var) &optional initform svar)
                 keyword-argument
               (declare (ignore keyword-name initform))
             (destructuring-bind ((keyword-name var) &optional initform svar)
                 keyword-argument
               (declare (ignore keyword-name initform))
-              (collect `(var ,(make-symbol (translate-variable var))))
+              (collect `(var ,(translate-variable var)))
               (when svar
                 (collect
               (when svar
                 (collect
-                    `(var (,(make-symbol (translate-variable svar))
-                            ,(ls-compile nil))))))))
+                    `(var (,(translate-variable svar)
+                            ,(convert nil))))))))
        
        ;; Parse keywords
        ,(flet ((parse-keyword (keyarg)
        
        ;; Parse keywords
        ,(flet ((parse-keyword (keyarg)
                            (+= i 2))
                           ;; ....
                           (if (=== (property |arguments| (+ i 2))
                            (+= i 2))
                           ;; ....
                           (if (=== (property |arguments| (+ i 2))
-                                   ,(ls-compile keyword-name))
+                                   ,(convert keyword-name))
                               (progn
                               (progn
-                                (= ,(make-symbol (translate-variable var))
+                                (= ,(translate-variable var)
                                    (property |arguments| (+ i 3)))
                                    (property |arguments| (+ i 3)))
-                                ,(when svar `(= ,(make-symbol (translate-variable svar))
-                                                ,(ls-compile t)))
+                                ,(when svar `(= ,(translate-variable svar)
+                                                ,(convert t)))
                                 (break))))
                      (if (== i |nargs|)
                                 (break))))
                      (if (== i |nargs|)
-                         (= ,(make-symbol (translate-variable var))
-                            ,(ls-compile initform)))))))
+                         (= ,(translate-variable var) ,(convert initform)))))))
          (when keyword-arguments
            `(progn
               (var i)
          (when keyword-arguments
            `(progn
               (var i)
                                  (destructuring-bind ((keyword-name var) &optional initform svar)
                                      keyword-argument
                                    (declare (ignore var initform svar))
                                  (destructuring-bind ((keyword-name var) &optional initform svar)
                                      keyword-argument
                                    (declare (ignore var initform svar))
-                                   `(!== (property |arguments| (+ i 2)) ,(ls-compile keyword-name))))
+                                   `(!== (property |arguments| (+ i 2)) ,(convert keyword-name))))
                                keyword-arguments))
                      (throw (+ "Unknown keyword argument "
                                (call |xstring|
                                keyword-arguments))
                      (throw (+ "Unknown keyword argument "
                                (call |xstring|
                                     (ll-svars ll)))))
         (lambda-name/docstring-wrapper name documentation
          `(function (|values| |nargs| ,@(mapcar (lambda (x)
                                     (ll-svars ll)))))
         (lambda-name/docstring-wrapper name documentation
          `(function (|values| |nargs| ,@(mapcar (lambda (x)
-                                                  (make-symbol (translate-variable x)))
+                                                  (translate-variable x))
                                                 (append required-arguments optional-arguments)))
                      ;; Check number of arguments
                     ,(lambda-check-argument-count n-required-arguments
                                                 (append required-arguments optional-arguments)))
                      ;; Check number of arguments
                     ,(lambda-check-argument-count n-required-arguments
 
                     ,(let ((*multiple-value-p* t))
                           (if block
 
                     ,(let ((*multiple-value-p* t))
                           (if block
-                              (ls-compile-block `((block ,block ,@body)) t)
-                              (ls-compile-block body t)))))))))
+                              (convert-block `((block ,block ,@body)) t)
+                              (convert-block body t)))))))))
 
 
 (defun setq-pair (var val)
 
 
 (defun setq-pair (var val)
             (eq (binding-type b) 'variable)
             (not (member 'special (binding-declarations b)))
             (not (member 'constant (binding-declarations b))))
             (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.
-       `(= ,(make-symbol (binding-value b)) ,(ls-compile val)))
+       `(= ,(binding-value b) ,(convert val)))
       ((and b (eq (binding-type b) 'macro))
       ((and b (eq (binding-type b) 'macro))
-       (ls-compile `(setf ,var ,val)))
+       (convert `(setf ,var ,val)))
       (t
       (t
-       (ls-compile `(set ',var ,val))))))
+       (convert `(set ',var ,val))))))
 
 
 (define-compilation setq (&rest pairs)
   (let ((result nil))
     (when (null pairs)
 
 
 (define-compilation setq (&rest pairs)
   (let ((result nil))
     (when (null pairs)
-      (return-from setq (ls-compile nil)))
+      (return-from setq (convert nil)))
     (while t
       (cond
        ((null pairs)
     (while t
       (cond
        ((null pairs)
 
 (defun genlit ()
   (incf *literal-counter*)
 
 (defun genlit ()
   (incf *literal-counter*)
-  (concat "l" (integer-to-string *literal-counter*)))
+  (make-symbol (concat "l" (integer-to-string *literal-counter*))))
 
 (defun dump-symbol (symbol)
   #-jscl
 
 (defun dump-symbol (symbol)
   #-jscl
   (let ((package (symbol-package symbol)))
     (if (null package)
         `(new (call |Symbol| ,(dump-string (symbol-name symbol))))
   (let ((package (symbol-package symbol)))
     (if (null package)
         `(new (call |Symbol| ,(dump-string (symbol-name symbol))))
-        (ls-compile `(intern ,(symbol-name symbol) ,(package-name package))))))
+        (convert `(intern ,(symbol-name symbol) ,(package-name package))))))
 
 (defun dump-cons (cons)
   (let ((head (butlast cons))
 
 (defun dump-cons (cons)
   (let ((head (butlast cons))
   (cond
     ((integerp sexp) sexp)
     ((floatp sexp) sexp)
   (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
     (t
      (or (cdr (assoc sexp *literal-table* :test #'eql))
          (let ((dumped (typecase sexp
                           ;; `dump-global-environment' for futher
                           ;; information.
                           (if (eq (car sexp) *magic-unquote-marker*)
                           ;; `dump-global-environment' for futher
                           ;; information.
                           (if (eq (car sexp) *magic-unquote-marker*)
-                              (ls-compile (second sexp))
+                              (convert (second sexp))
                               (dump-cons sexp)))
                          (array (dump-array sexp)))))
            (if (and recursive (not (symbolp sexp)))
                dumped
                (let ((jsvar (genlit)))
                               (dump-cons sexp)))
                          (array (dump-array sexp)))))
            (if (and recursive (not (symbolp sexp)))
                dumped
                (let ((jsvar (genlit)))
-                 (push (cons sexp (make-symbol jsvar)) *literal-table*)
-                 (toplevel-compilation `(var (,(make-symbol jsvar) ,dumped)))
+                 (push (cons sexp jsvar) *literal-table*)
+                 (toplevel-compilation `(var (,jsvar ,dumped)))
                  (when (keywordp sexp)
                  (when (keywordp sexp)
-                   (toplevel-compilation `(= ,(get (make-symbol jsvar) "value") ,(make-symbol jsvar))))
-                 (make-symbol jsvar))))))))
+                   (toplevel-compilation `(= ,(get jsvar "value") ,jsvar)))
+                 jsvar)))))))
 
 
 (define-compilation quote (sexp)
 
 
 (define-compilation quote (sexp)
 
 (define-compilation %while (pred &rest body)
   `(selfcall
 
 (define-compilation %while (pred &rest body)
   `(selfcall
-    (while (!== ,(ls-compile pred) ,(ls-compile nil))
-      0                                 ; TODO: Force
-                                        ; braces. Unnecesary when code
-                                        ; is gone
-      ,(ls-compile-block body))
-    (return ,(ls-compile nil))))
+    (while (!== ,(convert pred) ,(convert nil))
+      ,(convert-block body))
+    (return ,(convert nil))))
 
 (define-compilation function (x)
   (cond
 
 (define-compilation function (x)
   (cond
     ((symbolp x)
      (let ((b (lookup-in-lexenv x *environment* 'function)))
        (if b
     ((symbolp x)
      (let ((b (lookup-in-lexenv x *environment* 'function)))
        (if b
-          (make-symbol (binding-value b))
-          (ls-compile `(symbol-function ',x)))))))
+          (binding-value b)
+          (convert `(symbol-function ',x)))))))
 
 (defun make-function-binding (fname)
   (make-binding :name fname :type 'function :value (gvarname fname)))
 
 (defun make-function-binding (fname)
   (make-binding :name fname :type 'function :value (gvarname fname)))
           (extend-lexenv (mapcar #'make-function-binding fnames)
                          *environment*
                          'function)))
           (extend-lexenv (mapcar #'make-function-binding fnames)
                          *environment*
                          'function)))
-    `(call (function ,(mapcar #'make-symbol (mapcar #'translate-function fnames))
-                ,(ls-compile-block body t))
+    `(call (function ,(mapcar #'translate-function fnames)
+                ,(convert-block body t))
            ,@cfuncs)))
 
 (define-compilation labels (definitions &rest body)
            ,@cfuncs)))
 
 (define-compilation labels (definitions &rest body)
                          'function)))
     `(selfcall
       ,@(mapcar (lambda (func)
                          'function)))
     `(selfcall
       ,@(mapcar (lambda (func)
-                  `(var (,(make-symbol (translate-function (car func)))
+                  `(var (,(translate-function (car func))
                           ,(compile-lambda (cadr func)
                                            `((block ,(car func) ,@(cddr func)))))))
                 definitions)
                           ,(compile-lambda (cadr func)
                                            `((block ,(car func) ,@(cddr func)))))))
                 definitions)
-      ,(ls-compile-block body t))))
+      ,(convert-block body t))))
 
 
 (defvar *compiling-file* nil)
 
 
 (defvar *compiling-file* nil)
   (if *compiling-file*
       (progn
         (eval (cons 'progn body))
   (if *compiling-file*
       (progn
         (eval (cons 'progn body))
-        (ls-compile 0))
-      (ls-compile `(progn ,@body))))
+        (convert 0))
+      (convert `(progn ,@body))))
 
 (defmacro define-transformation (name args form)
   `(define-compilation ,name ,args
 
 (defmacro define-transformation (name args form)
   `(define-compilation ,name ,args
-     (ls-compile ,form)))
+     (convert ,form)))
 
 (define-compilation progn (&rest body)
   (if (null (cdr body))
 
 (define-compilation progn (&rest body)
   (if (null (cdr body))
-      (ls-compile (car body) *multiple-value-p*)
+      (convert (car body) *multiple-value-p*)
       `(progn
       `(progn
-         ,@(append (mapcar #'ls-compile (butlast body))
-                   (list (ls-compile (car (last body)) t))))))
+         ,@(append (mapcar #'convert (butlast body))
+                   (list (convert (car (last body)) t))))))
 
 (define-compilation macrolet (definitions &rest body)
   (let ((*environment* (copy-lexenv *environment*)))
 
 (define-compilation macrolet (definitions &rest body)
   (let ((*environment* (copy-lexenv *environment*)))
                                           (destructuring-bind ,lambda-list ,g!form
                                             ,@body))))))
           (push-to-lexenv binding  *environment* 'function))))
                                           (destructuring-bind ,lambda-list ,g!form
                                             ,@body))))))
           (push-to-lexenv binding  *environment* 'function))))
-    (ls-compile `(progn ,@body) *multiple-value-p*)))
+    (convert `(progn ,@body) *multiple-value-p*)))
 
 
 (defun special-variable-p (x)
 
 
 (defun special-variable-p (x)
      (try (var tmp)
           ,@(with-collect
              (dolist (b bindings)
      (try (var tmp)
           ,@(with-collect
              (dolist (b bindings)
-               (let ((s (ls-compile `',(car b))))
+               (let ((s (convert `',(car b))))
                  (collect `(= tmp (get ,s "value")))
                  (collect `(= (get ,s "value") ,(cdr b)))
                  (collect `(= ,(cdr b) tmp)))))
                  (collect `(= tmp (get ,s "value")))
                  (collect `(= (get ,s "value") ,(cdr b)))
                  (collect `(= ,(cdr b) tmp)))))
      (finally
       ,@(with-collect
          (dolist (b bindings)
      (finally
       ,@(with-collect
          (dolist (b bindings)
-           (let ((s (ls-compile `(quote ,(car b)))))
+           (let ((s (convert `(quote ,(car b)))))
              (collect `(= (get ,s "value") ,(cdr b)))))))))
 
 (define-compilation let (bindings &rest body)
   (let* ((bindings (mapcar #'ensure-list bindings))
          (variables (mapcar #'first bindings))
              (collect `(= (get ,s "value") ,(cdr b)))))))))
 
 (define-compilation let (bindings &rest body)
   (let* ((bindings (mapcar #'ensure-list bindings))
          (variables (mapcar #'first bindings))
-         (cvalues (mapcar #'ls-compile (mapcar #'second bindings)))
+         (cvalues (mapcar #'convert (mapcar #'second bindings)))
          (*environment* (extend-local-env (remove-if #'special-variable-p variables)))
          (dynamic-bindings))
     `(call (function ,(mapcar (lambda (x)
                                 (if (special-variable-p x)
                                     (let ((v (gvarname x)))
          (*environment* (extend-local-env (remove-if #'special-variable-p variables)))
          (dynamic-bindings))
     `(call (function ,(mapcar (lambda (x)
                                 (if (special-variable-p x)
                                     (let ((v (gvarname x)))
-                                      (push (cons x (make-symbol v)) dynamic-bindings)
-                                      (make-symbol v))
-                                    (make-symbol (translate-variable x))))
+                                      (push (cons x v) dynamic-bindings)
+                                      v)
+                                    (translate-variable x)))
                               variables)
                               variables)
-                     ,(let ((body (ls-compile-block body t t)))
+                     ,(let ((body (convert-block body t t)))
                            `,(let-binding-wrapper dynamic-bindings body)))
            ,@cvalues)))
 
                            `,(let-binding-wrapper dynamic-bindings body)))
            ,@cvalues)))
 
   (let ((var (first binding))
         (value (second binding)))
     (if (special-variable-p var)
   (let ((var (first binding))
         (value (second binding)))
     (if (special-variable-p var)
-        (ls-compile `(setq ,var ,value))
+        (convert `(setq ,var ,value))
         (let* ((v (gvarname var))
                (b (make-binding :name var :type 'variable :value v)))
         (let* ((v (gvarname var))
                (b (make-binding :name var :type 'variable :value v)))
-          (prog1 `(var (,(make-symbol v) ,(ls-compile value)))
+          (prog1 `(var (,v ,(convert value)))
             (push-to-lexenv b *environment* 'variable))))))
 
 ;;; Wrap BODY to restore the symbol values of SYMBOLS after body. It
             (push-to-lexenv b *environment* 'variable))))))
 
 ;;; Wrap BODY to restore the symbol values of SYMBOLS after body. It
     `(progn
        (try
         ,@(mapcar (lambda (b)
     `(progn
        (try
         ,@(mapcar (lambda (b)
-                    (let ((s (ls-compile `(quote ,(car b)))))
-                      `(var (,(make-symbol (cdr b)) (get ,s "value")))))
+                    (let ((s (convert `(quote ,(car b)))))
+                      `(var (,(cdr b) (get ,s "value")))))
                   store)
         ,body)
        (finally
         ,@(mapcar (lambda (b)
                   store)
         ,body)
        (finally
         ,@(mapcar (lambda (b)
-                    (let ((s (ls-compile `(quote ,(car b)))))
-                      `(= (get ,s "value") ,(make-symbol (cdr b)))))
+                    (let ((s (convert `(quote ,(car b)))))
+                      `(= (get ,s "value") ,(cdr b))))
                   store)))))
 
 (define-compilation let* (bindings &rest body)
                   store)))))
 
 (define-compilation let* (bindings &rest body)
     (let ((specials (remove-if-not #'special-variable-p (mapcar #'first bindings)))
           (body `(progn
                    ,@(mapcar #'let*-initialize-value bindings)
     (let ((specials (remove-if-not #'special-variable-p (mapcar #'first bindings)))
           (body `(progn
                    ,@(mapcar #'let*-initialize-value bindings)
-                   ,(ls-compile-block body t t))))
+                   ,(convert-block body t t))))
       `(selfcall ,(let*-binding-wrapper specials body)))))
 
 
       `(selfcall ,(let*-binding-wrapper specials body)))))
 
 
     (when *multiple-value-p*
       (push 'multiple-value (binding-declarations b)))
     (let* ((*environment* (extend-lexenv (list b) *environment* 'block))
     (when *multiple-value-p*
       (push 'multiple-value (binding-declarations b)))
     (let* ((*environment* (extend-lexenv (list b) *environment* 'block))
-           (cbody (ls-compile-block body t)))
+           (cbody (convert-block body t)))
       (if (member 'used (binding-declarations b))
           `(selfcall
             (try
       (if (member 'used (binding-declarations b))
           `(selfcall
             (try
-             (var (,(make-symbol idvar) #()))
+             (var (,idvar #()))
              ,cbody)
             (catch (cf)
               (if (and (== (get cf "type") "block")
              ,cbody)
             (catch (cf)
               (if (and (== (get cf "type") "block")
-                       (== (get cf "id") ,(make-symbol idvar)))
+                       (== (get cf "id") ,idvar))
                   ,(if *multiple-value-p*
                   ,(if *multiple-value-p*
-                       `(return (call (get |values| "apply") this (call |forcemv| (get cf "values"))))
+                       `(return (method-call |values| "apply" this (call |forcemv| (get cf "values"))))
                        `(return (get cf "values")))
                   (throw cf))))
                        `(return (get cf "values")))
                   (throw cf))))
-          ;; TODO: is selfcall necessary here?
           `(selfcall ,cbody)))))
 
 (define-compilation return-from (name &optional value)
           `(selfcall ,cbody)))))
 
 (define-compilation return-from (name &optional value)
       (throw
           (object
            "type" "block"
       (throw
           (object
            "type" "block"
-           "id" ,(make-symbol (binding-value b))
-           "values" ,(ls-compile value multiple-value-p)
+           "id" ,(binding-value b)
+           "values" ,(convert value multiple-value-p)
            "message" ,(concat "Return from unknown block '" (symbol-name name) "'."))))))
 
 (define-compilation catch (id &rest body)
   `(selfcall
            "message" ,(concat "Return from unknown block '" (symbol-name name) "'."))))))
 
 (define-compilation catch (id &rest body)
   `(selfcall
-    (var (|id| ,(ls-compile id)))
+    (var (|id| ,(convert id)))
     (try
     (try
-     ,(ls-compile-block body t))
+     ,(convert-block body t))
     (catch (|cf|)
       (if (and (== (get |cf| "type") "catch")
                (== (get |cf| "id") |id|))
           ,(if *multiple-value-p*
     (catch (|cf|)
       (if (and (== (get |cf| "type") "catch")
                (== (get |cf| "id") |id|))
           ,(if *multiple-value-p*
-               `(return (call (get |values| "apply")
-                              this
-                              (call |forcemv| (get |cf| "values"))))
-               `(return (call (get |pv| "apply")
-                              this
-                              (call |forcemv| (get |cf| "values")))))
+               `(return (method-call |values| "apply" this (call |forcemv| (get |cf| "values"))))
+               `(return (method-call |pv|     "apply" this (call |forcemv| (get |cf| "values")))))
           (throw |cf|)))))
 
 (define-compilation throw (id value)
           (throw |cf|)))))
 
 (define-compilation throw (id value)
     (var (|values| |mv|))
     (throw (object
             |type| "catch"
     (var (|values| |mv|))
     (throw (object
             |type| "catch"
-            |id| ,(ls-compile id)
-            |values| ,(ls-compile value t)
+            |id| ,(convert id)
+            |values| ,(convert value t)
             |message| "Throw uncatched."))))
 
 (defun go-tag-p (x)
             |message| "Throw uncatched."))))
 
 (defun go-tag-p (x)
   ;; because 1) it is easy and 2) many built-in forms expand to a
   ;; implicit tagbody, so we save some space.
   (unless (some #'go-tag-p body)
   ;; because 1) it is easy and 2) many built-in forms expand to a
   ;; implicit tagbody, so we save some space.
   (unless (some #'go-tag-p body)
-    (return-from tagbody (ls-compile `(progn ,@body nil))))
+    (return-from tagbody (convert `(progn ,@body nil))))
   ;; The translation assumes the first form in BODY is a label
   (unless (go-tag-p (car body))
     (push (gensym "START") body))
   ;; The translation assumes the first form in BODY is a label
   (unless (go-tag-p (car body))
     (push (gensym "START") body))
         (setq initag (second (binding-value b))))
       `(selfcall
         ;; TAGBODY branch to take
         (setq initag (second (binding-value b))))
       `(selfcall
         ;; TAGBODY branch to take
-        (var (,(make-symbol branch) ,initag))
-        (var (,(make-symbol tbidx) #()))
+        (var (,branch ,initag))
+        (var (,tbidx #()))
         (label tbloop
                (while true
                  (try
         (label tbloop
                (while true
                  (try
-                  (switch ,(make-symbol branch)
+                  (switch ,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)))))
                           ,@(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)))))
+                                   (collect (convert form)))))
                           default
                           (break tbloop)))
                  (catch (jump)
                    (if (and (== (get jump "type") "tagbody")
                           default
                           (break tbloop)))
                  (catch (jump)
                    (if (and (== (get jump "type") "tagbody")
-                            (== (get jump "id") ,(make-symbol tbidx)))
-                       (= ,(make-symbol branch) (get jump "label"))
+                            (== (get jump "id") ,tbidx))
+                       (= ,branch (get jump "label"))
                        (throw jump)))))
                        (throw jump)))))
-        (return ,(ls-compile nil))))))
+        (return ,(convert nil))))))
 
 (define-compilation go (label)
   (let ((b (lookup-in-lexenv label *environment* 'gotag))
 
 (define-compilation go (label)
   (let ((b (lookup-in-lexenv label *environment* 'gotag))
       (throw
           (object
            "type" "tagbody"
       (throw
           (object
            "type" "tagbody"
-           "id" ,(make-symbol (first (binding-value b)))
+           "id" ,(first (binding-value b))
            "label" ,(second (binding-value b))
            "message" ,(concat "Attempt to GO to non-existing tag " n))))))
 
 (define-compilation unwind-protect (form &rest clean-up)
   `(selfcall
            "label" ,(second (binding-value b))
            "message" ,(concat "Attempt to GO to non-existing tag " n))))))
 
 (define-compilation unwind-protect (form &rest clean-up)
   `(selfcall
-    (var (|ret| ,(ls-compile nil)))
+    (var (|ret| ,(convert nil)))
     (try
     (try
-     (= |ret| ,(ls-compile form)))
+     (= |ret| ,(convert form)))
     (finally
     (finally
-     ,(ls-compile-block clean-up))
+     ,(convert-block clean-up))
     (return |ret|)))
 
 (define-compilation multiple-value-call (func-form &rest forms)
   `(selfcall
     (return |ret|)))
 
 (define-compilation multiple-value-call (func-form &rest forms)
   `(selfcall
-    (var (func ,(ls-compile func-form)))
+    (var (func ,(convert func-form)))
     (var (args ,(vector (if *multiple-value-p* '|values| '|pv|) 0)))
     (return
       (selfcall
     (var (args ,(vector (if *multiple-value-p* '|values| '|pv|) 0)))
     (return
       (selfcall
        (progn
          ,@(with-collect
             (dolist (form forms)
        (progn
          ,@(with-collect
             (dolist (form forms)
-              (collect `(= vs ,(ls-compile form t)))
+              (collect `(= vs ,(convert form t)))
               (collect `(if (and (=== (typeof vs) "object")
                                  (in "multiple-value" vs))
               (collect `(if (and (=== (typeof vs) "object")
                                  (in "multiple-value" vs))
-                            (= args (call (get args "concat") vs))
-                            (call (get args "push") vs))))))
+                            (= args (method-call args "concat" vs))
+                            (method-call args "push" vs))))))
        (= (property args 1) (- (property args "length") 2))
        (= (property args 1) (- (property args "length") 2))
-       (return (call (get func "apply") |window| args))))))
+       (return (method-call func "apply" |window| args))))))
 
 (define-compilation multiple-value-prog1 (first-form &rest forms)
   `(selfcall
 
 (define-compilation multiple-value-prog1 (first-form &rest forms)
   `(selfcall
-    (var (args ,(ls-compile first-form *multiple-value-p*)))
-    ;; TODO: Interleave is temporal
-    (progn ,@(mapcar #'ls-compile forms))
+    (var (args ,(convert first-form *multiple-value-p*)))
+    (progn ,@(mapcar #'convert forms))
     (return args)))
 
 (define-transformation backquote (form)
     (return args)))
 
 (define-transformation backquote (form)
 
 (defmacro define-builtin (name args &body body)
   `(define-raw-builtin ,name ,args
 
 (defmacro define-builtin (name args &body body)
   `(define-raw-builtin ,name ,args
-     (let ,(mapcar (lambda (arg) `(,arg (ls-compile ,arg))) args)
+     (let ,(mapcar (lambda (arg) `(,arg (convert ,arg))) args)
        ,@body)))
 
 ;;; VARIABLE-ARITY compiles variable arity operations. ARGS stands for
        ,@body)))
 
 ;;; VARIABLE-ARITY compiles variable arity operations. ARGS stands for
           (push x fargs)
           (let ((v (make-symbol (concat "x" (integer-to-string (incf counter))))))
             (push v fargs)
           (push x fargs)
           (let ((v (make-symbol (concat "x" (integer-to-string (incf counter))))))
             (push v fargs)
-            (push `(var (,v ,(ls-compile x)))
+            (push `(var (,v ,(convert x)))
                   prelude)
             (push `(if (!= (typeof ,v) "number")
                        (throw "Not a number!"))
                   prelude)
             (push `(if (!= (typeof ,v) "number")
                        (throw "Not a number!"))
   `(bool (== (typeof ,x) "number")))
 
 (define-builtin floor (x)
   `(bool (== (typeof ,x) "number")))
 
 (define-builtin floor (x)
-  `(call (get |Math| |floor|) ,x))
+  `(method-call |Math| "floor" ,x))
 
 (define-builtin expt (x y)
 
 (define-builtin expt (x y)
-  `(call (get |Math| |pow|) ,x ,y))
+  `(method-call |Math| "pow" ,x ,y))
 
 (define-builtin float-to-string (x)
 
 (define-builtin float-to-string (x)
-  `(call |make_lisp_string| (call (get ,x |toString|))))
+  `(call |make_lisp_string| (method-call ,x |toString|)))
 
 (define-builtin cons (x y)
   `(object "car" ,x "cdr" ,y))
 
 (define-builtin cons (x y)
   `(object "car" ,x "cdr" ,y))
 (define-builtin car (x)
   `(selfcall
     (var (tmp ,x))
 (define-builtin car (x)
   `(selfcall
     (var (tmp ,x))
-    (return (if (=== tmp ,(ls-compile nil))
-                ,(ls-compile nil)
+    (return (if (=== tmp ,(convert nil))
+                ,(convert nil)
                 (get tmp "car")))))
 
 (define-builtin cdr (x)
   `(selfcall
     (var (tmp ,x))
                 (get tmp "car")))))
 
 (define-builtin cdr (x)
   `(selfcall
     (var (tmp ,x))
-    (return (if (=== tmp ,(ls-compile nil))
-                ,(ls-compile nil)
+    (return (if (=== tmp ,(convert nil))
+                ,(convert nil)
                 (get tmp "cdr")))))
 
 (define-builtin rplaca (x new)
                 (get tmp "cdr")))))
 
 (define-builtin rplaca (x new)
     (return func)))
 
 (define-builtin symbol-plist (x)
     (return func)))
 
 (define-builtin symbol-plist (x)
-  `(or (get ,x "plist") ,(ls-compile nil)))
+  `(or (get ,x "plist") ,(convert nil)))
 
 (define-builtin lambda-code (x)
 
 (define-builtin lambda-code (x)
-  `(call |make_lisp_string| (call (get ,x "toString"))))
+  `(call |make_lisp_string| (method-call ,x "toString")))
 
 (define-builtin eq (x y)
   `(bool (=== ,x ,y)))
 
 (define-builtin eq (x y)
   `(bool (=== ,x ,y)))
 
 (define-raw-builtin funcall (func &rest args)
   `(selfcall
 
 (define-raw-builtin funcall (func &rest args)
   `(selfcall
-    (var (f ,(ls-compile func)))
+    (var (f ,(convert func)))
     (return (call (if (=== (typeof f) "function")
                       f
                       (get f "fvalue"))
                   ,@(list* (if *multiple-value-p* '|values| '|pv|)
                            (length args)
     (return (call (if (=== (typeof f) "function")
                       f
                       (get f "fvalue"))
                   ,@(list* (if *multiple-value-p* '|values| '|pv|)
                            (length args)
-                           (mapcar #'ls-compile args))))))
+                           (mapcar #'convert args))))))
 
 (define-raw-builtin apply (func &rest args)
   (if (null args)
 
 (define-raw-builtin apply (func &rest args)
   (if (null args)
-      (ls-compile func)
+      (convert func)
       (let ((args (butlast args))
             (last (car (last args))))
         `(selfcall
       (let ((args (butlast args))
             (last (car (last args))))
         `(selfcall
-           (var (f ,(ls-compile func)))
+           (var (f ,(convert func)))
            (var (args ,(list-to-vector
                         (list* (if *multiple-value-p* '|values| '|pv|)
                                (length args)
            (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"))
+                               (mapcar #'convert args)))))
+           (var (tail ,(convert last)))
+           (while (!= tail ,(convert nil))
+             (method-call args "push" (get tail "car"))
              (post++ (property args 1))
              (= tail (get tail "cdr")))
              (post++ (property args 1))
              (= tail (get tail "cdr")))
-           (return (call (get (if (=== (typeof f) "function")
-                                  f
-                                  (get f "fvalue"))
-                              "apply")
-                         this
-                         args))))))
+           (return (method-call (if (=== (typeof f) "function")
+                                    f
+                                    (get f "fvalue"))
+                                "apply"
+                                this
+                                args))))))
 
 (define-builtin js-eval (string)
   (if *multiple-value-p*
       `(selfcall
         (var (v (call |globalEval| (call |xstring| ,string))))
 
 (define-builtin js-eval (string)
   (if *multiple-value-p*
       `(selfcall
         (var (v (call |globalEval| (call |xstring| ,string))))
-        (return (call (get |values| "apply") this (call |forcemv| v))))
+        (return (method-call |values| "apply" this (call |forcemv| v))))
       `(call |globalEval| (call |xstring| ,string))))
 
 (define-builtin %throw (string)
       `(call |globalEval| (call |xstring| ,string))))
 
 (define-builtin %throw (string)
   `(bool (=== (typeof ,x) "function")))
 
 (define-builtin %write-string (x)
   `(bool (=== (typeof ,x) "function")))
 
 (define-builtin %write-string (x)
-  `(call (get |lisp| "write") ,x))
+  `(method-call |lisp| "write" ,x))
 
 (define-builtin /debug (x)
 
 (define-builtin /debug (x)
-  `(call (get |console| "log") (call |xstring| ,x)))
+  `(method-call |console| "log" (call |xstring| ,x)))
 
 
 ;;; Storage vectors. They are used to implement arrays and (in the
 
 
 ;;; Storage vectors. They are used to implement arrays and (in the
 (define-builtin concatenate-storage-vector (sv1 sv2)
   `(selfcall
      (var (sv1 ,sv1))
 (define-builtin concatenate-storage-vector (sv1 sv2)
   `(selfcall
      (var (sv1 ,sv1))
-     (var (r (call (get sv1 "concat") ,sv2)))
+     (var (r (method-call sv1 "concat" ,sv2)))
      (= (get r "type") (get sv1 "type"))
      (= (get r "stringp") (get sv1 "stringp"))
      (return r)))
 
 (define-builtin get-internal-real-time ()
      (= (get r "type") (get sv1 "type"))
      (= (get r "stringp") (get sv1 "stringp"))
      (return r)))
 
 (define-builtin get-internal-real-time ()
-  `(call (get (new (call |Date|)) "getTime")))
+  `(method-call (new (call |Date|)) "getTime"))
 
 (define-builtin values-array (array)
   (if *multiple-value-p*
 
 (define-builtin values-array (array)
   (if *multiple-value-p*
-      `(call (get |values| "apply") this ,array)
-      `(call (get |pv| "apply") this ,array)))
+      `(method-call |values| "apply" this ,array)
+      `(method-call |pv| "apply" this ,array)))
 
 (define-raw-builtin values (&rest args)
   (if *multiple-value-p*
 
 (define-raw-builtin values (&rest args)
   (if *multiple-value-p*
-      `(call |values| ,@(mapcar #'ls-compile args))
-      `(call |pv| ,@(mapcar #'ls-compile args))))
+      `(call |values| ,@(mapcar #'convert args))
+      `(call |pv| ,@(mapcar #'convert args))))
 
 ;;; Javascript FFI
 
 
 ;;; Javascript FFI
 
 (define-raw-builtin oget* (object key &rest keys)
   `(selfcall
     (progn
 (define-raw-builtin oget* (object key &rest keys)
   `(selfcall
     (progn
-      (var (tmp (property ,(ls-compile object) (call |xstring| ,(ls-compile key)))))
+      (var (tmp (property ,(convert object) (call |xstring| ,(convert key)))))
       ,@(mapcar (lambda (key)
                   `(progn
       ,@(mapcar (lambda (key)
                   `(progn
-                     (if (=== tmp undefined) (return ,(ls-compile nil)))
-                     (= tmp (property tmp (call |xstring| ,(ls-compile key))))))
+                     (if (=== tmp undefined) (return ,(convert nil)))
+                     (= tmp (property tmp (call |xstring| ,(convert key))))))
                 keys))
                 keys))
-    (return (if (=== tmp undefined) ,(ls-compile nil) tmp))))
+    (return (if (=== tmp undefined) ,(convert nil) tmp))))
 
 (define-raw-builtin oset* (value object key &rest keys)
   (let ((keys (cons key keys)))
     `(selfcall
       (progn
 
 (define-raw-builtin oset* (value object key &rest keys)
   (let ((keys (cons key keys)))
     `(selfcall
       (progn
-        (var (obj ,(ls-compile object)))
+        (var (obj ,(convert object)))
         ,@(mapcar (lambda (key)
                     `(progn
         ,@(mapcar (lambda (key)
                     `(progn
-                       (= obj (property obj (call |xstring| ,(ls-compile key))))
+                       (= obj (property obj (call |xstring| ,(convert key))))
                        (if (=== object undefined)
                            (throw "Impossible to set object property."))))
                   (butlast keys))
         (var (tmp
                        (if (=== object undefined)
                            (throw "Impossible to set object property."))))
                   (butlast keys))
         (var (tmp
-              (= (property obj (call |xstring| ,(ls-compile (car (last keys)))))
-                 ,(ls-compile value))))
+              (= (property obj (call |xstring| ,(convert (car (last keys)))))
+                 ,(convert value))))
         (return (if (=== tmp undefined)
         (return (if (=== tmp undefined)
-                    ,(ls-compile nil)
+                    ,(convert nil)
                     tmp))))))
 
 (define-raw-builtin oget (object key &rest keys)
                     tmp))))))
 
 (define-raw-builtin oget (object key &rest keys)
-  `(call |js_to_lisp| ,(ls-compile `(oget* ,object ,key ,@keys))))
+  `(call |js_to_lisp| ,(convert `(oget* ,object ,key ,@keys))))
 
 (define-raw-builtin oset (value object key &rest keys)
 
 (define-raw-builtin oset (value object key &rest keys)
-  (ls-compile `(oset* (lisp-to-js ,value) ,object ,key ,@keys)))
+  (convert `(oset* (lisp-to-js ,value) ,object ,key ,@keys)))
 
 (define-builtin objectp (x)
   `(bool (=== (typeof ,x) "object")))
 
 (define-builtin objectp (x)
   `(bool (=== (typeof ,x) "object")))
          (o ,object))
     (for-in (key o)
             (call g ,(if *multiple-value-p* '|values| '|pv|) 1 (get o "key")))
          (o ,object))
     (for-in (key o)
             (call g ,(if *multiple-value-p* '|values| '|pv|) 1 (get o "key")))
-    (return ,(ls-compile nil))))
+    (return ,(convert nil))))
 
 (define-compilation %js-vref (var)
   `(call |js_to_lisp| ,(make-symbol var)))
 
 (define-compilation %js-vset (var val)
 
 (define-compilation %js-vref (var)
   `(call |js_to_lisp| ,(make-symbol var)))
 
 (define-compilation %js-vset (var val)
-  `(= ,(make-symbol var) (call |lisp_to_js| ,(ls-compile val))))
+  `(= ,(make-symbol var) (call |lisp_to_js| ,(convert val))))
 
 (define-setf-expander %js-vref (var)
   (let ((new-value (gensym)))
 
 (define-setf-expander %js-vref (var)
   (let ((new-value (gensym)))
 (defun compile-funcall (function args)
   (let* ((arglist (list* (if *multiple-value-p* '|values| '|pv|)
                          (length args)
 (defun compile-funcall (function args)
   (let* ((arglist (list* (if *multiple-value-p* '|values| '|pv|)
                          (length args)
-                         (mapcar #'ls-compile args))))
+                         (mapcar #'convert args))))
     (unless (or (symbolp function)
                 (and (consp function)
                      (member (car function) '(lambda oget))))
       (error "Bad function designator `~S'" function))
     (cond
       ((translate-function function)
     (unless (or (symbolp function)
                 (and (consp function)
                      (member (car function) '(lambda oget))))
       (error "Bad function designator `~S'" function))
     (cond
       ((translate-function function)
-       `(call ,(make-symbol (translate-function function)) ,@arglist))
+       `(call ,(translate-function function) ,@arglist))
       ((and (symbolp function)
             #+jscl (eq (symbol-package function) (find-package "COMMON-LISP"))
             #-jscl t)
       ((and (symbolp function)
             #+jscl (eq (symbol-package function) (find-package "COMMON-LISP"))
             #-jscl t)
-       `(call (get ,(ls-compile `',function) "fvalue") ,@arglist))
+       `(method-call ,(convert `',function) "fvalue" ,@arglist))
       #+jscl((symbolp function)
       #+jscl((symbolp function)
-             `(call ,(ls-compile `#',function) ,@arglist))
+             `(call ,(convert `#',function) ,@arglist))
       ((and (consp function) (eq (car function) 'lambda))
       ((and (consp function) (eq (car function) 'lambda))
-       `(call ,(ls-compile `#',function) ,@arglist))
+       `(call ,(convert `#',function) ,@arglist))
       ((and (consp function) (eq (car function) 'oget))
       ((and (consp function) (eq (car function) 'oget))
-       `(call ,(ls-compile function) ,@arglist))
+       `(call ,(convert function) ,@arglist))
       (t
        (error "Bad function descriptor")))))
 
       (t
        (error "Bad function descriptor")))))
 
-(defun ls-compile-block (sexps &optional return-last-p decls-allowed-p)
+(defun convert-block (sexps &optional return-last-p decls-allowed-p)
   (multiple-value-bind (sexps decls)
       (parse-body sexps :declarations decls-allowed-p)
     (declare (ignore decls))
     (if return-last-p
         `(progn
   (multiple-value-bind (sexps decls)
       (parse-body sexps :declarations decls-allowed-p)
     (declare (ignore decls))
     (if return-last-p
         `(progn
-           ,@(mapcar #'ls-compile (butlast sexps))
-           (return ,(ls-compile (car (last sexps)) *multiple-value-p*)))
-        `(progn ,@(mapcar #'ls-compile sexps)))))
+           ,@(mapcar #'convert (butlast sexps))
+           (return ,(convert (car (last sexps)) *multiple-value-p*)))
+        `(progn ,@(mapcar #'convert sexps)))))
 
 
-(defun ls-compile* (sexp &optional multiple-value-p)
+(defun convert (sexp &optional multiple-value-p)
   (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp)
     (when expandedp
   (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp)
     (when expandedp
-      (return-from ls-compile* (ls-compile 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
     ;; The expression has been macroexpanded. Now compile it!
     (let ((*multiple-value-p* multiple-value-p))
       (cond
          (let ((b (lookup-in-lexenv sexp *environment* 'variable)))
            (cond
              ((and b (not (member 'special (binding-declarations b))))
          (let ((b (lookup-in-lexenv sexp *environment* 'variable)))
            (cond
              ((and b (not (member 'special (binding-declarations b))))
-              (make-symbol (binding-value b)))
+              (binding-value b))
              ((or (keywordp sexp)
                   (and b (member 'constant (binding-declarations b))))
              ((or (keywordp sexp)
                   (and b (member 'constant (binding-declarations b))))
-              `(get ,(ls-compile `',sexp) "value"))
+              `(get ,(convert `',sexp) "value"))
              (t
              (t
-              (ls-compile `(symbol-value ',sexp))))))
+              (convert `(symbol-value ',sexp))))))
         ((or (integerp sexp) (floatp sexp) (characterp sexp) (stringp sexp) (arrayp sexp))
          (literal sexp))
         ((listp sexp)
         ((or (integerp sexp) (floatp sexp) (characterp sexp) (stringp sexp) (arrayp sexp))
          (literal sexp))
         ((listp sexp)
         (t
          (error "How should I compile `~S'?" sexp))))))
 
         (t
          (error "How should I compile `~S'?" sexp))))))
 
-(defun ls-compile (sexp &optional multiple-value-p)
-  (ls-compile* sexp multiple-value-p))
-
 
 (defvar *compile-print-toplevels* nil)
 
 
 (defvar *compile-print-toplevels* nil)
 
        (when *compile-print-toplevels*
          (let ((form-string (prin1-to-string sexp)))
            (format t "Compiling ~a..." (truncate-string form-string))))
        (when *compile-print-toplevels*
          (let ((form-string (prin1-to-string sexp)))
            (format t "Compiling ~a..." (truncate-string form-string))))
-       (let ((code (ls-compile sexp multiple-value-p)))
+       (let ((code (convert sexp multiple-value-p)))
          `(progn
             ,@(get-toplevel-compilations)
          `(progn
             ,@(get-toplevel-compilations)
-            (code ,code ";
-")))))))
+            ,code))))))
 
 
-(defun ls-compile-toplevel (sexp &optional multiple-value-p)
+(defun compile-toplevel (sexp &optional multiple-value-p)
   (with-output-to-string (*standard-output*)
     (js (convert-toplevel sexp multiple-value-p))))
   (with-output-to-string (*standard-output*)
     (js (convert-toplevel sexp multiple-value-p))))