Remove CODE use in convert-toplevel
[jscl.git] / src / compiler.lisp
index 381e99f..79bf250 100644 (file)
 (define-js-macro selfcall (&body body)
   `(call (function () ,@body)))
 
+(define-js-macro bool (expr)
+  `(if ,expr ,(ls-compile t) ,(ls-compile nil)))
+
+
 ;;; Translate the Lisp code to Javascript. It will compile the special
 ;;; forms. Some primitive functions are compiled as special forms
 ;;; too. The respective real functions are defined in the target (see
                     (js-expr arg)))))
              args))
 
-;;; Wrap X with a Javascript code to convert the result from
-;;; Javascript generalized booleans to T or NIL.
-(defun js!bool (x)
-  `(if ,x ,(ls-compile t) ,(ls-compile nil)))
-
 ;;; 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.
   `(define-raw-builtin ,op (x &rest args)
      (let ((args (cons x args)))
        (variable-arity args
-        (js!bool (comparison-conjuntion args ',sym))))))
+        `(bool ,(comparison-conjuntion args ',sym))))))
 
 (define-builtin-comparison > >)
 (define-builtin-comparison < <)
 (define-builtin-comparison /= !=)
 
 (define-builtin numberp (x)
-  (js!bool `(== (typeof ,x) "number")))
+  `(bool (== (typeof ,x) "number")))
 
 (define-builtin floor (x)
   `(call (get |Math| |floor|) ,x))
   `(object "car" ,x "cdr" ,y))
 
 (define-builtin consp (x)
-  (js!bool
-   `(selfcall
-     (var (tmp ,x))
-     (return (and (== (typeof tmp) "object")
-                  (in "car" tmp))))))
+  `(selfcall
+    (var (tmp ,x))
+    (return (bool (and (== (typeof tmp) "object")
+                       (in "car" tmp))))))
 
 (define-builtin car (x)
   `(selfcall
   `(= (get ,x "cdr") ,new))
 
 (define-builtin symbolp (x)
-  (js!bool `(instanceof ,x |Symbol|)))
+  `(bool (instanceof ,x |Symbol|)))
 
 (define-builtin make-symbol (name)
   `(new (call |Symbol| ,name)))
   `(= (get ,symbol "fvalue") ,value))
 
 (define-builtin boundp (x)
-  (js!bool `(!== (get ,x "value") undefined)))
+  `(bool (!== (get ,x "value") undefined)))
 
 (define-builtin fboundp (x)
-  (js!bool `(!== (get ,x "fvalue") undefined)))
+  `(bool (!== (get ,x "fvalue") undefined)))
 
 (define-builtin symbol-value (x)
   `(selfcall
   `(call |make_lisp_string| (call (get ,x "toString"))))
 
 (define-builtin eq (x y)
-  (js!bool `(=== ,x ,y)))
+  `(bool (=== ,x ,y)))
 
 (define-builtin char-code (x)
   `(call |char_to_codepoint| ,x))
   `(call |char_from_codepoint| ,x))
 
 (define-builtin characterp (x)
-  (js!bool
-   `(selfcall
-     (var (x ,x))
-     (return (and (== (typeof x) "string")
+  `(selfcall
+    (var (x ,x))
+    (return (bool
+             (and (== (typeof x) "string")
                   (or (== (get x "length") 1)
                       (== (get x "length") 2)))))))
 
   `(call |safe_char_downcase| ,x))
 
 (define-builtin stringp (x)
-  (js!bool
-   `(selfcall
-     (var (x ,x))
-     (return (and (and (===(typeof x) "object")
+  `(selfcall
+    (var (x ,x))
+    (return (bool
+             (and (and (===(typeof x) "object")
                        (in "length" x))
                   (== (get x "stringp") 1))))))
 
   `(selfcall (throw ,string)))
 
 (define-builtin functionp (x)
-  (js!bool `(=== (typeof ,x) "function")))
+  `(bool (=== (typeof ,x) "function")))
 
 (define-builtin %write-string (x)
   `(call (get |lisp| "write") ,x))
 ;;; future) structures.
 
 (define-builtin storage-vector-p (x)
-  (js!bool
-   `(selfcall
-     (var (x ,x))
-     (return (and (=== (typeof x) "object") (in "length" x))))))
+  `(selfcall
+    (var (x ,x))
+    (return (bool (and (=== (typeof x) "object") (in "length" x))))))
 
 (define-builtin make-storage-vector (n)
   `(selfcall
   (ls-compile `(oset* (lisp-to-js ,value) ,object ,key ,@keys)))
 
 (define-builtin objectp (x)
-  (js!bool `(=== (typeof ,x) "object")))
+  `(bool (=== (typeof ,x) "object")))
 
 (define-builtin lisp-to-js (x) `(call |lisp_to_js| ,x))
 (define-builtin js-to-lisp (x) `(call |js_to_lisp| ,x))
 
 
 (define-builtin in (key object)
-  (js!bool `(in (call |xstring| ,key) ,object)))
+  `(bool (in (call |xstring| ,key) ,object)))
 
 (define-builtin map-for-in (function object)
   `(selfcall
          (let ((form-string (prin1-to-string sexp)))
            (format t "Compiling ~a..." (truncate-string form-string))))
        (let ((code (ls-compile sexp multiple-value-p)))
-         `(code
-           ,@(interleave (get-toplevel-compilations) ";
-" t)
-           ,(when code
-                  `(code ,code ";"))))))))
+         `(progn
+            ,@(interleave (get-toplevel-compilations) '(code ";
+") t)
+            (code ,code ";")))))))
 
 (defun ls-compile-toplevel (sexp &optional multiple-value-p)
   (with-output-to-string (*standard-output*)