giles
679d6bd590
Previously a JS function body with no return fell through the call/cc
begin as nil, making `(function(){}())` return null and typeof → object.
Spec: falls-off-end gives undefined.
Wrap the call/cc in (let ((__r__ ...)) (if (= __r__ nil) :js-undefined __r__)).
Downside: explicit `return null` also returns nil, but so does (pick
your last expression evaluating to null). For 99% of cases it's
fall-off-end and the fix is correct. Code that genuinely needs
distinguishable null would need separate nil/undef handling in the
evaluator.
Unit 521/522, slice 148/148 unchanged.
Number 73/100 → 74/100 (+1), String 33/100 → 34/100 (+1).
Fixes S15.5.1.1_A1_T1 family (String(function(){}()) should be "undefined").
1409 lines
43 KiB
Plaintext
1409 lines
43 KiB
Plaintext
;; lib/js/transpile.sx — JS AST → SX AST
|
|
;;
|
|
;; Produces SX trees the existing CEK/VM can evaluate directly.
|
|
;; Reuses lib/js/runtime.sx shims for JS-specific semantics
|
|
;; (coercions, prototype lookup, abstract equality, etc.).
|
|
;;
|
|
;; Input AST node shapes (from lib/js/parser.sx):
|
|
;; (js-num n) (js-str s) (js-bool b)
|
|
;; (js-null) (js-undef)
|
|
;; (js-ident "name")
|
|
;; (js-unop op expr)
|
|
;; (js-binop op l r)
|
|
;; (js-member obj "key") (js-index obj expr)
|
|
;; (js-call fn (args...))
|
|
;; (js-array (elts...)) (js-object ({:key :value}...))
|
|
;; (js-cond c t f)
|
|
;; (js-arrow (params...) body)
|
|
;; (js-assign op target rhs)
|
|
;;
|
|
;; Output is plain SX the evaluator can run, built with `list`/`cons`/
|
|
;; `make-symbol`. The entry point `js-eval-ast` calls `eval-expr` on
|
|
;; the transpiled tree.
|
|
|
|
;; ── tiny helpers ──────────────────────────────────────────────────
|
|
|
|
(define js-has-dollar? (fn (name) (js-has-dollar-loop? name 0 (len name))))
|
|
(define
|
|
js-has-dollar-loop?
|
|
(fn
|
|
(s i n)
|
|
(cond
|
|
((>= i n) false)
|
|
((= (char-at s i) "$") true)
|
|
(else (js-has-dollar-loop? s (+ i 1) n)))))
|
|
|
|
(define
|
|
js-mangle-ident
|
|
(fn
|
|
(name)
|
|
(if
|
|
(js-has-dollar? name)
|
|
(js-mangle-ident-loop name 0 (len name) "")
|
|
name)))
|
|
|
|
;; ── main dispatcher ───────────────────────────────────────────────
|
|
|
|
(define
|
|
js-mangle-ident-loop
|
|
(fn
|
|
(s i n acc)
|
|
(cond
|
|
((>= i n) acc)
|
|
((= (char-at s i) "$")
|
|
(js-mangle-ident-loop s (+ i 1) n (str acc "_js_dollar_")))
|
|
(else (js-mangle-ident-loop s (+ i 1) n (str acc (char-at s i)))))))
|
|
|
|
;; ── Identifier lookup ─────────────────────────────────────────────
|
|
|
|
;; `undefined` in JS is really a global binding. If the parser emits
|
|
;; (js-undef) we handle that above. A bare `undefined` ident also maps
|
|
;; to the same sentinel.
|
|
(define js-sym (fn (name) (make-symbol (js-mangle-ident name))))
|
|
|
|
;; ── Unary ops ─────────────────────────────────────────────────────
|
|
|
|
(define
|
|
js-tag?
|
|
(fn
|
|
(ast tag)
|
|
(and
|
|
(= (type-of ast) "list")
|
|
(not (empty? ast))
|
|
(= (type-of (first ast)) "symbol")
|
|
(= (symbol-name (first ast)) tag))))
|
|
|
|
;; ── Binary ops ────────────────────────────────────────────────────
|
|
|
|
(define js-ast-tag (fn (ast) (symbol-name (first ast))))
|
|
|
|
;; ── Member / index ────────────────────────────────────────────────
|
|
|
|
(define
|
|
js-transpile
|
|
(fn
|
|
(ast)
|
|
(cond
|
|
((= (type-of ast) "number") ast)
|
|
((= (type-of ast) "string") ast)
|
|
((= (type-of ast) "boolean") ast)
|
|
((= ast nil) ast)
|
|
((= (type-of ast) "list")
|
|
(cond
|
|
((empty? ast) (list))
|
|
((js-tag? ast "js-num") (nth ast 1))
|
|
((js-tag? ast "js-str") (nth ast 1))
|
|
((js-tag? ast "js-bool") (nth ast 1))
|
|
((js-tag? ast "js-regex")
|
|
(list (js-sym "js-regex-new") (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-null") nil)
|
|
((js-tag? ast "js-undef") (list (js-sym "quote") :js-undefined))
|
|
((js-tag? ast "js-ident") (js-transpile-ident (nth ast 1)))
|
|
((js-tag? ast "js-unop")
|
|
(js-transpile-unop (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-binop")
|
|
(js-transpile-binop (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-member")
|
|
(js-transpile-member (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-index")
|
|
(js-transpile-index (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-call")
|
|
(js-transpile-call (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-array") (js-transpile-array (nth ast 1)))
|
|
((js-tag? ast "js-object") (js-transpile-object (nth ast 1)))
|
|
((js-tag? ast "js-cond")
|
|
(js-transpile-cond (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-arrow")
|
|
(js-transpile-arrow (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-program") (js-transpile-stmts (nth ast 1)))
|
|
((js-tag? ast "js-block") (js-transpile-stmts (nth ast 1)))
|
|
((js-tag? ast "js-exprstmt") (js-transpile (nth ast 1)))
|
|
((js-tag? ast "js-empty") nil)
|
|
((js-tag? ast "js-var")
|
|
(js-transpile-var (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-if")
|
|
(js-transpile-if-stmt (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-while")
|
|
(js-transpile-while (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-do-while")
|
|
(js-transpile-do-while (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-for")
|
|
(js-transpile-for
|
|
(nth ast 1)
|
|
(nth ast 2)
|
|
(nth ast 3)
|
|
(nth ast 4)))
|
|
((js-tag? ast "js-for-of-in")
|
|
(js-transpile-for-of-in
|
|
(nth ast 1)
|
|
(nth ast 2)
|
|
(nth ast 3)
|
|
(nth ast 4)))
|
|
((js-tag? ast "js-return") (js-transpile-return (nth ast 1)))
|
|
((js-tag? ast "js-break") (js-transpile-break))
|
|
((js-tag? ast "js-continue") (js-transpile-continue))
|
|
((js-tag? ast "js-funcdecl")
|
|
(js-transpile-funcdecl (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-funcexpr")
|
|
(js-transpile-funcexpr (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-assign")
|
|
(js-transpile-assign (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-postfix")
|
|
(js-transpile-postfix (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-prefix")
|
|
(js-transpile-prefix (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-optchain-member")
|
|
(js-transpile-optchain-member (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-optchain-index")
|
|
(js-transpile-optchain-index (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-optchain-call")
|
|
(js-transpile-optchain-call (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-switch")
|
|
(js-transpile-switch (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-new")
|
|
(js-transpile-new (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-class")
|
|
(js-transpile-class (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-throw") (js-transpile-throw (nth ast 1)))
|
|
((js-tag? ast "js-try")
|
|
(js-transpile-try (nth ast 1) (nth ast 2) (nth ast 3)))
|
|
((js-tag? ast "js-await")
|
|
(list (js-sym "js-await-value") (js-transpile (nth ast 1))))
|
|
((js-tag? ast "js-funcdecl-async")
|
|
(js-transpile-funcdecl-async
|
|
(nth ast 1)
|
|
(nth ast 2)
|
|
(nth ast 3)))
|
|
((js-tag? ast "js-funcexpr-async")
|
|
(js-transpile-funcexpr-async
|
|
(nth ast 1)
|
|
(nth ast 2)
|
|
(nth ast 3)))
|
|
((js-tag? ast "js-arrow-async")
|
|
(js-transpile-arrow-async (nth ast 1) (nth ast 2)))
|
|
((js-tag? ast "js-tpl") (js-transpile-tpl (nth ast 1)))
|
|
(else
|
|
(error (str "js-transpile: unknown AST tag: " (js-ast-tag ast))))))
|
|
(else
|
|
(error (str "js-transpile: unexpected value type: " (type-of ast)))))))
|
|
|
|
(define
|
|
js-transpile-ident
|
|
(fn
|
|
(name)
|
|
(cond
|
|
((= name "undefined") (list (js-sym "quote") :js-undefined))
|
|
((= name "NaN") (list (js-sym "js-nan-value")))
|
|
((= name "Infinity") (list (js-sym "js-infinity-value")))
|
|
((= name "eval") (js-sym "js-global-eval"))
|
|
((= name "globalThis") (js-sym "js-global"))
|
|
((= name "Function") (js-sym "js-function-global"))
|
|
(else (js-sym name)))))
|
|
|
|
;; ── Call ──────────────────────────────────────────────────────────
|
|
|
|
;; JS `f(a, b, c)` → `(f a b c)` after transpile. Works for both
|
|
;; identifier calls and computed callee (arrow fn, member access).
|
|
(define
|
|
js-transpile-unop
|
|
(fn
|
|
(op arg)
|
|
(cond
|
|
((= op "delete")
|
|
(cond
|
|
((js-tag? arg "js-member")
|
|
(list
|
|
(js-sym "js-delete-prop")
|
|
(js-transpile (nth arg 1))
|
|
(nth arg 2)))
|
|
((js-tag? arg "js-index")
|
|
(list
|
|
(js-sym "js-delete-prop")
|
|
(js-transpile (nth arg 1))
|
|
(js-transpile (nth arg 2))))
|
|
(else true)))
|
|
(else
|
|
(let
|
|
((a (js-transpile arg)))
|
|
(cond
|
|
((= op "-") (list (js-sym "js-neg") a))
|
|
((= op "+") (list (js-sym "js-pos") a))
|
|
((= op "!") (list (js-sym "js-not") a))
|
|
((= op "~") (list (js-sym "js-bitnot") a))
|
|
((= op "typeof") (list (js-sym "js-typeof") a))
|
|
((= op "void") (list (js-sym "quote") :js-undefined))
|
|
(else (error (str "js-transpile-unop: unsupported op: " op)))))))))
|
|
|
|
;; ── Array literal ─────────────────────────────────────────────────
|
|
|
|
(define
|
|
js-transpile-binop
|
|
(fn
|
|
(op l r)
|
|
(cond
|
|
((= op "+")
|
|
(list (js-sym "js-add") (js-transpile l) (js-transpile r)))
|
|
((= op "-")
|
|
(list (js-sym "js-sub") (js-transpile l) (js-transpile r)))
|
|
((= op "*")
|
|
(list (js-sym "js-mul") (js-transpile l) (js-transpile r)))
|
|
((= op "/")
|
|
(list (js-sym "js-div") (js-transpile l) (js-transpile r)))
|
|
((= op "%")
|
|
(list (js-sym "js-mod") (js-transpile l) (js-transpile r)))
|
|
((= op "**")
|
|
(list (js-sym "js-pow") (js-transpile l) (js-transpile r)))
|
|
((= op "===")
|
|
(list (js-sym "js-strict-eq") (js-transpile l) (js-transpile r)))
|
|
((= op "!==")
|
|
(list (js-sym "js-strict-neq") (js-transpile l) (js-transpile r)))
|
|
((= op "==")
|
|
(list (js-sym "js-loose-eq") (js-transpile l) (js-transpile r)))
|
|
((= op "!=")
|
|
(list (js-sym "js-loose-neq") (js-transpile l) (js-transpile r)))
|
|
((= op "<")
|
|
(list (js-sym "js-lt") (js-transpile l) (js-transpile r)))
|
|
((= op ">")
|
|
(list (js-sym "js-gt") (js-transpile l) (js-transpile r)))
|
|
((= op "<=")
|
|
(list (js-sym "js-le") (js-transpile l) (js-transpile r)))
|
|
((= op ">=")
|
|
(list (js-sym "js-ge") (js-transpile l) (js-transpile r)))
|
|
((= op "&&")
|
|
(list
|
|
(js-sym "js-and")
|
|
(js-transpile l)
|
|
(list (js-sym "fn") (list) (js-transpile r))))
|
|
((= op "||")
|
|
(list
|
|
(js-sym "js-or")
|
|
(js-transpile l)
|
|
(list (js-sym "fn") (list) (js-transpile r))))
|
|
((= op "instanceof")
|
|
(list (js-sym "js-instanceof") (js-transpile l) (js-transpile r)))
|
|
((= op "in")
|
|
(list (js-sym "js-in") (js-transpile l) (js-transpile r)))
|
|
((= op "??")
|
|
(list
|
|
(js-sym "let")
|
|
(list (list (js-sym "_a") (js-transpile l)))
|
|
(list
|
|
(js-sym "if")
|
|
(list
|
|
(js-sym "or")
|
|
(list (js-sym "=") (js-sym "_a") nil)
|
|
(list (js-sym "js-undefined?") (js-sym "_a")))
|
|
(js-transpile r)
|
|
(js-sym "_a"))))
|
|
(else (error (str "js-transpile-binop: unsupported op: " op))))))
|
|
|
|
;; ── Object literal ────────────────────────────────────────────────
|
|
|
|
;; Build a dict by `(dict)` + `dict-set!` inside a `let` that yields
|
|
;; the dict as its final expression. This keeps keys in JS insertion
|
|
;; order and allows computed values.
|
|
(define
|
|
js-transpile-member
|
|
(fn (obj key) (list (js-sym "js-get-prop") (js-transpile obj) key)))
|
|
|
|
;; ── Conditional ───────────────────────────────────────────────────
|
|
|
|
(define
|
|
js-transpile-index
|
|
(fn
|
|
(obj idx)
|
|
(list (js-sym "js-get-prop") (js-transpile obj) (js-transpile idx))))
|
|
|
|
;; ── Arrow function ────────────────────────────────────────────────
|
|
|
|
(define
|
|
js-transpile-call
|
|
(fn
|
|
(callee args)
|
|
(cond
|
|
((and (js-tag? callee "js-member") (not (js-has-spread? args)))
|
|
(let
|
|
((recv (js-transpile (nth callee 1))) (key (nth callee 2)))
|
|
(list
|
|
(js-sym "js-invoke-method")
|
|
recv
|
|
key
|
|
(js-transpile-args args))))
|
|
((and (js-tag? callee "js-index") (not (js-has-spread? args)))
|
|
(let
|
|
((recv (js-transpile (nth callee 1)))
|
|
(key (js-transpile (nth callee 2))))
|
|
(list
|
|
(js-sym "js-invoke-method-dyn")
|
|
recv
|
|
key
|
|
(js-transpile-args args))))
|
|
((js-tag? callee "js-member")
|
|
(let
|
|
((recv (js-transpile (nth callee 1))) (key (nth callee 2)))
|
|
(list
|
|
(js-sym "js-invoke-method")
|
|
recv
|
|
key
|
|
(js-transpile-args args))))
|
|
((js-tag? callee "js-index")
|
|
(let
|
|
((recv (js-transpile (nth callee 1)))
|
|
(key (js-transpile (nth callee 2))))
|
|
(list
|
|
(js-sym "js-invoke-method-dyn")
|
|
recv
|
|
key
|
|
(js-transpile-args args))))
|
|
(else
|
|
(list
|
|
(js-sym "js-call-plain")
|
|
(js-transpile callee)
|
|
(js-transpile-args args))))))
|
|
|
|
;; ── Assignment ────────────────────────────────────────────────────
|
|
|
|
;; `a = b` on an ident → (set! a b).
|
|
;; `a += b` on an ident → (set! a (js-add a b)).
|
|
;; `obj.k = v` / `obj[k] = v` → (js-set-prop obj "k" v).
|
|
(define
|
|
js-transpile-new
|
|
(fn
|
|
(callee args)
|
|
(list
|
|
(js-sym "js-new-call")
|
|
(js-transpile callee)
|
|
(cons (js-sym "list") (map js-transpile args)))))
|
|
|
|
(define
|
|
js-transpile-array
|
|
(fn
|
|
(elts)
|
|
(if
|
|
(js-has-spread? elts)
|
|
(cons
|
|
(js-sym "js-array-spread-build")
|
|
(map
|
|
(fn
|
|
(e)
|
|
(if
|
|
(js-tag? e "js-spread")
|
|
(list (js-sym "list") "js-spread" (js-transpile (nth e 1)))
|
|
(list (js-sym "list") "js-value" (js-transpile e))))
|
|
elts))
|
|
(cons (js-sym "list") (map js-transpile elts)))))
|
|
|
|
(define
|
|
js-has-spread?
|
|
(fn
|
|
(lst)
|
|
(cond
|
|
((empty? lst) false)
|
|
((js-tag? (first lst) "js-spread") true)
|
|
(else (js-has-spread? (rest lst))))))
|
|
|
|
;; ── End-to-end entry points ───────────────────────────────────────
|
|
|
|
;; Transpile + eval a single JS expression string.
|
|
(define
|
|
js-transpile-args
|
|
(fn
|
|
(args)
|
|
(if
|
|
(js-has-spread? args)
|
|
(cons
|
|
(js-sym "js-array-spread-build")
|
|
(map
|
|
(fn
|
|
(e)
|
|
(if
|
|
(js-tag? e "js-spread")
|
|
(list (js-sym "list") "js-spread" (js-transpile (nth e 1)))
|
|
(list (js-sym "list") "js-value" (js-transpile e))))
|
|
args))
|
|
(cons (js-sym "list") (map js-transpile args)))))
|
|
|
|
;; Transpile a JS expression string to SX source text (for inspection
|
|
;; in tests). Useful for asserting the exact emitted tree.
|
|
(define
|
|
js-transpile-object
|
|
(fn
|
|
(entries)
|
|
(list
|
|
(js-sym "let")
|
|
(list (list (js-sym "_obj") (list (js-sym "dict"))))
|
|
(cons
|
|
(js-sym "begin")
|
|
(append
|
|
(map
|
|
(fn
|
|
(entry)
|
|
(list
|
|
(js-sym "dict-set!")
|
|
(js-sym "_obj")
|
|
(get entry :key)
|
|
(js-transpile (get entry :value))))
|
|
entries)
|
|
(list (js-sym "_obj")))))))
|
|
|
|
(define
|
|
js-transpile-cond
|
|
(fn
|
|
(c t f)
|
|
(list
|
|
(js-sym "if")
|
|
(list (js-sym "js-to-boolean") (js-transpile c))
|
|
(js-transpile t)
|
|
(js-transpile f))))
|
|
|
|
(define
|
|
js-transpile-arrow
|
|
(fn
|
|
(params body)
|
|
(let
|
|
((param-syms (js-build-param-list params))
|
|
(inits (js-param-init-forms params))
|
|
(body-tr
|
|
(if
|
|
(and (list? body) (js-tag? body "js-block"))
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__return__"))
|
|
(cons
|
|
(js-sym "begin")
|
|
(append
|
|
inits
|
|
(append
|
|
(js-collect-funcdecls (nth body 1))
|
|
(js-transpile-stmt-list (nth body 1)))))))
|
|
(if
|
|
(empty? inits)
|
|
(js-transpile body)
|
|
(cons
|
|
(js-sym "begin")
|
|
(append inits (list (js-transpile body))))))))
|
|
(list (js-sym "fn") param-syms body-tr))))
|
|
|
|
(define
|
|
js-transpile-tpl
|
|
(fn
|
|
(parts)
|
|
(cond
|
|
((empty? parts) (list (quote quote) ""))
|
|
((= (len parts) 1)
|
|
(list (js-sym "js-to-string") (js-transpile (first parts))))
|
|
(else
|
|
(cons (js-sym "js-template-concat") (js-transpile-tpl-parts parts))))))
|
|
|
|
(define
|
|
js-transpile-tpl-parts
|
|
(fn
|
|
(parts)
|
|
(if
|
|
(empty? parts)
|
|
(list)
|
|
(cons
|
|
(js-transpile (first parts))
|
|
(js-transpile-tpl-parts (rest parts))))))
|
|
|
|
(define
|
|
js-transpile-assign
|
|
(fn
|
|
(op target rhs)
|
|
(cond
|
|
((js-tag? target "js-ident")
|
|
(let
|
|
((name (nth target 1)))
|
|
(let
|
|
((sxname (js-sym name)))
|
|
(cond
|
|
((= op "=") (list (js-sym "set!") sxname (js-transpile rhs)))
|
|
(else
|
|
(list
|
|
(js-sym "set!")
|
|
sxname
|
|
(js-compound-update op sxname (js-transpile rhs))))))))
|
|
((js-tag? target "js-member")
|
|
(list
|
|
(js-sym "js-set-prop")
|
|
(js-transpile (nth target 1))
|
|
(nth target 2)
|
|
(js-compound-update-or-plain
|
|
op
|
|
(js-transpile target)
|
|
(js-transpile rhs))))
|
|
((js-tag? target "js-index")
|
|
(list
|
|
(js-sym "js-set-prop")
|
|
(js-transpile (nth target 1))
|
|
(js-transpile (nth target 2))
|
|
(js-compound-update-or-plain
|
|
op
|
|
(js-transpile target)
|
|
(js-transpile rhs))))
|
|
(else (error "js-transpile-assign: unsupported target")))))
|
|
|
|
(define
|
|
js-compound-update
|
|
(fn
|
|
(op lhs-expr rhs-expr)
|
|
(cond
|
|
((= op "+=") (list (js-sym "js-add") lhs-expr rhs-expr))
|
|
((= op "-=") (list (js-sym "js-sub") lhs-expr rhs-expr))
|
|
((= op "*=") (list (js-sym "js-mul") lhs-expr rhs-expr))
|
|
((= op "/=") (list (js-sym "js-div") lhs-expr rhs-expr))
|
|
((= op "%=") (list (js-sym "js-mod") lhs-expr rhs-expr))
|
|
((= op "**=") (list (js-sym "js-pow") lhs-expr rhs-expr))
|
|
((= op "&&=")
|
|
(list
|
|
(js-sym "if")
|
|
(list (js-sym "js-to-boolean") lhs-expr)
|
|
rhs-expr
|
|
lhs-expr))
|
|
((= op "||=")
|
|
(list
|
|
(js-sym "if")
|
|
(list (js-sym "js-to-boolean") lhs-expr)
|
|
lhs-expr
|
|
rhs-expr))
|
|
((= op "??=")
|
|
(list
|
|
(js-sym "if")
|
|
(list
|
|
(js-sym "or")
|
|
(list (js-sym "=") lhs-expr nil)
|
|
(list (js-sym "js-undefined?") lhs-expr))
|
|
rhs-expr
|
|
lhs-expr))
|
|
(else (error (str "js-compound-update: unsupported op: " op))))))
|
|
|
|
(define
|
|
js-compound-update-or-plain
|
|
(fn
|
|
(op lhs-expr rhs-expr)
|
|
(cond
|
|
((= op "=") rhs-expr)
|
|
(else (js-compound-update op lhs-expr rhs-expr)))))
|
|
|
|
(define
|
|
js-transpile-prefix
|
|
(fn
|
|
(op target)
|
|
(let
|
|
((delta (if (= op "++") 1 -1)))
|
|
(cond
|
|
((js-tag? target "js-ident")
|
|
(let
|
|
((name (nth target 1)))
|
|
(let
|
|
((sxname (js-sym name)))
|
|
(list
|
|
(js-sym "set!")
|
|
sxname
|
|
(list
|
|
(js-sym "+")
|
|
(list (js-sym "js-to-number") sxname)
|
|
delta)))))
|
|
((js-tag? target "js-member")
|
|
(let
|
|
((obj-sx (js-transpile (nth target 1))) (key (nth target 2)))
|
|
(list
|
|
(js-sym "js-set-prop")
|
|
obj-sx
|
|
key
|
|
(list
|
|
(js-sym "+")
|
|
(list
|
|
(js-sym "js-to-number")
|
|
(list (js-sym "js-get-prop") obj-sx key))
|
|
delta))))
|
|
((js-tag? target "js-index")
|
|
(let
|
|
((obj-sx (js-transpile (nth target 1)))
|
|
(key-sx (js-transpile (nth target 2))))
|
|
(list
|
|
(js-sym "js-set-prop")
|
|
obj-sx
|
|
key-sx
|
|
(list
|
|
(js-sym "+")
|
|
(list
|
|
(js-sym "js-to-number")
|
|
(list (js-sym "js-get-prop") obj-sx key-sx))
|
|
delta))))
|
|
(else (error "js-transpile-prefix: unsupported target"))))))
|
|
|
|
(define
|
|
js-transpile-postfix
|
|
(fn
|
|
(op target)
|
|
(let
|
|
((delta (if (= op "++") 1 -1)))
|
|
(cond
|
|
((js-tag? target "js-ident")
|
|
(let
|
|
((name (nth target 1)))
|
|
(let
|
|
((sxname (js-sym name)))
|
|
(list
|
|
(js-sym "let")
|
|
(list
|
|
(list
|
|
(js-sym "__js_old__")
|
|
(list (js-sym "js-to-number") sxname)))
|
|
(list
|
|
(js-sym "set!")
|
|
sxname
|
|
(list (js-sym "+") (js-sym "__js_old__") delta))
|
|
(js-sym "__js_old__")))))
|
|
((js-tag? target "js-member")
|
|
(let
|
|
((obj-sx (js-transpile (nth target 1))) (key (nth target 2)))
|
|
(list
|
|
(js-sym "let")
|
|
(list
|
|
(list (js-sym "__js_obj__") obj-sx)
|
|
(list
|
|
(js-sym "__js_old__")
|
|
(list
|
|
(js-sym "js-to-number")
|
|
(list (js-sym "js-get-prop") (js-sym "__js_obj__") key))))
|
|
(list
|
|
(js-sym "js-set-prop")
|
|
(js-sym "__js_obj__")
|
|
key
|
|
(list (js-sym "+") (js-sym "__js_old__") delta))
|
|
(js-sym "__js_old__"))))
|
|
((js-tag? target "js-index")
|
|
(let
|
|
((obj-sx (js-transpile (nth target 1)))
|
|
(key-sx (js-transpile (nth target 2))))
|
|
(list
|
|
(js-sym "let")
|
|
(list
|
|
(list (js-sym "__js_obj__") obj-sx)
|
|
(list (js-sym "__js_key__") key-sx)
|
|
(list
|
|
(js-sym "__js_old__")
|
|
(list
|
|
(js-sym "js-to-number")
|
|
(list
|
|
(js-sym "js-get-prop")
|
|
(js-sym "__js_obj__")
|
|
(js-sym "__js_key__")))))
|
|
(list
|
|
(js-sym "js-set-prop")
|
|
(js-sym "__js_obj__")
|
|
(js-sym "__js_key__")
|
|
(list (js-sym "+") (js-sym "__js_old__") delta))
|
|
(js-sym "__js_old__"))))
|
|
(else (error "js-transpile-postfix: unsupported target"))))))
|
|
|
|
(define
|
|
js-transpile-switch
|
|
(fn
|
|
(discr cases)
|
|
(let
|
|
((discr-sym (js-sym "__discr__"))
|
|
(matched-sym (js-sym "__matched__"))
|
|
(break-sym (js-sym "__break__")))
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list break-sym)
|
|
(list
|
|
(js-sym "let")
|
|
(list
|
|
(list discr-sym (js-transpile discr))
|
|
(list matched-sym false))
|
|
(js-transpile-switch-clauses cases discr-sym matched-sym)))))))
|
|
|
|
(define
|
|
js-transpile-switch-clauses
|
|
(fn
|
|
(cases discr-sym matched-sym)
|
|
(let
|
|
((forms (list)))
|
|
(for-each
|
|
(fn
|
|
(c)
|
|
(let
|
|
((kind (nth c 0)))
|
|
(cond
|
|
((= kind "case")
|
|
(let
|
|
((val (nth c 1)) (body (nth c 2)))
|
|
(append!
|
|
forms
|
|
(list
|
|
(js-sym "when")
|
|
(list
|
|
(js-sym "or")
|
|
matched-sym
|
|
(list
|
|
(js-sym "js-strict-eq")
|
|
discr-sym
|
|
(js-transpile val)))
|
|
(js-transpile-switch-body-block matched-sym body)))))
|
|
((= kind "default")
|
|
(let
|
|
((body (nth c 2)))
|
|
(append!
|
|
forms
|
|
(list
|
|
(js-sym "when")
|
|
matched-sym
|
|
(js-transpile-switch-body-block matched-sym body))))))))
|
|
cases)
|
|
(let
|
|
((def-body nil))
|
|
(for-each
|
|
(fn
|
|
(c)
|
|
(when (= (nth c 0) "default") (set! def-body (nth c 2))))
|
|
cases)
|
|
(when
|
|
(not (= def-body nil))
|
|
(append!
|
|
forms
|
|
(list
|
|
(js-sym "when")
|
|
(list (js-sym "not") matched-sym)
|
|
(js-transpile-switch-body-block matched-sym def-body)))))
|
|
(cons (js-sym "begin") forms))))
|
|
|
|
(define
|
|
js-transpile-switch-body-block
|
|
(fn
|
|
(matched-sym body)
|
|
(let
|
|
((forms (list (list (js-sym "set!") matched-sym true))))
|
|
(for-each (fn (stmt) (append! forms (js-transpile stmt))) body)
|
|
(cons (js-sym "begin") forms))))
|
|
|
|
(define
|
|
js-transpile-for-of-in
|
|
(fn
|
|
(iter-kind ident iter-ast body-ast)
|
|
(let
|
|
((ident-sym (js-sym ident))
|
|
(iter-sx (js-transpile iter-ast))
|
|
(body-sx (js-transpile body-ast))
|
|
(items-sym (js-sym "__js_items__")))
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__break__"))
|
|
(list
|
|
(js-sym "let")
|
|
(list
|
|
(list
|
|
items-sym
|
|
(if
|
|
(= iter-kind "of")
|
|
(list (js-sym "js-iterable-to-list") iter-sx)
|
|
(list (js-sym "js-object-keys") iter-sx))))
|
|
(list
|
|
(js-sym "for-each")
|
|
(list
|
|
(js-sym "fn")
|
|
(list ident-sym)
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__continue__"))
|
|
body-sx)))
|
|
items-sym)))))))
|
|
|
|
(define
|
|
js-param-sym
|
|
(fn
|
|
(p)
|
|
(cond
|
|
((string? p) (js-sym p))
|
|
((and (list? p) (js-tag? p "js-param")) (js-sym (nth p 1)))
|
|
((and (list? p) (js-tag? p "js-rest")) (js-sym (nth p 1)))
|
|
(else (js-sym p)))))
|
|
|
|
(define
|
|
js-build-param-list
|
|
(fn
|
|
(params)
|
|
(cond
|
|
((empty? params) (list))
|
|
((and (list? (first params)) (js-tag? (first params) "js-rest"))
|
|
(list (js-sym "&rest") (js-sym (nth (first params) 1))))
|
|
(else
|
|
(cons
|
|
(js-param-sym (first params))
|
|
(js-build-param-list (rest params)))))))
|
|
|
|
(define
|
|
js-param-init-forms
|
|
(fn
|
|
(params)
|
|
(cond
|
|
((empty? params) (list))
|
|
((and (list? (first params)) (js-tag? (first params) "js-param"))
|
|
(let
|
|
((nm (js-sym (nth (first params) 1)))
|
|
(dv (js-transpile (nth (first params) 2))))
|
|
(cons
|
|
(list
|
|
(js-sym "set!")
|
|
nm
|
|
(list
|
|
(js-sym "if")
|
|
(list
|
|
(js-sym "or")
|
|
(list (js-sym "=") nm nil)
|
|
(list
|
|
(js-sym "=")
|
|
nm
|
|
(list (js-sym "quote") :js-undefined)))
|
|
dv
|
|
nm))
|
|
(js-param-init-forms (rest params)))))
|
|
(else (js-param-init-forms (rest params))))))
|
|
|
|
(define
|
|
js-transpile-stmts
|
|
(fn
|
|
(stmts)
|
|
(let
|
|
((hoisted (js-collect-funcdecls stmts)))
|
|
(let
|
|
((rest-stmts (js-transpile-stmt-list stmts)))
|
|
(cons (js-sym "begin") (append hoisted rest-stmts))))))
|
|
|
|
(define
|
|
js-collect-funcdecls
|
|
(fn
|
|
(stmts)
|
|
(cond
|
|
((empty? stmts) (list))
|
|
((and (list? (first stmts)) (js-tag? (first stmts) "js-funcdecl"))
|
|
(cons
|
|
(js-transpile-funcdecl
|
|
(nth (first stmts) 1)
|
|
(nth (first stmts) 2)
|
|
(nth (first stmts) 3))
|
|
(js-collect-funcdecls (rest stmts))))
|
|
(else (js-collect-funcdecls (rest stmts))))))
|
|
|
|
(define
|
|
js-transpile-optchain-member
|
|
(fn
|
|
(obj-ast name)
|
|
(list (js-sym "js-optchain-get") (js-transpile obj-ast) name)))
|
|
|
|
(define
|
|
js-transpile-optchain-index
|
|
(fn
|
|
(obj-ast key-ast)
|
|
(list
|
|
(js-sym "js-optchain-get")
|
|
(js-transpile obj-ast)
|
|
(js-transpile key-ast))))
|
|
|
|
(define
|
|
js-transpile-optchain-call
|
|
(fn
|
|
(callee-ast args)
|
|
(list
|
|
(js-sym "js-optchain-call")
|
|
(js-transpile callee-ast)
|
|
(js-transpile-args args))))
|
|
|
|
(define
|
|
js-transpile-stmt-list
|
|
(fn
|
|
(stmts)
|
|
(cond
|
|
((empty? stmts) (list))
|
|
((and (list? (first stmts)) (js-tag? (first stmts) "js-funcdecl"))
|
|
(cons nil (js-transpile-stmt-list (rest stmts))))
|
|
(else
|
|
(cons
|
|
(js-transpile (first stmts))
|
|
(js-transpile-stmt-list (rest stmts)))))))
|
|
|
|
(define
|
|
js-transpile-var
|
|
(fn (kind decls) (cons (js-sym "begin") (js-vardecl-forms decls))))
|
|
|
|
(define
|
|
js-vardecl-forms
|
|
(fn
|
|
(decls)
|
|
(cond
|
|
((empty? decls) (list))
|
|
(else
|
|
(let
|
|
((d (first decls)))
|
|
(cond
|
|
((js-tag? d "js-vardecl")
|
|
(cons
|
|
(list
|
|
(js-sym "define")
|
|
(js-sym (nth d 1))
|
|
(js-transpile (nth d 2)))
|
|
(js-vardecl-forms (rest decls))))
|
|
((js-tag? d "js-vardecl-obj")
|
|
(let
|
|
((names (nth d 1))
|
|
(rhs (js-transpile (nth d 2)))
|
|
(tmp-sym (js-sym "__destruct__")))
|
|
(cons
|
|
(list (js-sym "define") tmp-sym rhs)
|
|
(js-vardecl-obj-forms
|
|
names
|
|
tmp-sym
|
|
(js-vardecl-forms (rest decls))))))
|
|
((js-tag? d "js-vardecl-arr")
|
|
(let
|
|
((names (nth d 1))
|
|
(rhs (js-transpile (nth d 2)))
|
|
(tmp-sym (js-sym "__destruct__")))
|
|
(cons
|
|
(list (js-sym "define") tmp-sym rhs)
|
|
(js-vardecl-arr-forms
|
|
names
|
|
tmp-sym
|
|
0
|
|
(js-vardecl-forms (rest decls))))))
|
|
(else (error "js-vardecl-forms: unexpected decl"))))))))
|
|
|
|
(define
|
|
js-vardecl-obj-forms
|
|
(fn
|
|
(names tmp-sym tail)
|
|
(cond
|
|
((empty? names) tail)
|
|
((= (first names) nil)
|
|
(js-vardecl-obj-forms (rest names) tmp-sym tail))
|
|
((and (list? (first names)) (= (first (first names)) "rename"))
|
|
(cons
|
|
(list
|
|
(js-sym "define")
|
|
(js-sym (nth (first names) 2))
|
|
(list (js-sym "js-get-prop") tmp-sym (nth (first names) 1)))
|
|
(js-vardecl-obj-forms (rest names) tmp-sym tail)))
|
|
((and (list? (first names)) (= (first (first names)) "rest"))
|
|
(js-vardecl-obj-forms (rest names) tmp-sym tail))
|
|
(else
|
|
(cons
|
|
(list
|
|
(js-sym "define")
|
|
(js-sym (first names))
|
|
(list (js-sym "js-get-prop") tmp-sym (first names)))
|
|
(js-vardecl-obj-forms (rest names) tmp-sym tail))))))
|
|
|
|
(define
|
|
js-vardecl-arr-forms
|
|
(fn
|
|
(names tmp-sym i tail)
|
|
(cond
|
|
((empty? names) tail)
|
|
((= (first names) nil)
|
|
(js-vardecl-arr-forms (rest names) tmp-sym (+ i 1) tail))
|
|
((and (list? (first names)) (= (first (first names)) "rest"))
|
|
(cons
|
|
(list
|
|
(js-sym "define")
|
|
(js-sym (nth (first names) 1))
|
|
(list
|
|
(js-sym "js-list-slice")
|
|
tmp-sym
|
|
i
|
|
(list (js-sym "len") tmp-sym)))
|
|
tail))
|
|
(else
|
|
(cons
|
|
(list
|
|
(js-sym "define")
|
|
(js-sym (first names))
|
|
(list (js-sym "js-get-prop") tmp-sym i))
|
|
(js-vardecl-arr-forms (rest names) tmp-sym (+ i 1) tail))))))
|
|
|
|
(define
|
|
js-transpile-if-stmt
|
|
(fn
|
|
(c t e)
|
|
(let
|
|
((c-tr (list (js-sym "js-to-boolean") (js-transpile c)))
|
|
(t-tr (if (= t nil) nil (js-transpile t))))
|
|
(if
|
|
(= e nil)
|
|
(list (js-sym "if") c-tr t-tr nil)
|
|
(list (js-sym "if") c-tr t-tr (js-transpile e))))))
|
|
|
|
(define
|
|
js-transpile-while
|
|
(fn
|
|
(c body)
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__break__"))
|
|
(list
|
|
(js-sym "letrec")
|
|
(list
|
|
(list
|
|
(js-sym "__loop__")
|
|
(list
|
|
(js-sym "fn")
|
|
(list)
|
|
(list
|
|
(js-sym "if")
|
|
(list (js-sym "js-to-boolean") (js-transpile c))
|
|
(list
|
|
(js-sym "begin")
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__continue__"))
|
|
(js-transpile body)))
|
|
(list (js-sym "__loop__")))
|
|
nil))))
|
|
(list (js-sym "__loop__")))))))
|
|
|
|
(define
|
|
js-transpile-do-while
|
|
(fn
|
|
(body c)
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__break__"))
|
|
(list
|
|
(js-sym "letrec")
|
|
(list
|
|
(list
|
|
(js-sym "__loop__")
|
|
(list
|
|
(js-sym "fn")
|
|
(list)
|
|
(list
|
|
(js-sym "begin")
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__continue__"))
|
|
(js-transpile body)))
|
|
(list
|
|
(js-sym "if")
|
|
(list (js-sym "js-to-boolean") (js-transpile c))
|
|
(list (js-sym "__loop__"))
|
|
nil)))))
|
|
(list (js-sym "__loop__")))))))
|
|
|
|
(define
|
|
js-transpile-for
|
|
(fn
|
|
(init cond-ast step body)
|
|
(let
|
|
((init-form (if (= init nil) nil (js-transpile init)))
|
|
(cond-form
|
|
(if
|
|
(= cond-ast nil)
|
|
(list (js-sym "quote") true)
|
|
(list (js-sym "js-to-boolean") (js-transpile cond-ast))))
|
|
(step-form (if (= step nil) nil (js-transpile step)))
|
|
(body-tr (js-transpile body)))
|
|
(list
|
|
(js-sym "begin")
|
|
(if (= init-form nil) nil init-form)
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__break__"))
|
|
(list
|
|
(js-sym "letrec")
|
|
(list
|
|
(list
|
|
(js-sym "__loop__")
|
|
(list
|
|
(js-sym "fn")
|
|
(list)
|
|
(list
|
|
(js-sym "if")
|
|
cond-form
|
|
(list
|
|
(js-sym "begin")
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__continue__"))
|
|
body-tr))
|
|
(if (= step-form nil) nil step-form)
|
|
(list (js-sym "__loop__")))
|
|
nil))))
|
|
(list (js-sym "__loop__")))))))))
|
|
|
|
(define
|
|
js-transpile-return
|
|
(fn
|
|
(e)
|
|
(list
|
|
(js-sym "__return__")
|
|
(if (= e nil) (list (js-sym "quote") :js-undefined) (js-transpile e)))))
|
|
|
|
(define js-transpile-break (fn () (list (js-sym "__break__") nil)))
|
|
|
|
(define js-transpile-continue (fn () (list (js-sym "__continue__") nil)))
|
|
|
|
(define
|
|
js-transpile-funcdecl
|
|
(fn
|
|
(name params body)
|
|
(list
|
|
(js-sym "define")
|
|
(js-sym name)
|
|
(js-transpile-funcexpr name params body))))
|
|
|
|
(define
|
|
js-transpile-class
|
|
(fn
|
|
(name parent methods)
|
|
(let
|
|
((ctor-method (js-find-ctor methods))
|
|
(instance-methods (js-filter-methods methods "instance"))
|
|
(name-sym (js-sym name)))
|
|
(let
|
|
((ctor-body (if (= ctor-method nil) (if parent (js-default-ctor-with-super parent) (js-default-ctor-noop)) (js-transpile-funcexpr name (nth ctor-method 3) (nth ctor-method 4)))))
|
|
(cons
|
|
(js-sym "begin")
|
|
(append
|
|
(list (list (js-sym "define") name-sym ctor-body))
|
|
(list (list (js-sym "js-reset-ctor-proto!") name-sym))
|
|
(if
|
|
parent
|
|
(list
|
|
(list
|
|
(js-sym "dict-set!")
|
|
(list (js-sym "js-get-ctor-proto") name-sym)
|
|
"__proto__"
|
|
(list (js-sym "js-get-ctor-proto") (js-sym parent))))
|
|
(list))
|
|
(map
|
|
(fn
|
|
(m)
|
|
(let
|
|
((mname (nth m 2))
|
|
(mparams (nth m 3))
|
|
(mbody (nth m 4)))
|
|
(list
|
|
(js-sym "dict-set!")
|
|
(list (js-sym "js-get-ctor-proto") name-sym)
|
|
mname
|
|
(js-transpile-funcexpr mname mparams mbody))))
|
|
instance-methods)
|
|
(list
|
|
(list
|
|
(js-sym "dict-set!")
|
|
(list (js-sym "js-get-ctor-proto") name-sym)
|
|
"constructor"
|
|
name-sym))))))))
|
|
|
|
(define
|
|
js-find-ctor
|
|
(fn
|
|
(methods)
|
|
(cond
|
|
((empty? methods) nil)
|
|
((and (js-tag? (first methods) "js-method") (= (nth (first methods) 1) "instance") (= (nth (first methods) 2) "constructor"))
|
|
(first methods))
|
|
(else (js-find-ctor (rest methods))))))
|
|
|
|
(define
|
|
js-filter-methods
|
|
(fn
|
|
(methods kind)
|
|
(cond
|
|
((empty? methods) (list))
|
|
((and (js-tag? (first methods) "js-method") (= (nth (first methods) 1) kind) (not (= (nth (first methods) 2) "constructor")))
|
|
(cons (first methods) (js-filter-methods (rest methods) kind)))
|
|
(else (js-filter-methods (rest methods) kind)))))
|
|
|
|
(define
|
|
js-default-ctor-noop
|
|
(fn
|
|
()
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "&rest") (js-sym "__args__"))
|
|
(list
|
|
(js-sym "let")
|
|
(list (list (js-sym "this") (list (js-sym "js-this"))))
|
|
:js-undefined))))
|
|
|
|
(define
|
|
js-default-ctor-with-super
|
|
(fn
|
|
(parent)
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "&rest") (js-sym "__args__"))
|
|
(list
|
|
(js-sym "let")
|
|
(list (list (js-sym "this") (list (js-sym "js-this"))))
|
|
(list
|
|
(js-sym "js-call-with-this")
|
|
(js-sym "this")
|
|
(js-sym parent)
|
|
(js-sym "__args__"))))))
|
|
|
|
(define
|
|
js-transpile-throw
|
|
(fn (e) (list (js-sym "raise") (js-transpile e))))
|
|
|
|
(define
|
|
js-transpile-try
|
|
(fn
|
|
(body catch-part finally-part)
|
|
(let
|
|
((body-tr (js-transpile body)))
|
|
(let
|
|
((with-catch (cond ((= catch-part nil) body-tr) (else (let ((pname (nth catch-part 0)) (cbody (nth catch-part 1))) (list (js-sym "guard") (list (if (= pname nil) (js-sym "__exc__") (js-sym pname)) (list (js-sym "else") (js-transpile cbody))) body-tr))))))
|
|
(cond
|
|
((= finally-part nil) with-catch)
|
|
(else
|
|
(list
|
|
(js-sym "let")
|
|
(list (list (js-sym "__try_result__") with-catch))
|
|
(js-transpile finally-part)
|
|
(js-sym "__try_result__"))))))))
|
|
|
|
(define
|
|
js-transpile-funcexpr
|
|
(fn
|
|
(name params body)
|
|
(let
|
|
((param-syms (js-build-param-list params))
|
|
(inits (js-param-init-forms params))
|
|
(body-forms
|
|
(if
|
|
(and (list? body) (js-tag? body "js-block"))
|
|
(let
|
|
((hoisted (js-collect-funcdecls (nth body 1))))
|
|
(append hoisted (js-transpile-stmt-list (nth body 1))))
|
|
(list (js-transpile body)))))
|
|
(list
|
|
(js-sym "fn")
|
|
param-syms
|
|
(list
|
|
(js-sym "let")
|
|
(list (list (js-sym "this") (list (js-sym "js-this"))))
|
|
(list
|
|
(js-sym "let")
|
|
(list
|
|
(list
|
|
(js-sym "__r__")
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__return__"))
|
|
(cons (js-sym "begin") (append inits body-forms))))))
|
|
(list
|
|
(js-sym "if")
|
|
(list (js-sym "=") (js-sym "__r__") nil)
|
|
:js-undefined (js-sym "__r__"))))))))
|
|
|
|
(define
|
|
js-transpile-funcexpr-async
|
|
(fn
|
|
(name params body)
|
|
(let
|
|
((param-syms (js-build-param-list params))
|
|
(inits (js-param-init-forms params))
|
|
(body-forms
|
|
(if
|
|
(and (list? body) (js-tag? body "js-block"))
|
|
(let
|
|
((hoisted (js-collect-funcdecls (nth body 1))))
|
|
(append hoisted (js-transpile-stmt-list (nth body 1))))
|
|
(list (js-transpile body)))))
|
|
(list
|
|
(js-sym "fn")
|
|
param-syms
|
|
(list
|
|
(js-sym "let")
|
|
(list (list (js-sym "this") (list (js-sym "js-this"))))
|
|
(list
|
|
(js-sym "js-async-wrap")
|
|
(list
|
|
(js-sym "fn")
|
|
(list)
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__return__"))
|
|
(cons (js-sym "begin") (append inits body-forms)))))))))))
|
|
|
|
(define
|
|
js-transpile-funcdecl-async
|
|
(fn
|
|
(name params body)
|
|
(list
|
|
(js-sym "define")
|
|
(js-sym name)
|
|
(js-transpile-funcexpr-async name params body))))
|
|
|
|
(define
|
|
js-transpile-arrow-async
|
|
(fn
|
|
(params body)
|
|
(let
|
|
((param-syms (js-build-param-list params))
|
|
(inits (js-param-init-forms params))
|
|
(body-tr
|
|
(if
|
|
(and (list? body) (js-tag? body "js-block"))
|
|
(list
|
|
(js-sym "call/cc")
|
|
(list
|
|
(js-sym "fn")
|
|
(list (js-sym "__return__"))
|
|
(cons
|
|
(js-sym "begin")
|
|
(append
|
|
inits
|
|
(append
|
|
(js-collect-funcdecls (nth body 1))
|
|
(js-transpile-stmt-list (nth body 1)))))))
|
|
(if
|
|
(empty? inits)
|
|
(js-transpile body)
|
|
(cons
|
|
(js-sym "begin")
|
|
(append inits (list (js-transpile body))))))))
|
|
(list
|
|
(js-sym "fn")
|
|
param-syms
|
|
(list (js-sym "js-async-wrap") (list (js-sym "fn") (list) body-tr))))))
|
|
|
|
(define
|
|
js-eval
|
|
(fn
|
|
(src)
|
|
(let
|
|
((result (eval-expr (js-transpile (js-parse (js-tokenize src))))))
|
|
(js-drain-microtasks!)
|
|
result)))
|
|
|
|
(define js-compile-expr (fn (src) (js-transpile (js-parse-expr src))))
|