(if (or name docstring)
(js!selfcall*
`(var (func ,code))
- (when name `(= (get func |fname|) ,name))
- (when docstring `(= (get func |docstring|) ,docstring))
+ (when name `(= (get func "fname") ,name))
+ (when docstring `(= (get func "docstring") ,docstring))
`(return func))
code))
((and (listp x) (eq (car x) 'lambda))
(compile-lambda (cadr x) (cddr x)))
((and (listp x) (eq (car x) 'named-lambda))
- ;; TODO: destructuring-bind now! Do error checking manually is
- ;; very annoying.
- (let ((name (cadr x))
- (ll (caddr x))
- (body (cdddr x)))
+ (destructuring-bind (name ll &rest body) (cdr x)
(compile-lambda ll body
:name (symbol-name name)
:block name)))
(extend-lexenv (mapcar #'make-function-binding fnames)
*environment*
'function)))
- `(code "(function("
- ,@(interleave (mapcar #'translate-function fnames) ",")
- "){"
- ,(ls-compile-block body t)
- "})(" ,@(interleave cfuncs ",") ")")))
+ `(call (function ,(mapcar #'make-symbol (mapcar #'translate-function fnames))
+ ,(ls-compile-block body t))
+ ,@cfuncs)))
(define-compilation labels (definitions &rest body)
(let* ((fnames (mapcar #'car definitions))
(extend-lexenv (mapcar #'make-function-binding fnames)
*environment*
'function)))
- (js!selfcall
- `(code ,@(mapcar (lambda (func)
- `(code "var " ,(translate-function (car func))
- " = " ,(compile-lambda (cadr func)
- `((block ,(car func) ,@(cddr func))))
- ";" ))
- definitions))
+ (js!selfcall*
+ `(progn
+ ,@(mapcar (lambda (func)
+ `(var (,(make-symbol (translate-function (car func)))
+ ,(compile-lambda (cadr func)
+ `((block ,(car func) ,@(cddr func)))))))
+ definitions))
(ls-compile-block body t))))
(cvalues (mapcar #'ls-compile (mapcar #'second bindings)))
(*environment* (extend-local-env (remove-if #'special-variable-p variables)))
(dynamic-bindings))
- `(code "(function("
- ,@(interleave
- (mapcar (lambda (x)
- (if (special-variable-p x)
- (let ((v (gvarname x)))
- (push (cons x v) dynamic-bindings)
- v)
- (translate-variable x)))
- variables)
- ",")
- "){"
- ,(let ((body (ls-compile-block body t t)))
- `(code ,(let-binding-wrapper dynamic-bindings body)))
- "})(" ,@(interleave cvalues ",") ")")))
+ `(call (function ,(mapcar (lambda (x)
+ (if (special-variable-p x)
+ (let ((v (gvarname x)))
+ (push (cons x v) dynamic-bindings)
+ (make-symbol v))
+ (make-symbol (translate-variable x))))
+ variables)
+ ,(let ((body (ls-compile-block body t t)))
+ `(code ,(let-binding-wrapper dynamic-bindings body))))
+ ,@cvalues)))
;;; Return the code to initialize BINDING, and push it extending the
`(try
,(ls-compile-block body t))
`(catch (|cf|)
- (if (and (== (get |cf| |type|) "catch")
- (== (get |cf| |id|) |id|))
+ (if (and (== (get |cf| "type") "catch")
+ (== (get |cf| "id") |id|))
,(if *multiple-value-p*
- `(return (call (get |values| |apply|)
+ `(return (call (get |values| "apply")
this
- (call |forcemv| (get |cf| |values|))))
- `(return (call (get |pv| |apply|)
+ (call |forcemv| (get |cf| "values"))))
+ `(return (call (get |pv| "apply")
this
- (call |forcemv| (get |cf| |values|)))))
+ (call |forcemv| (get |cf| "values")))))
(throw |cf|)))))
(define-compilation throw (id value)
(define-builtin storage-vector-ref (vector n)
(js!selfcall*
- `(var (x (get ,vector ,n)))
+ `(var (x (property ,vector ,n)))
`(if (=== x undefined) (throw "Out of range."))
`(return x)))
(define-builtin values-array (array)
(if *multiple-value-p*
- `(code "values.apply(this, " ,array ")")
- `(code "pv.apply(this, " ,array ")")))
+ `(call (get |values| "apply") this ,array)
+ `(call (get |pv| "apply") this ,array)))
(define-raw-builtin values (&rest args)
(if *multiple-value-p*
- `(code "values(" ,@(interleave (mapcar #'ls-compile args) ",") ")")
- `(code "pv(" ,@(interleave (mapcar #'ls-compile args) ", ") ")")))
-
+ `(call |values| ,@(mapcar #'ls-compile args))
+ `(call |pv| ,@(mapcar #'ls-compile args))))
;;; Javascript FFI
(define-raw-builtin oget* (object key &rest keys)
(js!selfcall*
`(progn
- (var (tmp (get ,(ls-compile object) (call |xstring| ,(ls-compile key)))))
+ (var (tmp (property ,(ls-compile object) (call |xstring| ,(ls-compile key)))))
,@(mapcar (lambda (key)
`(progn
(if (=== tmp undefined) (return ,(ls-compile nil)))
- (= tmp (get tmp (call |xstring| ,(ls-compile key))))))
+ (= tmp (property tmp (call |xstring| ,(ls-compile key))))))
keys))
`(return (if (=== tmp undefined) ,(ls-compile nil) tmp))))
(var (obj ,(ls-compile object)))
,@(mapcar (lambda (key)
`(progn
- (= obj (get obj (call |xstring| ,(ls-compile key))))
+ (= obj (property obj (call |xstring| ,(ls-compile key))))
(if (=== object undefined)
(throw "Impossible to set object property."))))
(butlast keys))
(var (tmp
- (= (get obj (call |xstring| ,(ls-compile (car (last keys)))))
+ (= (property obj (call |xstring| ,(ls-compile (car (last keys)))))
,(ls-compile value))))
(return (if (=== tmp undefined)
,(ls-compile nil)