Rename LS-COMPILE => CONVERT and LS-COMPILE-TOPLEVEL to COMPILE-TOPLEVEL

diff --git a/jscl.lisp b/jscl.lisp
index e613f7b..78c5982 100644 (file)
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -72,7 +72,7 @@
       (read-sequence seq in)
       seq)))
 
       (read-sequence seq in)
       seq)))
 

-(defun ls-compile-file (filename out &key print)
+(defun !compile-file (filename out &key print)

   (let ((*compiling-file* t)
         (*compile-print-toplevels* print))
     (let* ((source (read-whole-file filename))
   (let ((*compiling-file* t)
         (*compile-print-toplevels* print))
     (let* ((source (read-whole-file filename))

@@ -82,14 +82,14 @@
          with eof-mark = (gensym)
          for x = (ls-read in nil eof-mark)
          until (eq x eof-mark)
          with eof-mark = (gensym)
          for x = (ls-read in nil eof-mark)
          until (eq x eof-mark)

-         do (let ((compilation (ls-compile-toplevel x)))
+         do (let ((compilation (compile-toplevel x)))

               (when (plusp (length compilation))
                 (write-string compilation out)))))))
 
 (defun dump-global-environment (stream)
   (flet ((late-compile (form)
            (let ((*standard-output* stream))
               (when (plusp (length compilation))
                 (write-string compilation out)))))))
 
 (defun dump-global-environment (stream)
   (flet ((late-compile (form)
            (let ((*standard-output* stream))

-             (write-string (ls-compile-toplevel form)))))
+             (write-string (compile-toplevel form)))))

     ;; We assume that environments have a friendly list representation
     ;; for the compiler and it can be dumped.
     (dolist (b (lexenv-function *environment*))
     ;; We assume that environments have a friendly list representation
     ;; for the compiler and it can be dumped.
     (dolist (b (lexenv-function *environment*))

@@ -120,14 +120,14 @@
       (write-string (read-whole-file (source-pathname "prelude.js")) out)
       (dolist (input *source*)
         (when (member (cadr input) '(:target :both))
       (write-string (read-whole-file (source-pathname "prelude.js")) out)
       (dolist (input *source*)
         (when (member (cadr input) '(:target :both))

-          (ls-compile-file (source-pathname (car input) :type "lisp") out)))
+          (!compile-file (source-pathname (car input) :type "lisp") out)))

       (dump-global-environment out))
     ;; Tests
     (with-open-file (out "tests.js" :direction :output :if-exists :supersede)
       (dolist (input (append (directory "tests.lisp")
                              (directory "tests/*.lisp")
                              (directory "tests-report.lisp")))
       (dump-global-environment out))
     ;; Tests
     (with-open-file (out "tests.js" :direction :output :if-exists :supersede)
       (dolist (input (append (directory "tests.lisp")
                              (directory "tests/*.lisp")
                              (directory "tests-report.lisp")))

-        (ls-compile-file input out)))))
+        (!compile-file input out)))))

 
 
 ;;; Run the tests in the host Lisp implementation. It is a quick way
 
 
 ;;; Run the tests in the host Lisp implementation. It is a quick way

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 30e430d..2c8269c 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -24,7 +24,7 @@
   `(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)))

 
 ;;; 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

@@ -116,7 +116,7 @@
   (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)

@@ -171,9 +171,9 @@
          *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))
 

@@ -258,10 +258,10 @@
                     (let ((arg (nth idx optional-arguments)))
                       (collect `(case ,(+ idx n-required-arguments)))
                       (collect `(= ,(make-symbol (translate-variable (car arg)))
                     (let ((arg (nth idx optional-arguments)))
                       (collect `(case ,(+ idx n-required-arguments)))
                       (collect `(= ,(make-symbol (translate-variable (car arg)))

-                                   ,(ls-compile (cadr arg))))
+                                   ,(convert (cadr arg))))

                       (collect (when (third arg)
                                  `(= ,(make-symbol (translate-variable (third arg)))
                       (collect (when (third arg)
                                  `(= ,(make-symbol (translate-variable (third arg)))

-                                     ,(ls-compile nil))))))
+                                     ,(convert nil))))))

                   (collect 'default)
                   (collect '(break)))))))
 
                   (collect 'default)
                   (collect '(break)))))))
 

@@ -272,7 +272,7 @@
     (when rest-argument
       (let ((js!rest (make-symbol (translate-variable rest-argument))))
         `(progn
     (when rest-argument
       (let ((js!rest (make-symbol (translate-variable rest-argument))))
         `(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))

@@ -298,7 +298,7 @@
               (when svar
                 (collect
                     `(var (,(make-symbol (translate-variable svar))
               (when svar
                 (collect
                     `(var (,(make-symbol (translate-variable svar))

-                            ,(ls-compile nil))))))))
+                            ,(convert nil))))))))

        
        ;; Parse keywords
        ,(flet ((parse-keyword (keyarg)
        
        ;; Parse keywords
        ,(flet ((parse-keyword (keyarg)

@@ -310,16 +310,16 @@
                            (+= i 2))
                           ;; ....
                           (if (=== (property |arguments| (+ i 2))
                            (+= i 2))
                           ;; ....
                           (if (=== (property |arguments| (+ i 2))

-                                   ,(ls-compile keyword-name))
+                                   ,(convert keyword-name))

                               (progn
                                 (= ,(make-symbol (translate-variable var))
                                    (property |arguments| (+ i 3)))
                                 ,(when svar `(= ,(make-symbol (translate-variable svar))
                               (progn
                                 (= ,(make-symbol (translate-variable var))
                                    (property |arguments| (+ i 3)))
                                 ,(when svar `(= ,(make-symbol (translate-variable svar))

-                                                ,(ls-compile t)))
+                                                ,(convert t)))

                                 (break))))
                      (if (== i |nargs|)
                          (= ,(make-symbol (translate-variable var))
                                 (break))))
                      (if (== i |nargs|)
                          (= ,(make-symbol (translate-variable var))

-                            ,(ls-compile initform)))))))
+                            ,(convert initform)))))))

          (when keyword-arguments
            `(progn
               (var i)
          (when keyword-arguments
            `(progn
               (var i)

@@ -336,7 +336,7 @@
                                  (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|

@@ -407,8 +407,8 @@
 
                     ,(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)

@@ -420,17 +420,17 @@
             (not (member 'constant (binding-declarations b))))
        ;; TODO: Unnecesary make-symbol when codegen migration is
        ;; finished.
             (not (member 'constant (binding-declarations b))))
        ;; TODO: Unnecesary make-symbol when codegen migration is
        ;; finished.

-       `(= ,(make-symbol (binding-value b)) ,(ls-compile val)))
+       `(= ,(make-symbol (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)

@@ -482,7 +482,7 @@
   (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))

@@ -517,7 +517,7 @@
                           ;; `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)))
                               (dump-cons sexp)))
                          (array (dump-array sexp)))))
            (if (and recursive (not (symbolp sexp)))

@@ -535,12 +535,12 @@
 
 (define-compilation %while (pred &rest body)
   `(selfcall
 
 (define-compilation %while (pred &rest body)
   `(selfcall

-    (while (!== ,(ls-compile pred) ,(ls-compile nil))
+    (while (!== ,(convert pred) ,(convert nil))

       0                                 ; TODO: Force
                                         ; braces. Unnecesary when code
                                         ; is gone
       0                                 ; TODO: Force
                                         ; braces. Unnecesary when code
                                         ; is gone

-      ,(ls-compile-block body))
-    (return ,(ls-compile nil))))
+      ,(convert-block body))
+    (return ,(convert nil))))

 
 (define-compilation function (x)
   (cond
 
 (define-compilation function (x)
   (cond

@@ -555,7 +555,7 @@
      (let ((b (lookup-in-lexenv x *environment* 'function)))
        (if b
           (make-symbol (binding-value b))
      (let ((b (lookup-in-lexenv x *environment* 'function)))
        (if b
           (make-symbol (binding-value b))

-          (ls-compile `(symbol-function ',x)))))))
+          (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)))

@@ -579,7 +579,7 @@
                          *environment*
                          'function)))
     `(call (function ,(mapcar #'make-symbol (mapcar #'translate-function fnames))
                          *environment*
                          'function)))
     `(call (function ,(mapcar #'make-symbol (mapcar #'translate-function fnames))

-                ,(ls-compile-block body t))
+                ,(convert-block body t))

            ,@cfuncs)))
 
 (define-compilation labels (definitions &rest body)
            ,@cfuncs)))
 
 (define-compilation labels (definitions &rest body)

@@ -594,7 +594,7 @@
                           ,(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)

@@ -602,19 +602,19 @@
   (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*)))

@@ -626,7 +626,7 @@
                                           (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)

@@ -644,7 +644,7 @@
      (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)))))

@@ -652,13 +652,13 @@
      (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)
          (*environment* (extend-local-env (remove-if #'special-variable-p variables)))
          (dynamic-bindings))
     `(call (function ,(mapcar (lambda (x)

@@ -668,7 +668,7 @@
                                       (make-symbol v))
                                     (make-symbol (translate-variable x))))
                               variables)
                                       (make-symbol v))
                                     (make-symbol (translate-variable x))))
                               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)))
 

@@ -679,10 +679,10 @@
   (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 (,(make-symbol 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

@@ -696,13 +696,13 @@
     `(progn
        (try
         ,@(mapcar (lambda (b)
     `(progn
        (try
         ,@(mapcar (lambda (b)

-                    (let ((s (ls-compile `(quote ,(car b)))))
+                    (let ((s (convert `(quote ,(car b)))))

                       `(var (,(make-symbol (cdr b)) (get ,s "value")))))
                   store)
         ,body)
        (finally
         ,@(mapcar (lambda (b)
                       `(var (,(make-symbol (cdr b)) (get ,s "value")))))
                   store)
         ,body)
        (finally
         ,@(mapcar (lambda (b)

-                    (let ((s (ls-compile `(quote ,(car b)))))
+                    (let ((s (convert `(quote ,(car b)))))

                       `(= (get ,s "value") ,(make-symbol (cdr b)))))
                   store)))))
 
                       `(= (get ,s "value") ,(make-symbol (cdr b)))))
                   store)))))
 

@@ -712,7 +712,7 @@
     (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)))))
 
 

@@ -728,7 +728,7 @@
     (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

@@ -760,14 +760,14 @@
           (object
            "type" "block"
            "id" ,(make-symbol (binding-value b))
           (object
            "type" "block"
            "id" ,(make-symbol (binding-value b))

-           "values" ,(ls-compile value multiple-value-p)
+           "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|))
     (catch (|cf|)
       (if (and (== (get |cf| "type") "catch")
                (== (get |cf| "id") |id|))

@@ -785,8 +785,8 @@
     (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)

@@ -806,7 +806,7 @@
   ;; 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))

@@ -831,7 +831,7 @@
                                (if (go-tag-p form)
                                    (let ((b (lookup-in-lexenv form *environment* 'gotag)))
                                      (collect `(case ,(second (binding-value b)))))
                                (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)
                           default
                           (break tbloop)))
                  (catch (jump)

@@ -839,7 +839,7 @@
                             (== (get jump "id") ,(make-symbol tbidx)))
                        (= ,(make-symbol branch) (get jump "label"))
                        (throw jump)))))
                             (== (get jump "id") ,(make-symbol tbidx)))
                        (= ,(make-symbol branch) (get jump "label"))
                        (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))

@@ -858,16 +858,16 @@
 
 (define-compilation unwind-protect (form &rest clean-up)
   `(selfcall
 
 (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

@@ -876,7 +876,7 @@
        (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))
                             (= args (call (get args "concat") vs))
               (collect `(if (and (=== (typeof vs) "object")
                                  (in "multiple-value" vs))
                             (= args (call (get args "concat") vs))

@@ -886,9 +886,9 @@
 
 (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*)))
+    (var (args ,(convert first-form *multiple-value-p*)))

     ;; TODO: Interleave is temporal
     ;; TODO: Interleave is temporal

-    (progn ,@(mapcar #'ls-compile forms))
+    (progn ,@(mapcar #'convert forms))

     (return args)))
 
 (define-transformation backquote (form)
     (return args)))
 
 (define-transformation backquote (form)

@@ -908,7 +908,7 @@
 
 (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

@@ -927,7 +927,7 @@
           (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!"))

@@ -1016,15 +1016,15 @@
 (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)

@@ -1071,7 +1071,7 @@
     (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)
   `(call |make_lisp_string| (call (get ,x "toString"))))
 
 (define-builtin lambda-code (x)
   `(call |make_lisp_string| (call (get ,x "toString"))))

@@ -1109,27 +1109,27 @@
 
 (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))
+                               (mapcar #'convert args)))))
+           (var (tail ,(convert last)))
+           (while (!= tail ,(convert nil))

              (call (get args "push") (get tail "car"))
              (post++ (property args 1))
              (= tail (get tail "cdr")))
              (call (get args "push") (get tail "car"))
              (post++ (property args 1))
              (= tail (get tail "cdr")))

@@ -1212,8 +1212,8 @@
 
 (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
 

@@ -1223,37 +1223,37 @@
 (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")))

@@ -1272,13 +1272,13 @@
          (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)))

@@ -1338,7 +1338,7 @@
 (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))))
     (unless (or (symbolp function)
                 (and (consp function)
                      (member (car function) '(lambda oget))))

@@ -1349,30 +1349,30 @@
       ((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))
+       `(call (get ,(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

@@ -1383,9 +1383,9 @@
               (make-symbol (binding-value b)))
              ((or (keywordp sexp)
                   (and b (member 'constant (binding-declarations b))))
               (make-symbol (binding-value 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)

@@ -1406,8 +1406,8 @@
         (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))
+(defun convert (sexp &optional multiple-value-p)
+  (convert* sexp multiple-value-p))

 
 
 (defvar *compile-print-toplevels* nil)
 
 
 (defvar *compile-print-toplevels* nil)

@@ -1431,11 +1431,11 @@
        (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)
             ,code))))))
 
          `(progn
             ,@(get-toplevel-compilations)
             ,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))))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 99d3b39..7dddf6e 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -19,7 +19,7 @@
 (/debug "loading toplevel.lisp!")
 
 (defun eval (x)
 (/debug "loading toplevel.lisp!")
 
 (defun eval (x)

-  (js-eval (ls-compile-toplevel x t)))
+  (js-eval (compile-toplevel x t)))

 
 (defvar * nil)
 (defvar ** nil)
 
 (defvar * nil)
 (defvar ** nil)

@@ -258,8 +258,8 @@
   (setf #j:read #'ls-read-from-string)
   (setf #j:print #'prin1-to-string)
   (setf #j:eval #'eval)
   (setf #j:read #'ls-read-from-string)
   (setf #j:print #'prin1-to-string)
   (setf #j:eval #'eval)

-  (setf #j:compile (lambda (s) (ls-compile-toplevel s t)))
+  (setf #j:compile (lambda (s) (compile-toplevel s t)))

   (setf #j:evalString (lambda (str) (eval (ls-read-from-string str))))
   (setf #j:evalInput (lambda (str) (eval-interactive (ls-read-from-string str))))
   (setf #j:evalString (lambda (str) (eval (ls-read-from-string str))))
   (setf #j:evalInput (lambda (str) (eval-interactive (ls-read-from-string str))))

-  (setf #j:compileString (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t))))
+  (setf #j:compileString (lambda (str) (compile-toplevel (ls-read-from-string str) t))))