(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.
dumped
(let ((jsvar (genlit)))
(push (cons sexp jsvar) *literal-table*)
- (toplevel-compilation `(code "var " ,jsvar " = " ,dumped))
+ (toplevel-compilation `(var (,(make-symbol jsvar) ,dumped)))
(when (keywordp sexp)
- (toplevel-compilation `(code ,jsvar ".value = " ,jsvar)))
+ (toplevel-compilation `(= ,(get (make-symbol jsvar) "value") ,(make-symbol jsvar))))
jsvar)))))))
`(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*)