giles
df4aa8eb0a
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
6706 lines
197 KiB
Plaintext
6706 lines
197 KiB
Plaintext
;; lib/js/runtime.sx — JS semantics shims
|
|
;;
|
|
;; Coercions, abstract equality, arithmetic with JS rules, and the
|
|
;; global object live here. Transpiled code (from lib/js/transpile.sx)
|
|
;; compiles to calls into these helpers.
|
|
;;
|
|
;; Phase 4 status: core coercions, arithmetic, comparison, equality,
|
|
;; property access, `console.log`, Math shim wired up. Enough to make
|
|
;; the expression-level test262 slice green.
|
|
|
|
;; ── JS value sentinels ────────────────────────────────────────────
|
|
|
|
;; JS `undefined` — we represent it as a distinct keyword so it
|
|
;; survives round-trips through the evaluator without colliding with
|
|
;; SX `nil` (which maps to JS `null`).
|
|
(define js-nan-value (fn () nan))
|
|
|
|
(define js-infinity-value (fn () inf))
|
|
|
|
;; ── Type predicates ───────────────────────────────────────────────
|
|
|
|
(define js-max-value-approx (fn () 1.7976931348623157e+308))
|
|
|
|
;; ── Boolean coercion (ToBoolean) ──────────────────────────────────
|
|
|
|
(define js-function-global {:__callable__ (fn (&rest args) (js-function-ctor args)) :prototype {:call {:__callable__ (fn (&rest args) (js-invoke-function-method (js-this) "call" args)) :length 1 :name "call"} :length 0 :bind {:__callable__ (fn (&rest args) (js-invoke-function-method (js-this) "bind" args)) :length 1 :name "bind"} :toString {:__callable__ (fn () (js-invoke-function-method (js-this) "toString" (list))) :length 0 :name "toString"} :apply {:__callable__ (fn (&rest args) (js-invoke-function-method (js-this) "apply" args)) :length 2 :name "apply"} :name ""}})
|
|
|
|
(define
|
|
js-function-ctor
|
|
(fn
|
|
(args)
|
|
(cond
|
|
((empty? args) (js-eval "(function(){})"))
|
|
(else
|
|
(let
|
|
((all-strs (js-fn-args-to-strs args))
|
|
(n (len args)))
|
|
(let
|
|
((param-strs (js-fn-take-init all-strs))
|
|
(body-str (js-fn-take-last all-strs)))
|
|
(js-eval
|
|
(str "(function(" (js-fn-join-commas param-strs) "){" body-str "})"))))))))
|
|
|
|
(define
|
|
js-fn-args-to-strs
|
|
(fn
|
|
(args)
|
|
(cond
|
|
((empty? args) (list))
|
|
(else (cons (js-to-string (first args)) (js-fn-args-to-strs (rest args)))))))
|
|
|
|
(define
|
|
js-fn-take-init
|
|
(fn
|
|
(lst)
|
|
(cond
|
|
((empty? lst) (list))
|
|
((empty? (rest lst)) (list))
|
|
(else (cons (first lst) (js-fn-take-init (rest lst)))))))
|
|
|
|
(define
|
|
js-fn-take-last
|
|
(fn
|
|
(lst)
|
|
(cond
|
|
((empty? lst) "")
|
|
((empty? (rest lst)) (first lst))
|
|
(else (js-fn-take-last (rest lst))))))
|
|
|
|
(define
|
|
js-fn-join-commas
|
|
(fn
|
|
(lst)
|
|
(cond
|
|
((empty? lst) "")
|
|
((empty? (rest lst)) (first lst))
|
|
(else (str (first lst) "," (js-fn-join-commas (rest lst)))))))
|
|
|
|
;; ── Numeric coercion (ToNumber) ───────────────────────────────────
|
|
|
|
(dict-set!
|
|
(get js-function-global "prototype")
|
|
"isPrototypeOf"
|
|
(fn (x) (js-function? x)))
|
|
|
|
;; Parse a JS-style string to a number. For the slice we just delegate
|
|
;; to SX's number parser via `str->num`/`parse-number`. Empty string → 0
|
|
;; per JS (technically ToNumber("") === 0).
|
|
(define
|
|
js-global-eval
|
|
(fn (&rest args)
|
|
(cond
|
|
((empty? args) :js-undefined)
|
|
((not (= (type-of (nth args 0)) "string")) (nth args 0))
|
|
(else (js-eval (nth args 0))))))
|
|
|
|
;; Safe number-parser. Tries to call an SX primitive that can parse
|
|
;; strings to numbers; on failure returns 0 (stand-in for NaN so the
|
|
;; slice doesn't crash).
|
|
(define
|
|
js-max-value-loop
|
|
(fn
|
|
(cur steps)
|
|
(if
|
|
(<= steps 0)
|
|
cur
|
|
(let
|
|
((next (* cur 2)))
|
|
(if
|
|
(= next (js-infinity-value))
|
|
cur
|
|
(js-max-value-loop next (- steps 1)))))))
|
|
|
|
;; Minimal string->number for the slice. Handles integers, negatives,
|
|
;; and simple decimals. Returns 0 on malformed input.
|
|
(define js-undefined :js-undefined)
|
|
|
|
(define js-undefined? (fn (v) (= v :js-undefined)))
|
|
|
|
(define __js_this_cell__ (dict))
|
|
|
|
(define
|
|
js-this
|
|
(fn
|
|
()
|
|
(if
|
|
(dict-has? __js_this_cell__ "this")
|
|
(get __js_this_cell__ "this")
|
|
js-global-this)))
|
|
|
|
(define js-global-this :js-undefined)
|
|
|
|
(define js-this-set! (fn (v) (dict-set! __js_this_cell__ "this" v)))
|
|
|
|
(define
|
|
js-call-with-this
|
|
(fn
|
|
(recv fn-val args)
|
|
(let
|
|
((saved (js-this)))
|
|
(begin
|
|
(js-this-set! recv)
|
|
(let
|
|
((result (js-apply-fn fn-val args)))
|
|
(begin (js-this-set! saved) result))))))
|
|
|
|
(define
|
|
js-function-method?
|
|
(fn
|
|
(name)
|
|
(or
|
|
(= name "call")
|
|
(= name "apply")
|
|
(= name "bind")
|
|
(= name "toString")
|
|
(= name "name")
|
|
(= name "length"))))
|
|
|
|
;; parse a decimal number from a trimmed non-empty string.
|
|
;; s — source
|
|
;; i — cursor
|
|
;; acc — integer part so far (or total for decimals)
|
|
;; sign — 1 or -1
|
|
;; frac? — are we past the decimal point
|
|
;; fdiv — divisor used to scale fraction digits (only if frac?)
|
|
(define
|
|
js-fn-length
|
|
(fn
|
|
(f)
|
|
(let
|
|
((t (type-of f)))
|
|
(cond
|
|
((= t "lambda")
|
|
(let
|
|
((mapped (js-builtin-fn-length (js-unmap-fn-name (js-extract-fn-name f)))))
|
|
(if (>= mapped 0) mapped (js-count-real-params (lambda-params f)))))
|
|
((= t "function") 0)
|
|
((= t "component") 0)
|
|
((and (= t "dict") (contains? (keys f) "__callable__"))
|
|
(js-fn-length (get f "__callable__")))
|
|
(else 0)))))
|
|
|
|
(define
|
|
js-builtin-fn-length
|
|
(fn
|
|
(name)
|
|
(cond
|
|
((= name "fromCharCode") 1)
|
|
((= name "fromCodePoint") 1)
|
|
((= name "raw") 1)
|
|
((= name "of") 0)
|
|
((= name "from") 1)
|
|
((= name "isArray") 1)
|
|
((= name "max") 2)
|
|
((= name "min") 2)
|
|
((= name "hypot") 2)
|
|
((= name "atan2") 2)
|
|
((= name "imul") 2)
|
|
((= name "pow") 2)
|
|
(else -1))))
|
|
|
|
(define
|
|
js-extract-fn-name
|
|
(fn
|
|
(f)
|
|
(let ((raw (inspect f))) (js-strip-fn-name raw 0 (len raw)))))
|
|
|
|
(define
|
|
js-strip-fn-name
|
|
(fn
|
|
(s i n)
|
|
(let
|
|
((start (if (and (< i n) (= (char-at s i) "<")) (+ i 1) i)))
|
|
(js-strip-fn-name-end s start n))))
|
|
|
|
;; ── String coercion (ToString) ────────────────────────────────────
|
|
|
|
(define
|
|
js-strip-fn-name-end
|
|
(fn
|
|
(s start n)
|
|
(let
|
|
((end (js-find-paren-or-space s start n)))
|
|
(let ((name (js-string-slice s start end))) (js-unmap-fn-name name)))))
|
|
|
|
(define
|
|
js-find-paren-or-space
|
|
(fn
|
|
(s i n)
|
|
(cond
|
|
((>= i n) n)
|
|
((or (= (char-at s i) "(") (= (char-at s i) " ")) i)
|
|
(else (js-find-paren-or-space s (+ i 1) n)))))
|
|
|
|
;; ── Arithmetic (JS rules) ─────────────────────────────────────────
|
|
|
|
;; JS `+`: if either operand is a string → string concat, else numeric.
|
|
(define
|
|
js-unmap-fn-name
|
|
(fn
|
|
(name)
|
|
(cond
|
|
((= name "js-math-abs") "abs")
|
|
((= name "js-math-floor") "floor")
|
|
((= name "js-math-ceil") "ceil")
|
|
((= name "js-math-round") "round")
|
|
((= name "js-math-max") "max")
|
|
((= name "js-math-min") "min")
|
|
((= name "js-math-random") "random")
|
|
((= name "js-math-sqrt") "sqrt")
|
|
((= name "js-math-pow") "pow")
|
|
((= name "js-math-trunc") "trunc")
|
|
((= name "js-math-sign") "sign")
|
|
((= name "js-math-cbrt") "cbrt")
|
|
((= name "js-math-hypot") "hypot")
|
|
((= name "js-math-sin") "sin")
|
|
((= name "js-math-cos") "cos")
|
|
((= name "js-math-tan") "tan")
|
|
((= name "js-math-asin") "asin")
|
|
((= name "js-math-acos") "acos")
|
|
((= name "js-math-atan") "atan")
|
|
((= name "js-math-atan2") "atan2")
|
|
((= name "js-math-sinh") "sinh")
|
|
((= name "js-math-cosh") "cosh")
|
|
((= name "js-math-tanh") "tanh")
|
|
((= name "js-math-asinh") "asinh")
|
|
((= name "js-math-acosh") "acosh")
|
|
((= name "js-math-atanh") "atanh")
|
|
((= name "js-math-exp") "exp")
|
|
((= name "js-math-log") "log")
|
|
((= name "js-math-log2") "log2")
|
|
((= name "js-math-log10") "log10")
|
|
((= name "js-math-expm1") "expm1")
|
|
((= name "js-math-log1p") "log1p")
|
|
((= name "js-math-clz32") "clz32")
|
|
((= name "js-math-imul") "imul")
|
|
((= name "js-math-fround") "fround")
|
|
((= name "js-number-is-finite") "isFinite")
|
|
((= name "js-number-is-nan") "isNaN")
|
|
((= name "js-number-is-integer") "isInteger")
|
|
((= name "js-number-is-safe-integer") "isSafeInteger")
|
|
((= name "js-global-is-finite") "isFinite")
|
|
((= name "js-global-is-nan") "isNaN")
|
|
((= name "js-string-from-char-code") "fromCharCode")
|
|
((= name "js-array-is-array") "isArray")
|
|
((= name "js-array-of") "of")
|
|
((= name "js-array-from") "from")
|
|
((= name "js-object-keys") "keys")
|
|
((= name "js-object-values") "values")
|
|
((= name "js-object-entries") "entries")
|
|
((= name "js-object-assign") "assign")
|
|
((= name "js-object-freeze") "freeze")
|
|
((= name "js-object-get-prototype-of") "getPrototypeOf")
|
|
((= name "js-object-set-prototype-of") "setPrototypeOf")
|
|
((= name "js-object-create") "create")
|
|
((= name "js-object-define-property") "defineProperty")
|
|
((= name "js-object-define-properties") "defineProperties")
|
|
((= name "js-object-get-own-property-names") "getOwnPropertyNames")
|
|
((= name "js-object-get-own-property-descriptor")
|
|
"getOwnPropertyDescriptor")
|
|
((= name "js-object-get-own-property-descriptors")
|
|
"getOwnPropertyDescriptors")
|
|
((= name "js-object-is-extensible") "isExtensible")
|
|
((= name "js-object-is-frozen") "isFrozen")
|
|
((= name "js-object-is-sealed") "isSealed")
|
|
((= name "js-object-seal") "seal")
|
|
((= name "js-object-prevent-extensions") "preventExtensions")
|
|
((= name "js-object-is") "is")
|
|
((= name "js-object-from-entries") "fromEntries")
|
|
((= name "js-object-has-own") "hasOwn")
|
|
((= name "js-to-number") "Number")
|
|
((= name "js-to-boolean") "Boolean")
|
|
(else name))))
|
|
|
|
(define
|
|
js-count-real-params
|
|
(fn
|
|
(params)
|
|
(cond
|
|
((empty? params) 0)
|
|
(else
|
|
(let
|
|
((first (first params)))
|
|
(if
|
|
(= first "&rest")
|
|
0
|
|
(+ 1 (js-count-real-params (rest params)))))))))
|
|
|
|
(define
|
|
js-coerce-this-arg
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((js-undefined? v) js-global-this)
|
|
((= v nil) js-global-this)
|
|
((or (= (type-of v) "number") (= (type-of v) "rational"))
|
|
(js-new-call Number (js-args v)))
|
|
((= (type-of v) "string") (js-new-call String (js-args v)))
|
|
((= (type-of v) "boolean") (js-new-call Boolean (js-args v)))
|
|
(else v))))
|
|
|
|
(define
|
|
js-call-this-coerce
|
|
(fn
|
|
(recv v)
|
|
(cond
|
|
((or (= (type-of recv) "lambda") (= (type-of recv) "component"))
|
|
(js-coerce-this-arg v))
|
|
(else v))))
|
|
|
|
(define
|
|
js-invoke-function-method
|
|
(fn
|
|
(recv key args)
|
|
(cond
|
|
((= key "call")
|
|
(let
|
|
((raw-this (if (< (len args) 1) :js-undefined (nth args 0)))
|
|
(rest
|
|
(if
|
|
(< (len args) 1)
|
|
(list)
|
|
(js-list-slice args 1 (len args)))))
|
|
(js-call-with-this (js-call-this-coerce recv raw-this) recv rest)))
|
|
((= key "apply")
|
|
(let
|
|
((raw-this (if (< (len args) 1) :js-undefined (nth args 0)))
|
|
(arr
|
|
(if (< (len args) 2) (list) (nth args 1))))
|
|
(let
|
|
((rest (cond ((= arr nil) (list)) ((js-undefined? arr) (list)) ((list? arr) arr) (else (js-iterable-to-list arr)))))
|
|
(js-call-with-this (js-call-this-coerce recv raw-this) recv rest))))
|
|
((= key "bind")
|
|
(cond
|
|
((not (js-function? recv))
|
|
(raise (js-new-call TypeError (js-args "Function.prototype.bind: target is not callable"))))
|
|
(else
|
|
(let
|
|
((this-arg (if (< (len args) 1) :js-undefined (nth args 0)))
|
|
(bound
|
|
(if
|
|
(< (len args) 1)
|
|
(list)
|
|
(js-list-slice args 1 (len args)))))
|
|
(let
|
|
((target-len (js-fn-length recv)))
|
|
(let
|
|
((bound-len
|
|
(let ((d (- target-len (len bound))))
|
|
(if (< d 0) 0 d))))
|
|
{:__callable__
|
|
(fn
|
|
(&rest more)
|
|
(js-call-with-this this-arg recv (js-list-concat bound more)))
|
|
:length bound-len
|
|
:name "bound"
|
|
:__js_bound_target__ recv}))))))
|
|
((= key "toString")
|
|
(let
|
|
((override (js-dict-get-walk (get js-function-global "prototype") "toString")))
|
|
(if
|
|
(= (type-of override) "lambda")
|
|
(js-call-with-this recv override args)
|
|
"function () { [native code] }")))
|
|
((= key "name") (js-extract-fn-name recv))
|
|
((= key "length") (js-fn-length recv))
|
|
(else :js-undefined))))
|
|
|
|
(define
|
|
js-invoke-function-bound
|
|
(fn
|
|
(recv key)
|
|
(cond
|
|
((= key "call")
|
|
(fn (&rest args) (js-invoke-function-method recv "call" args)))
|
|
((= key "apply")
|
|
(fn (&rest args) (js-invoke-function-method recv "apply" args)))
|
|
((= key "bind")
|
|
(fn (&rest args) (js-invoke-function-method recv "bind" args)))
|
|
(else :js-undefined))))
|
|
|
|
(define
|
|
js-invoke-number-method
|
|
(fn
|
|
(recv key args)
|
|
(cond
|
|
((= key "toString")
|
|
(let
|
|
((radix (if (empty? args) 10 (nth args 0))))
|
|
(js-num-to-str-radix
|
|
recv
|
|
(if
|
|
(or (= radix nil) (js-undefined? radix))
|
|
10
|
|
(js-to-number radix)))))
|
|
((= key "toFixed")
|
|
(js-number-to-fixed
|
|
recv
|
|
(if (empty? args) 0 (js-to-number (nth args 0)))))
|
|
((= key "valueOf") recv)
|
|
((= key "toLocaleString") (js-to-string recv))
|
|
((= key "toPrecision") (js-to-string recv))
|
|
((= key "toExponential") (js-to-string recv))
|
|
(else
|
|
(let
|
|
((m (js-dict-get-walk (get Number "prototype") (js-to-string key))))
|
|
(cond
|
|
((js-undefined? m)
|
|
(error
|
|
(str
|
|
"TypeError: "
|
|
(js-to-string key)
|
|
" is not a function (on number)")))
|
|
(else (js-call-with-this recv m args))))))))
|
|
|
|
(define
|
|
js-invoke-function-objproto
|
|
(fn
|
|
(recv key args)
|
|
(cond
|
|
((= key "hasOwnProperty")
|
|
(let
|
|
((k (if (empty? args) "" (js-to-string (nth args 0)))))
|
|
(or (= k "name") (= k "length") (= k "prototype"))))
|
|
((= key "toString") "function () { [native code] }")
|
|
((= key "valueOf") recv)
|
|
((= key "isPrototypeOf") false)
|
|
((= key "propertyIsEnumerable") false)
|
|
((= key "toLocaleString") "function () { [native code] }")
|
|
(else :js-undefined))))
|
|
|
|
(define
|
|
js-invoke-boolean-method
|
|
(fn
|
|
(recv key args)
|
|
(cond
|
|
((= key "toString") (if recv "true" "false"))
|
|
((= key "valueOf") recv)
|
|
(else
|
|
(let
|
|
((m (js-dict-get-walk (get Boolean "prototype") (js-to-string key))))
|
|
(cond
|
|
((js-undefined? m)
|
|
(error
|
|
(str
|
|
"TypeError: "
|
|
(js-to-string key)
|
|
" is not a function (on boolean)")))
|
|
(else (js-call-with-this recv m args))))))))
|
|
|
|
(define
|
|
js-num-to-str-radix
|
|
(fn
|
|
(n radix)
|
|
(cond
|
|
((and (number? n) (js-number-is-nan n)) "NaN")
|
|
((= n (js-infinity-value)) "Infinity")
|
|
((= n (- 0 (js-infinity-value))) "-Infinity")
|
|
((or (= radix 10) (= radix nil) (js-undefined? radix))
|
|
(js-to-string n))
|
|
(else
|
|
(let
|
|
((int-n (js-math-trunc n)))
|
|
(if
|
|
(< int-n 0)
|
|
(str "-" (js-num-to-str-radix-rec (- 0 int-n) radix ""))
|
|
(js-num-to-str-radix-rec int-n radix "")))))))
|
|
|
|
;; Bitwise + logical-not
|
|
(define
|
|
js-num-to-str-radix-rec
|
|
(fn
|
|
(n radix acc)
|
|
(if
|
|
(= n 0)
|
|
(if (= acc "") "0" acc)
|
|
(let
|
|
((d (mod n radix)) (rest (js-math-trunc (/ n radix))))
|
|
(js-num-to-str-radix-rec rest radix (str (js-digit-char d) acc))))))
|
|
|
|
(define
|
|
js-digit-char
|
|
(fn
|
|
(d)
|
|
(cond
|
|
((< d 10) (js-to-string d))
|
|
(else
|
|
(let
|
|
((offset (+ 97 (- d 10))))
|
|
(js-code-to-char offset))))))
|
|
|
|
;; ── Equality ──────────────────────────────────────────────────────
|
|
|
|
;; Strict equality (===): no coercion; js-undefined matches js-undefined.
|
|
(define
|
|
js-number-to-fixed
|
|
(fn
|
|
(n digits)
|
|
(cond
|
|
((js-number-is-nan n) "NaN")
|
|
((= n (js-infinity-value)) "Infinity")
|
|
((= n (- 0 (js-infinity-value))) "-Infinity")
|
|
(else
|
|
(let
|
|
((d (js-math-trunc digits)))
|
|
(if
|
|
(< d 1)
|
|
(js-to-string (js-math-round n))
|
|
(let
|
|
((scale (js-pow-int 10 d)))
|
|
(let
|
|
((scaled (js-math-round (* n scale))))
|
|
(let
|
|
((abs-scaled (if (< scaled 0) (- 0 scaled) scaled))
|
|
(sign (if (< scaled 0) "-" "")))
|
|
(let
|
|
((int-part (js-math-trunc (/ abs-scaled scale)))
|
|
(frac-part
|
|
(-
|
|
abs-scaled
|
|
(* (js-math-trunc (/ abs-scaled scale)) scale))))
|
|
(str
|
|
sign
|
|
(js-to-string int-part)
|
|
"."
|
|
(js-pad-int-str
|
|
(js-to-string (js-math-trunc frac-part))
|
|
d))))))))))))
|
|
|
|
(define
|
|
js-pow-int
|
|
(fn
|
|
(b e)
|
|
(if (<= e 0) 1 (* b (js-pow-int b (- e 1))))))
|
|
|
|
;; Abstract equality (==): type coercion rules.
|
|
;; Simplified: number↔string coerce both to number; null == undefined;
|
|
;; everything else falls back to strict equality.
|
|
(define
|
|
js-pad-int-str
|
|
(fn (s n) (if (>= (len s) n) s (js-pad-int-str (str "0" s) n))))
|
|
|
|
(define
|
|
js-apply-fn
|
|
(fn
|
|
(fn-val args)
|
|
(let
|
|
((callable (if (and (dict? fn-val) (contains? (keys fn-val) "__callable__")) (get fn-val "__callable__") fn-val)))
|
|
(if
|
|
(not (js-function? callable))
|
|
(raise
|
|
(js-new-call
|
|
TypeError
|
|
(list (str (type-of fn-val) " is not a function"))))
|
|
(cond
|
|
((= (len args) 0) (callable))
|
|
((= (len args) 1) (callable (nth args 0)))
|
|
((= (len args) 2)
|
|
(callable (nth args 0) (nth args 1)))
|
|
((= (len args) 3)
|
|
(callable
|
|
(nth args 0)
|
|
(nth args 1)
|
|
(nth args 2)))
|
|
((= (len args) 4)
|
|
(callable
|
|
(nth args 0)
|
|
(nth args 1)
|
|
(nth args 2)
|
|
(nth args 3)))
|
|
((= (len args) 5)
|
|
(callable
|
|
(nth args 0)
|
|
(nth args 1)
|
|
(nth args 2)
|
|
(nth args 3)
|
|
(nth args 4)))
|
|
((= (len args) 6)
|
|
(callable
|
|
(nth args 0)
|
|
(nth args 1)
|
|
(nth args 2)
|
|
(nth args 3)
|
|
(nth args 4)
|
|
(nth args 5)))
|
|
(else (apply callable args)))))))
|
|
|
|
;; ── Relational comparisons ────────────────────────────────────────
|
|
|
|
;; Abstract relational comparison from ES5.
|
|
;; Numbers compare numerically; two strings compare lexicographically;
|
|
;; mixed types coerce both to numbers.
|
|
(define
|
|
js-invoke-method
|
|
(fn
|
|
(recv key args)
|
|
(cond
|
|
((and (js-promise? recv) (js-promise-builtin-method? key))
|
|
(js-invoke-promise-method recv key args))
|
|
((js-regex? recv) (js-regex-invoke-method recv key args))
|
|
((number? recv) (js-invoke-number-method recv key args))
|
|
((boolean? recv) (js-invoke-boolean-method recv key args))
|
|
(else
|
|
(let
|
|
((m (js-get-prop recv key)))
|
|
(cond
|
|
((not (js-undefined? m)) (js-call-with-this recv m args))
|
|
((and (js-function? recv) (js-function-method? key))
|
|
(js-invoke-function-method recv key args))
|
|
((and (js-function? recv) (not (= (type-of recv) "dict")) (js-object-builtin-method? key))
|
|
(js-invoke-function-objproto recv key args))
|
|
((and (= (type-of recv) "dict") (js-object-builtin-method? key))
|
|
(js-invoke-object-method recv key args))
|
|
(else
|
|
(error
|
|
(str "TypeError: " (js-to-string key) " is not a function")))))))))
|
|
|
|
(define
|
|
js-object-builtin-method?
|
|
(fn
|
|
(name)
|
|
(or
|
|
(= name "hasOwnProperty")
|
|
(= name "isPrototypeOf")
|
|
(= name "propertyIsEnumerable")
|
|
(= name "toString")
|
|
(= name "valueOf")
|
|
(= name "toLocaleString"))))
|
|
|
|
(define
|
|
js-invoke-object-method
|
|
(fn
|
|
(recv name args)
|
|
(cond
|
|
((= name "hasOwnProperty")
|
|
(if
|
|
(= (len args) 0)
|
|
false
|
|
(contains? (keys recv) (js-to-string (nth args 0)))))
|
|
((= name "isPrototypeOf") false)
|
|
((= name "propertyIsEnumerable")
|
|
(if
|
|
(= (len args) 0)
|
|
false
|
|
(contains? (keys recv) (js-to-string (nth args 0)))))
|
|
((= name "toString") "[object Object]")
|
|
((= name "valueOf") recv)
|
|
((= name "toLocaleString") "[object Object]")
|
|
(else js-undefined))))
|
|
|
|
(define js-upper-case (fn (s) (js-case-loop s 0 "" true)))
|
|
|
|
(define js-lower-case (fn (s) (js-case-loop s 0 "" false)))
|
|
|
|
(define
|
|
js-case-loop
|
|
(fn
|
|
(s i acc to-upper?)
|
|
(cond
|
|
((>= i (len s)) acc)
|
|
(else
|
|
(let
|
|
((c (char-at s i)))
|
|
(let
|
|
((cc (char-code c)))
|
|
(let
|
|
((cv (cond ((and to-upper? (>= cc 97) (<= cc 122)) (js-code-to-char (- cc 32))) ((and (not to-upper?) (>= cc 65) (<= cc 90)) (js-code-to-char (+ cc 32))) (else c))))
|
|
(js-case-loop s (+ i 1) (str acc cv) to-upper?))))))))
|
|
|
|
(define
|
|
js-code-to-char
|
|
(fn
|
|
(code)
|
|
(cond
|
|
((= code 65) "A")
|
|
((= code 66) "B")
|
|
((= code 67) "C")
|
|
((= code 68) "D")
|
|
((= code 69) "E")
|
|
((= code 70) "F")
|
|
((= code 71) "G")
|
|
((= code 72) "H")
|
|
((= code 73) "I")
|
|
((= code 74) "J")
|
|
((= code 75) "K")
|
|
((= code 76) "L")
|
|
((= code 77) "M")
|
|
((= code 78) "N")
|
|
((= code 79) "O")
|
|
((= code 80) "P")
|
|
((= code 81) "Q")
|
|
((= code 82) "R")
|
|
((= code 83) "S")
|
|
((= code 84) "T")
|
|
((= code 85) "U")
|
|
((= code 86) "V")
|
|
((= code 87) "W")
|
|
((= code 88) "X")
|
|
((= code 89) "Y")
|
|
((= code 90) "Z")
|
|
((= code 97) "a")
|
|
((= code 98) "b")
|
|
((= code 99) "c")
|
|
((= code 100) "d")
|
|
((= code 101) "e")
|
|
((= code 102) "f")
|
|
((= code 103) "g")
|
|
((= code 104) "h")
|
|
((= code 105) "i")
|
|
((= code 106) "j")
|
|
((= code 107) "k")
|
|
((= code 108) "l")
|
|
((= code 109) "m")
|
|
((= code 110) "n")
|
|
((= code 111) "o")
|
|
((= code 112) "p")
|
|
((= code 113) "q")
|
|
((= code 114) "r")
|
|
((= code 115) "s")
|
|
((= code 116) "t")
|
|
((= code 117) "u")
|
|
((= code 118) "v")
|
|
((= code 119) "w")
|
|
((= code 120) "x")
|
|
((= code 121) "y")
|
|
((= code 122) "z")
|
|
(else ""))))
|
|
|
|
;; ── Property access ───────────────────────────────────────────────
|
|
|
|
;; obj[key] or obj.key in JS. Handles:
|
|
;; • dicts keyed by string
|
|
;; • lists indexed by number (incl. .length)
|
|
;; • strings indexed by number (incl. .length)
|
|
;; Returns js-undefined if the key is absent.
|
|
(define
|
|
js-invoke-method-dyn
|
|
(fn (recv key args) (js-invoke-method recv key args)))
|
|
|
|
(define
|
|
js-call-plain
|
|
(fn
|
|
(fn-val args)
|
|
(cond
|
|
((js-undefined? fn-val)
|
|
(raise (js-new-call TypeError (list "undefined is not a function"))))
|
|
((and (dict? fn-val) (contains? (keys fn-val) "__callable__"))
|
|
(js-call-with-this :js-undefined (get fn-val "__callable__") args))
|
|
(else (js-call-with-this :js-undefined fn-val args)))))
|
|
|
|
(define
|
|
js-new-call
|
|
(fn
|
|
(ctor args)
|
|
(cond
|
|
((not (js-function? ctor))
|
|
(raise (js-new-call TypeError (list (str (type-of ctor) " is not a constructor")))))
|
|
(else
|
|
(let
|
|
((obj (dict)))
|
|
(begin
|
|
(dict-set! obj "__proto__" (js-get-ctor-proto ctor))
|
|
(let
|
|
((ret (js-call-with-this obj ctor args)))
|
|
(if
|
|
(and
|
|
(not (js-undefined? ret))
|
|
(or (= (type-of ret) "dict") (= (type-of ret) "list") (js-function? ret)))
|
|
ret
|
|
obj))))))))
|
|
|
|
;; Setter — mutates the dict. Returns the new value (JS assignment yields rhs).
|
|
(define
|
|
js-instanceof
|
|
(fn
|
|
(obj ctor)
|
|
(cond
|
|
((not (js-function? ctor))
|
|
(error "TypeError: Right-hand side of instanceof is not callable"))
|
|
((js-function? obj)
|
|
(let
|
|
((proto (js-get-ctor-proto ctor))
|
|
(fnproto (get js-function-global "prototype"))
|
|
(objproto (get Object "prototype")))
|
|
(cond
|
|
((= proto fnproto) true)
|
|
((= proto objproto) true)
|
|
((and (= (type-of obj) "dict") (contains? (keys obj) "__proto__"))
|
|
(js-instanceof-walk obj proto))
|
|
(else false))))
|
|
((list? obj)
|
|
(let
|
|
((proto (js-get-ctor-proto ctor))
|
|
(arrproto (get Array "prototype"))
|
|
(objproto (get Object "prototype")))
|
|
(cond
|
|
((= proto arrproto) true)
|
|
((= proto objproto) true)
|
|
(else false))))
|
|
((not (= (type-of obj) "dict")) false)
|
|
(else
|
|
(let
|
|
((proto (js-get-ctor-proto ctor)))
|
|
(js-instanceof-walk obj proto))))))
|
|
|
|
;; ── Short-circuit logical ops ─────────────────────────────────────
|
|
|
|
;; `a && b` in JS: if a is truthy return b else return a. The thunk
|
|
;; form defers evaluation of b — the transpiler passes (fn () b).
|
|
(define
|
|
js-instanceof-walk
|
|
(fn
|
|
(obj proto)
|
|
(cond
|
|
((not (= (type-of obj) "dict")) false)
|
|
((not (dict-has? obj "__proto__")) false)
|
|
(else
|
|
(let
|
|
((p (get obj "__proto__")))
|
|
(cond
|
|
((= p proto) true)
|
|
((not (= (type-of p) "dict")) false)
|
|
(else (js-instanceof-walk p proto))))))))
|
|
|
|
(define
|
|
js-in
|
|
(fn
|
|
(key obj)
|
|
(cond
|
|
((not (= (type-of obj) "dict")) false)
|
|
(else (js-in-walk obj (js-to-string key))))))
|
|
|
|
;; ── console.log ───────────────────────────────────────────────────
|
|
|
|
;; Trivial bridge. `log-info` is available on OCaml; fall back to print.
|
|
(define
|
|
js-in-walk
|
|
(fn
|
|
(obj skey)
|
|
(cond
|
|
((not (= (type-of obj) "dict")) false)
|
|
((dict-has? obj skey) true)
|
|
((dict-has? obj "__proto__") (js-in-walk (get obj "__proto__") skey))
|
|
(else false))))
|
|
|
|
(define
|
|
js-error-init!
|
|
(fn
|
|
(this name args)
|
|
(begin
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if (= (len args) 0) "" (js-to-string (nth args 0))))
|
|
(dict-set! this "name" name)
|
|
(dict-set! this "__js_error_data__" true)
|
|
this)))
|
|
|
|
(define
|
|
js-error-receiver
|
|
(fn
|
|
(ctor)
|
|
(let
|
|
((this (js-this)))
|
|
(cond
|
|
((= (type-of this) "dict") this)
|
|
(else (js-new-call ctor (list)))))))
|
|
|
|
(define
|
|
Error
|
|
(fn
|
|
(&rest args)
|
|
(js-error-init! (js-error-receiver Error) "Error" args)))
|
|
|
|
(define
|
|
js-error-is-error
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0) false)
|
|
(else
|
|
(let
|
|
((v (nth args 0)))
|
|
(and
|
|
(= (type-of v) "dict")
|
|
(or
|
|
(contains? (keys v) "__js_error_data__")
|
|
(js-error-proto-walk? v))))))))
|
|
|
|
(define
|
|
js-error-proto-walk?
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((not (= (type-of v) "dict")) false)
|
|
((contains? (keys v) "__js_error_data__") true)
|
|
((not (contains? (keys v) "__proto__")) false)
|
|
(else (js-error-proto-walk? (get v "__proto__"))))))
|
|
|
|
;; ── Math object ───────────────────────────────────────────────────
|
|
|
|
(define
|
|
TypeError
|
|
(fn (&rest args)
|
|
(js-error-init! (js-error-receiver TypeError) "TypeError" args)))
|
|
(define
|
|
RangeError
|
|
(fn (&rest args)
|
|
(js-error-init! (js-error-receiver RangeError) "RangeError" args)))
|
|
(define
|
|
SyntaxError
|
|
(fn (&rest args)
|
|
(js-error-init! (js-error-receiver SyntaxError) "SyntaxError" args)))
|
|
(define
|
|
ReferenceError
|
|
(fn (&rest args)
|
|
(js-error-init! (js-error-receiver ReferenceError) "ReferenceError" args)))
|
|
(define
|
|
URIError
|
|
(fn (&rest args)
|
|
(js-error-init! (js-error-receiver URIError) "URIError" args)))
|
|
(define
|
|
EvalError
|
|
(fn (&rest args)
|
|
(js-error-init! (js-error-receiver EvalError) "EvalError" args)))
|
|
|
|
(define AggregateError :js-undefined)
|
|
|
|
(define SuppressedError :js-undefined)
|
|
|
|
(define
|
|
RegExp
|
|
{:length 2
|
|
:name "RegExp"
|
|
:__callable__
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(let
|
|
((pattern-arg (if (= (len args) 0) "" (nth args 0)))
|
|
(flags-arg
|
|
(if (>= (len args) 2) (nth args 1) :js-undefined)))
|
|
(let
|
|
((src
|
|
(cond
|
|
((js-regex? pattern-arg) (get pattern-arg "source"))
|
|
((js-undefined? pattern-arg) "")
|
|
((= pattern-arg nil) "")
|
|
(else (js-to-string pattern-arg))))
|
|
(fl
|
|
(cond
|
|
((js-undefined? flags-arg)
|
|
(if (js-regex? pattern-arg) (get pattern-arg "flags") ""))
|
|
((= flags-arg nil) "")
|
|
(else (js-to-string flags-arg)))))
|
|
(let
|
|
((rx (js-regex-new src fl)))
|
|
(cond
|
|
((not (= (type-of this) "dict")) rx)
|
|
(else
|
|
(begin
|
|
(for-each
|
|
(fn (k) (dict-set! this k (get rx k)))
|
|
(keys rx))
|
|
this))))))))
|
|
:prototype
|
|
{:test
|
|
(fn (s)
|
|
(let ((rx (js-this)) (str (js-to-string s)))
|
|
(js-regex-stub-test rx str)))
|
|
:exec
|
|
(fn (s)
|
|
(let ((rx (js-this)) (str (js-to-string s)))
|
|
(js-regex-stub-exec rx str)))
|
|
:toString
|
|
(fn ()
|
|
(let ((rx (js-this)))
|
|
(str "/" (get rx "source") "/" (get rx "flags"))))
|
|
:compile
|
|
(fn (&rest args)
|
|
(let ((rx (js-this)))
|
|
(cond
|
|
((>= (len args) 1)
|
|
(let
|
|
((src (js-to-string (nth args 0)))
|
|
(fl (if (>= (len args) 2) (js-to-string (nth args 1)) "")))
|
|
(let
|
|
((rx2 (js-regex-new src fl)))
|
|
(begin
|
|
(for-each
|
|
(fn (k) (dict-set! rx k (get rx2 k)))
|
|
(keys rx2))
|
|
rx))))
|
|
(else rx))))}})
|
|
|
|
(define
|
|
js-str-startswith?
|
|
(fn
|
|
(s prefix)
|
|
(cond
|
|
((< (len s) (len prefix)) false)
|
|
(else (= (js-string-slice s 0 (len prefix)) prefix)))))
|
|
|
|
(define
|
|
js-wrap-exn
|
|
(fn
|
|
(e)
|
|
(cond
|
|
((not (= (type-of e) "string")) e)
|
|
((js-str-startswith? e "Undefined symbol:")
|
|
(js-new-call ReferenceError (js-args e)))
|
|
((js-str-startswith? e "TypeError:")
|
|
(js-new-call TypeError (js-args (js-string-slice e 11 (len e)))))
|
|
((js-str-startswith? e "RangeError:")
|
|
(js-new-call RangeError (js-args (js-string-slice e 12 (len e)))))
|
|
((js-str-startswith? e "SyntaxError:")
|
|
(js-new-call SyntaxError (js-args (js-string-slice e 13 (len e)))))
|
|
((js-str-startswith? e "ReferenceError:")
|
|
(js-new-call ReferenceError (js-args (js-string-slice e 16 (len e)))))
|
|
((js-str-startswith? e "URIError:")
|
|
(js-new-call URIError (js-args (js-string-slice e 10 (len e)))))
|
|
(else e))))
|
|
|
|
(define
|
|
js-date-time-value
|
|
(fn
|
|
(d)
|
|
(cond
|
|
((or (not (dict? d)) (not (contains? (keys d) "__js_is_date__")))
|
|
(raise (js-new-call TypeError (js-args "this is not a Date object"))))
|
|
(else (get d "__date_value__")))))
|
|
|
|
(define
|
|
js-date-getter
|
|
(fn
|
|
(d field)
|
|
(let
|
|
((ms-raw (js-date-time-value d)))
|
|
(let
|
|
((ms (if (= (type-of ms-raw) "rational") (exact->inexact ms-raw) ms-raw)))
|
|
(cond
|
|
((or (= ms nil) (js-undefined? ms) (not (number? ms)))
|
|
(js-nan-value))
|
|
((js-number-is-nan ms) (js-nan-value))
|
|
(else
|
|
(let
|
|
((days (floor (/ ms 86400000)))
|
|
(tod
|
|
(let ((m (modulo (js-num-to-int ms) 86400000)))
|
|
(if (< m 0) (+ m 86400000) m))))
|
|
(cond
|
|
((= field "ms") (modulo tod 1000))
|
|
((= field "seconds") (js-math-trunc (/ (modulo tod 60000) 1000)))
|
|
((= field "minutes") (js-math-trunc (/ (modulo tod 3600000) 60000)))
|
|
((= field "hours") (js-math-trunc (/ tod 3600000)))
|
|
((= field "day")
|
|
(let ((dow (modulo (+ days 4) 7)))
|
|
(if (< dow 0) (+ dow 7) dow)))
|
|
(else
|
|
(let ((ymd (js-date-days-to-ymd days)))
|
|
(cond
|
|
((= field "year") (nth ymd 0))
|
|
((= field "month") (- (nth ymd 1) 1))
|
|
((= field "date") (nth ymd 2))
|
|
(else (js-nan-value)))))))))))))
|
|
|
|
(define
|
|
js-date-from-one
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((number? v) v)
|
|
((= (type-of v) "string") (js-date-parse-string v))
|
|
(else 0))))
|
|
|
|
(define
|
|
js-date-parse-string
|
|
(fn
|
|
(s)
|
|
(cond
|
|
((>= (len s) 4)
|
|
(let
|
|
((year-part (js-string-slice s 0 4)))
|
|
(cond
|
|
((js-is-numeric-string? year-part)
|
|
(let
|
|
((y (js-num-to-int (js-string-to-number year-part))))
|
|
(* (- y 1970) 31557600000)))
|
|
(else 0))))
|
|
(else 0))))
|
|
|
|
(define
|
|
js-date-from-parts
|
|
(fn
|
|
(args)
|
|
(let
|
|
((year-raw (js-num-to-int (js-to-number (nth args 0)))))
|
|
(let
|
|
((year (if (and (>= year-raw 0) (<= year-raw 99)) (+ year-raw 1900) year-raw))
|
|
(month
|
|
(if (>= (len args) 2) (js-num-to-int (js-to-number (nth args 1))) 0))
|
|
(day
|
|
(if (>= (len args) 3) (js-num-to-int (js-to-number (nth args 2))) 1))
|
|
(hour
|
|
(if (>= (len args) 4) (js-num-to-int (js-to-number (nth args 3))) 0))
|
|
(mins
|
|
(if (>= (len args) 5) (js-num-to-int (js-to-number (nth args 4))) 0))
|
|
(secs
|
|
(if (>= (len args) 6) (js-num-to-int (js-to-number (nth args 5))) 0))
|
|
(ms
|
|
(if (>= (len args) 7) (js-num-to-int (js-to-number (nth args 6))) 0)))
|
|
(let
|
|
((days (js-date-civil-to-days year (+ month 1) day)))
|
|
(+
|
|
(* days 86400000)
|
|
(* hour 3600000)
|
|
(* mins 60000)
|
|
(* secs 1000)
|
|
ms))))))
|
|
|
|
(define
|
|
js-date-civil-to-days
|
|
(fn
|
|
(y m d)
|
|
(let
|
|
((y2 (if (<= m 2) (- y 1) y)))
|
|
(let
|
|
((era (if (>= y2 0) (js-math-trunc (/ y2 400)) (js-math-trunc (/ (- y2 399) 400)))))
|
|
(let
|
|
((yoe (- y2 (* era 400))))
|
|
(let
|
|
((doy
|
|
(+
|
|
(js-math-trunc (/ (+ (* 153 (if (> m 2) (- m 3) (+ m 9))) 2) 5))
|
|
(- d 1))))
|
|
(let
|
|
((doe
|
|
(+
|
|
(* yoe 365)
|
|
(+
|
|
(- (js-math-trunc (/ yoe 4)) (js-math-trunc (/ yoe 100)))
|
|
doy))))
|
|
(+ (* era 146097) (- doe 719468)))))))))
|
|
|
|
(define
|
|
js-date-format-now
|
|
(fn () "[Date stub]"))
|
|
|
|
(define
|
|
js-date-pad2
|
|
(fn (n) (if (< n 10) (str "0" (js-to-string n)) (js-to-string n))))
|
|
|
|
(define
|
|
js-date-pad3
|
|
(fn
|
|
(n)
|
|
(cond
|
|
((< n 10) (str "00" (js-to-string n)))
|
|
((< n 100) (str "0" (js-to-string n)))
|
|
(else (js-to-string n)))))
|
|
|
|
(define
|
|
Date
|
|
{:length 7
|
|
:name "Date"
|
|
:__callable__
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(cond
|
|
((not (= (type-of this) "dict")) (js-date-format-now))
|
|
(else
|
|
(begin
|
|
(dict-set!
|
|
this
|
|
"__date_value__"
|
|
(cond
|
|
((= (len args) 0) 0)
|
|
((= (len args) 1) (js-date-from-one (nth args 0)))
|
|
(else (js-date-from-parts args))))
|
|
(dict-set! this "__js_is_date__" true)
|
|
this)))))
|
|
:now (fn () 0)
|
|
:parse (fn (s) (js-date-parse-string (js-to-string s)))
|
|
:UTC
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0) 0)
|
|
(else (js-date-from-parts args))))
|
|
:prototype
|
|
{:getTime (fn () (js-date-time-value (js-this)))
|
|
:valueOf (fn () (js-date-time-value (js-this)))
|
|
:getFullYear (fn () (js-date-getter (js-this) "year"))
|
|
:getUTCFullYear (fn () (js-date-getter (js-this) "year"))
|
|
:getMonth (fn () (js-date-getter (js-this) "month"))
|
|
:getUTCMonth (fn () (js-date-getter (js-this) "month"))
|
|
:getDate (fn () (js-date-getter (js-this) "date"))
|
|
:getUTCDate (fn () (js-date-getter (js-this) "date"))
|
|
:getDay (fn () (js-date-getter (js-this) "day"))
|
|
:getUTCDay (fn () (js-date-getter (js-this) "day"))
|
|
:getHours (fn () (js-date-getter (js-this) "hours"))
|
|
:getUTCHours (fn () (js-date-getter (js-this) "hours"))
|
|
:getMinutes (fn () (js-date-getter (js-this) "minutes"))
|
|
:getUTCMinutes (fn () (js-date-getter (js-this) "minutes"))
|
|
:getSeconds (fn () (js-date-getter (js-this) "seconds"))
|
|
:getUTCSeconds (fn () (js-date-getter (js-this) "seconds"))
|
|
:getMilliseconds (fn () (js-date-getter (js-this) "ms"))
|
|
:getUTCMilliseconds (fn () (js-date-getter (js-this) "ms"))
|
|
:getTimezoneOffset (fn () 0)
|
|
:setTime
|
|
(fn (v)
|
|
(let ((t (js-this)))
|
|
(begin (dict-set! t "__date_value__" v) v)))
|
|
:toISOString (fn () (js-date-iso (js-this)))
|
|
:toJSON (fn () (js-date-iso (js-this)))
|
|
:toString (fn () (js-date-iso (js-this)))
|
|
:toUTCString (fn () (js-date-iso (js-this)))
|
|
:toDateString (fn () (js-date-iso (js-this)))
|
|
:toTimeString (fn () "00:00:00 GMT+0000")
|
|
:toLocaleString (fn () (js-date-iso (js-this)))
|
|
:toLocaleDateString (fn () (js-date-iso (js-this)))
|
|
:toLocaleTimeString (fn () "00:00:00")}})
|
|
|
|
(define
|
|
js-date-iso
|
|
(fn
|
|
(d)
|
|
(cond
|
|
((or (not (dict? d)) (not (contains? (keys d) "__js_is_date__")))
|
|
(raise (js-new-call TypeError (js-args "this is not a Date object"))))
|
|
(else
|
|
(let
|
|
((ms-raw (get d "__date_value__")))
|
|
(let
|
|
((ms (if (= (type-of ms-raw) "rational") (exact->inexact ms-raw) ms-raw)))
|
|
(cond
|
|
((or (= ms nil) (js-undefined? ms))
|
|
(raise (js-new-call RangeError (js-args "Invalid time value"))))
|
|
((not (number? ms))
|
|
(raise (js-new-call RangeError (js-args "Invalid time value"))))
|
|
((js-number-is-nan ms)
|
|
(raise (js-new-call RangeError (js-args "Invalid time value"))))
|
|
((or (> ms 8640000000000000) (< ms -8640000000000000))
|
|
(raise (js-new-call RangeError (js-args "Invalid time value"))))
|
|
(else (js-date-iso-format ms)))))))))
|
|
|
|
(define
|
|
js-date-iso-format
|
|
(fn
|
|
(ms)
|
|
(let
|
|
((day-ms 86400000) (sec-ms 1000) (min-ms 60000) (hr-ms 3600000))
|
|
(let
|
|
((days (floor (/ ms day-ms)))
|
|
(time-of-day
|
|
(let ((m (modulo (js-num-to-int ms) day-ms)))
|
|
(if (< m 0) (+ m day-ms) m))))
|
|
(let
|
|
((hh (js-math-trunc (/ time-of-day hr-ms)))
|
|
(mm (js-math-trunc (/ (modulo time-of-day hr-ms) min-ms)))
|
|
(ss (js-math-trunc (/ (modulo time-of-day min-ms) sec-ms)))
|
|
(msec (modulo time-of-day sec-ms))
|
|
(ymd (js-date-days-to-ymd days)))
|
|
(let
|
|
((y (nth ymd 0)) (mo (nth ymd 1)) (d (nth ymd 2)))
|
|
(str
|
|
(js-date-iso-year y)
|
|
"-"
|
|
(js-pad2 mo)
|
|
"-"
|
|
(js-pad2 d)
|
|
"T"
|
|
(js-pad2 hh)
|
|
":"
|
|
(js-pad2 mm)
|
|
":"
|
|
(js-pad2 ss)
|
|
"."
|
|
(js-pad3 msec)
|
|
"Z")))))))
|
|
|
|
(define
|
|
js-date-iso-year
|
|
(fn
|
|
(y)
|
|
(cond
|
|
((or (< y 0) (> y 9999))
|
|
(let
|
|
((sign (if (< y 0) "-" "+"))
|
|
(ay (if (< y 0) (- 0 y) y)))
|
|
(str sign (js-date-year-6 ay))))
|
|
((< y 10) (str "000" (js-to-string y)))
|
|
((< y 100) (str "00" (js-to-string y)))
|
|
((< y 1000) (str "0" (js-to-string y)))
|
|
(else (js-to-string y)))))
|
|
|
|
(define
|
|
js-date-year-6
|
|
(fn
|
|
(y)
|
|
(cond
|
|
((< y 10) (str "00000" (js-to-string y)))
|
|
((< y 100) (str "0000" (js-to-string y)))
|
|
((< y 1000) (str "000" (js-to-string y)))
|
|
((< y 10000) (str "00" (js-to-string y)))
|
|
((< y 100000) (str "0" (js-to-string y)))
|
|
(else (js-to-string y)))))
|
|
|
|
(define js-pad2 (fn (n) (if (< n 10) (str "0" (js-to-string n)) (js-to-string n))))
|
|
|
|
(define
|
|
js-pad3
|
|
(fn
|
|
(n)
|
|
(cond
|
|
((< n 10) (str "00" (js-to-string n)))
|
|
((< n 100) (str "0" (js-to-string n)))
|
|
(else (js-to-string n)))))
|
|
|
|
(define
|
|
js-date-days-to-ymd
|
|
(fn
|
|
(days-since-epoch)
|
|
(let
|
|
((d (+ days-since-epoch 719468)))
|
|
(let
|
|
((era (if (>= d 0) (js-math-trunc (/ d 146097)) (js-math-trunc (/ (- d 146096) 146097)))))
|
|
(let
|
|
((doe (- d (* era 146097))))
|
|
(let
|
|
((yoe
|
|
(js-math-trunc
|
|
(/
|
|
(-
|
|
(+
|
|
(- doe (js-math-trunc (/ doe 1460)))
|
|
(js-math-trunc (/ doe 36524)))
|
|
(js-math-trunc (/ doe 146096)))
|
|
365))))
|
|
(let
|
|
((y (+ yoe (* era 400)))
|
|
(doy
|
|
(-
|
|
doe
|
|
(+
|
|
(* yoe 365)
|
|
(-
|
|
(js-math-trunc (/ yoe 4))
|
|
(js-math-trunc (/ yoe 100)))))))
|
|
(let
|
|
((mp (js-math-trunc (/ (+ (* 5 doy) 2) 153))))
|
|
(let
|
|
((day (- (+ doy 1) (js-math-trunc (/ (+ (* 153 mp) 2) 5))))
|
|
(month (if (< mp 10) (+ mp 3) (- mp 9))))
|
|
(list
|
|
(if (<= month 2) (+ y 1) y)
|
|
month
|
|
day))))))))))
|
|
|
|
(define
|
|
js-date-year-pad
|
|
(fn
|
|
(y)
|
|
(cond
|
|
((>= y 0)
|
|
(cond
|
|
((< y 10) (str "000" (js-to-string y)))
|
|
((< y 100) (str "00" (js-to-string y)))
|
|
((< y 1000) (str "0" (js-to-string y)))
|
|
(else (js-to-string y))))
|
|
(else (str "-" (js-date-year-pad (- 0 y)))))))
|
|
(define
|
|
js-function?
|
|
(fn
|
|
(v)
|
|
(let
|
|
((t (type-of v)))
|
|
(or
|
|
(= t "lambda")
|
|
(= t "function")
|
|
(= t "component")
|
|
(and (= t "dict") (contains? (keys v) "__callable__"))))))
|
|
(define __js_proto_table__ (dict))
|
|
(define __js_next_id__ (dict)) ; deterministic placeholder for tests
|
|
|
|
(dict-set! __js_next_id__ "n" 0)
|
|
|
|
;; The global object — lookup table for JS names that aren't in the
|
|
;; SX env. Transpiled idents look up locally first; globals here are a
|
|
;; fallback, but most slice programs reference `console`, `Math`,
|
|
;; `undefined` as plain symbols, which we bind as defines above.
|
|
(define
|
|
js-get-ctor-proto
|
|
(fn
|
|
(ctor)
|
|
(cond
|
|
((and (= (type-of ctor) "dict") (contains? (keys ctor) "prototype"))
|
|
(get ctor "prototype"))
|
|
(else
|
|
(let
|
|
((id (js-ctor-id ctor)))
|
|
(cond
|
|
((dict-has? __js_proto_table__ id) (get __js_proto_table__ id))
|
|
(else
|
|
(let
|
|
((p (dict)))
|
|
(begin (dict-set! __js_proto_table__ id p) p)))))))))
|
|
|
|
(define
|
|
js-reset-ctor-proto!
|
|
(fn
|
|
(ctor)
|
|
(let
|
|
((id (js-ctor-id ctor)) (p (dict)))
|
|
(begin (dict-set! __js_proto_table__ id p) p))))
|
|
|
|
(define
|
|
js-set-ctor-proto!
|
|
(fn
|
|
(ctor proto)
|
|
(let ((id (js-ctor-id ctor))) (dict-set! __js_proto_table__ id proto))))
|
|
|
|
(define
|
|
js-ctor-id
|
|
(fn
|
|
(ctor)
|
|
(cond
|
|
((and (= (type-of ctor) "dict") (dict-has? ctor "__ctor_id__"))
|
|
(get ctor "__ctor_id__"))
|
|
(else (inspect ctor)))))
|
|
|
|
(define
|
|
js-typeof
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((js-undefined? v) "undefined")
|
|
((= v nil) "object")
|
|
((= (type-of v) "boolean") "boolean")
|
|
((= (type-of v) "number") "number")
|
|
((= (type-of v) "rational") "number")
|
|
((= (type-of v) "string") "string")
|
|
((= (type-of v) "lambda") "function")
|
|
((= (type-of v) "function") "function")
|
|
((= (type-of v) "component") "function")
|
|
((and (= (type-of v) "dict") (contains? (keys v) "__callable__"))
|
|
"function")
|
|
(else "object"))))
|
|
|
|
(define
|
|
js-object-tostring-class
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((js-undefined? v) "[object Undefined]")
|
|
((= v nil) "[object Null]")
|
|
((= (type-of v) "list") "[object Array]")
|
|
((= (type-of v) "string") "[object String]")
|
|
((= (type-of v) "number") "[object Number]")
|
|
((= (type-of v) "rational") "[object Number]")
|
|
((= (type-of v) "boolean") "[object Boolean]")
|
|
((or (= (type-of v) "lambda") (= (type-of v) "function") (= (type-of v) "component"))
|
|
"[object Function]")
|
|
((= (type-of v) "dict")
|
|
(cond
|
|
((contains? (keys v) "__callable__") "[object Function]")
|
|
((contains? (keys v) "__js_string_value__") "[object String]")
|
|
((contains? (keys v) "__js_number_value__") "[object Number]")
|
|
((contains? (keys v) "__js_boolean_value__") "[object Boolean]")
|
|
((contains? (keys v) "__js_error_data__") "[object Error]")
|
|
((contains? (keys v) "__js_is_date__") "[object Date]")
|
|
((contains? (keys v) "__map_keys__") "[object Map]")
|
|
((contains? (keys v) "__set_items__") "[object Set]")
|
|
((= v (get Number "prototype")) "[object Number]")
|
|
((= v (get String "prototype")) "[object String]")
|
|
((= v (get Boolean "prototype")) "[object Boolean]")
|
|
((= v (get Array "prototype")) "[object Array]")
|
|
(else "[object Object]")))
|
|
(else "[object Object]"))))
|
|
|
|
(define
|
|
js-to-boolean
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((js-undefined? v) false)
|
|
((= v nil) false)
|
|
((= v false) false)
|
|
((= v 0) false)
|
|
((and (= (type-of v) "number") (js-number-is-nan v)) false)
|
|
((= v "") false)
|
|
(else true))))
|
|
|
|
(define
|
|
js-to-number
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((js-undefined? v) (js-nan-value))
|
|
((= v nil) 0)
|
|
((= v true) 1)
|
|
((= v false) 0)
|
|
((= (type-of v) "number") v)
|
|
((= (type-of v) "rational") (exact->inexact v))
|
|
((= (type-of v) "string") (js-string-to-number v))
|
|
((or (= (type-of v) "lambda") (= (type-of v) "function") (= (type-of v) "component"))
|
|
(js-nan-value))
|
|
((= (type-of v) "list") (if (= (len v) 0) 0 (if (= (len v) 1) (js-to-number (nth v 0)) (js-nan-value))))
|
|
((= (type-of v) "dict")
|
|
(cond
|
|
((contains? (keys v) "__js_number_value__")
|
|
(get v "__js_number_value__"))
|
|
((contains? (keys v) "__js_boolean_value__")
|
|
(if (get v "__js_boolean_value__") 1 0))
|
|
((contains? (keys v) "__js_string_value__")
|
|
(js-string-to-number (get v "__js_string_value__")))
|
|
(else
|
|
(let
|
|
((valueof-fn (js-get-prop v "valueOf")))
|
|
(if
|
|
(= (type-of valueof-fn) "lambda")
|
|
(let
|
|
((result (js-call-with-this v valueof-fn ())))
|
|
(if
|
|
(and (not (= (type-of result) "dict")) (not (js-function? result)))
|
|
(js-to-number result)
|
|
(let
|
|
((tostr-fn (js-get-prop v "toString")))
|
|
(if
|
|
(= (type-of tostr-fn) "lambda")
|
|
(let
|
|
((result2 (js-call-with-this v tostr-fn ())))
|
|
(if
|
|
(and (not (= (type-of result2) "dict")) (not (js-function? result2)))
|
|
(js-to-number result2)
|
|
(raise (js-new-call TypeError (list "Cannot convert object to primitive value")))))
|
|
(js-nan-value)))))
|
|
(js-nan-value))))))
|
|
(else 0))))
|
|
|
|
(define
|
|
js-string-to-number
|
|
(fn
|
|
(s)
|
|
(let
|
|
((trimmed (js-trim s)))
|
|
(cond
|
|
((= trimmed "") 0)
|
|
((= trimmed "Infinity") (js-infinity-value))
|
|
((= trimmed "+Infinity") (js-infinity-value))
|
|
((= trimmed "-Infinity") (- 0 (js-infinity-value)))
|
|
((js-is-numeric-string? trimmed) (js-parse-num-safe trimmed))
|
|
(else (js-nan-value))))))
|
|
|
|
(define
|
|
js-is-numeric-string?
|
|
(fn
|
|
(s)
|
|
(if
|
|
(js-hex-prefix? s)
|
|
(js-is-hex-body? s 2 (len s))
|
|
(js-is-numeric-loop s 0 false false false))))
|
|
|
|
(define
|
|
js-is-hex-body?
|
|
(fn
|
|
(s i n)
|
|
(cond
|
|
((>= i n) (> n 2))
|
|
((>= (js-hex-digit-value (char-at s i)) 0)
|
|
(js-is-hex-body? s (+ i 1) n))
|
|
(else false))))
|
|
|
|
(define
|
|
js-is-numeric-loop
|
|
(fn
|
|
(s i sawdigit sawdot sawe)
|
|
(cond
|
|
((>= i (len s)) sawdigit)
|
|
(else
|
|
(let
|
|
((c (char-at s i)))
|
|
(cond
|
|
((or (= c "0") (= c "1") (= c "2") (= c "3") (= c "4") (= c "5") (= c "6") (= c "7") (= c "8") (= c "9"))
|
|
(js-is-numeric-loop s (+ i 1) true sawdot sawe))
|
|
((and (= c ".") (not sawdot) (not sawe))
|
|
(js-is-numeric-loop s (+ i 1) sawdigit true sawe))
|
|
((and (or (= c "e") (= c "E")) sawdigit (not sawe))
|
|
(js-is-numeric-loop s (+ i 1) false sawdot true))
|
|
((and (or (= c "+") (= c "-")) (= i 0))
|
|
(js-is-numeric-loop s (+ i 1) sawdigit sawdot sawe))
|
|
((and (or (= c "+") (= c "-")) sawe (= i (- (len s) 1)))
|
|
false)
|
|
((and (or (= c "+") (= c "-")) sawe)
|
|
(let
|
|
((prev (char-at s (- i 1))))
|
|
(if
|
|
(or (= prev "e") (= prev "E"))
|
|
(js-is-numeric-loop s (+ i 1) sawdigit sawdot sawe)
|
|
false)))
|
|
(else false)))))))
|
|
|
|
(define js-parse-num-safe (fn (s) (cond (else (js-num-from-string s)))))
|
|
|
|
(define
|
|
js-find-exp-char
|
|
(fn (s) (js-find-exp-char-loop s 0 (len s))))
|
|
|
|
(define
|
|
js-find-exp-char-loop
|
|
(fn
|
|
(s i n)
|
|
(cond
|
|
((>= i n) -1)
|
|
((or (= (char-at s i) "e") (= (char-at s i) "E")) i)
|
|
(else (js-find-exp-char-loop s (+ i 1) n)))))
|
|
|
|
(define
|
|
js-pow-int
|
|
(fn
|
|
(base exp)
|
|
(cond
|
|
((= exp 0) 1)
|
|
((> exp 0) (* base (js-pow-int base (- exp 1))))
|
|
(else (/ 1 (js-pow-int base (- 0 exp)))))))
|
|
|
|
(define
|
|
js-hex-prefix?
|
|
(fn
|
|
(s)
|
|
(and
|
|
(>= (len s) 2)
|
|
(= (char-at s 0) "0")
|
|
(or (= (char-at s 1) "x") (= (char-at s 1) "X")))))
|
|
|
|
(define
|
|
js-parse-hex
|
|
(fn
|
|
(s i acc)
|
|
(cond
|
|
((>= i (len s)) acc)
|
|
(else
|
|
(let
|
|
((c (char-at s i)) (d (js-hex-digit-value (char-at s i))))
|
|
(cond
|
|
((< d 0) (js-nan-value))
|
|
(else
|
|
(js-parse-hex s (+ i 1) (+ (* acc 16) d)))))))))
|
|
|
|
(define
|
|
js-hex-digit-value
|
|
(fn
|
|
(c)
|
|
(cond
|
|
((= c "0") 0)
|
|
((= c "1") 1)
|
|
((= c "2") 2)
|
|
((= c "3") 3)
|
|
((= c "4") 4)
|
|
((= c "5") 5)
|
|
((= c "6") 6)
|
|
((= c "7") 7)
|
|
((= c "8") 8)
|
|
((= c "9") 9)
|
|
((or (= c "a") (= c "A")) 10)
|
|
((or (= c "b") (= c "B")) 11)
|
|
((or (= c "c") (= c "C")) 12)
|
|
((or (= c "d") (= c "D")) 13)
|
|
((or (= c "e") (= c "E")) 14)
|
|
((or (= c "f") (= c "F")) 15)
|
|
(else -1))))
|
|
|
|
(define
|
|
js-num-from-string
|
|
(fn
|
|
(s)
|
|
(let
|
|
((trimmed (js-trim s)))
|
|
(cond
|
|
((= trimmed "") 0)
|
|
((js-hex-prefix? trimmed)
|
|
(js-parse-hex trimmed 2 0))
|
|
(else
|
|
(let
|
|
((esplit (js-find-exp-char trimmed)))
|
|
(if
|
|
(>= esplit 0)
|
|
(let
|
|
((parsed (string->number trimmed)))
|
|
(if
|
|
(= parsed nil)
|
|
(let
|
|
((mant (js-string-slice trimmed 0 esplit))
|
|
(expstr
|
|
(js-string-slice
|
|
trimmed
|
|
(+ esplit 1)
|
|
(len trimmed))))
|
|
(let
|
|
((m (js-parse-decimal mant 0 0 1 false 0))
|
|
(e
|
|
(js-parse-decimal
|
|
expstr
|
|
0
|
|
0
|
|
1
|
|
false
|
|
0)))
|
|
(* m (pow 10 e))))
|
|
parsed))
|
|
(js-parse-decimal
|
|
trimmed
|
|
0
|
|
0
|
|
1
|
|
false
|
|
0))))))))
|
|
|
|
(define js-args (fn (&rest args) args))
|
|
|
|
(define
|
|
js-make-list
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((r (list)))
|
|
(begin
|
|
(for-each (fn (x) (append! r x)) args)
|
|
r))))
|
|
|
|
(define js-trim (fn (s) (js-trim-left (js-trim-right s))))
|
|
|
|
(define
|
|
js-trim-left
|
|
(fn (s) (let ((n (len s))) (js-trim-left-at s n 0))))
|
|
|
|
(define
|
|
js-trim-left-at
|
|
(fn
|
|
(s n i)
|
|
(cond
|
|
((>= i n) "")
|
|
((js-is-space? (char-at s i)) (js-trim-left-at s n (+ i 1)))
|
|
(else (substr s i n)))))
|
|
|
|
(define
|
|
js-trim-right
|
|
(fn (s) (let ((n (len s))) (js-trim-right-at s n))))
|
|
|
|
(define
|
|
js-trim-right-at
|
|
(fn
|
|
(s n)
|
|
(cond
|
|
((<= n 0) "")
|
|
((js-is-space? (char-at s (- n 1)))
|
|
(js-trim-right-at s (- n 1)))
|
|
(else (substr s 0 n)))))
|
|
|
|
(define
|
|
js-is-space?
|
|
(fn
|
|
(c)
|
|
(let
|
|
((cc (char-code c)))
|
|
(or
|
|
(= cc 9)
|
|
(= cc 10)
|
|
(= cc 11)
|
|
(= cc 12)
|
|
(= cc 13)
|
|
(= cc 32)
|
|
(= cc 160)
|
|
(= cc 5760)
|
|
(and (>= cc 8192) (<= cc 8202))
|
|
(= cc 8232)
|
|
(= cc 8233)
|
|
(= cc 8239)
|
|
(= cc 8287)
|
|
(= cc 12288)
|
|
(= cc 65279)))))
|
|
|
|
(define
|
|
js-parse-decimal
|
|
(fn
|
|
(s i acc sign frac? fdiv)
|
|
(let
|
|
((n (len s)))
|
|
(cond
|
|
((>= i n) (* sign (if frac? (/ acc fdiv) acc)))
|
|
((and (= i 0) (= (char-at s 0) "-"))
|
|
(js-parse-decimal
|
|
s
|
|
1
|
|
0
|
|
-1
|
|
false
|
|
0))
|
|
((and (= i 0) (= (char-at s 0) "+"))
|
|
(js-parse-decimal
|
|
s
|
|
1
|
|
0
|
|
1
|
|
false
|
|
0))
|
|
((= (char-at s i) ".")
|
|
(js-parse-decimal s (+ i 1) acc sign true 1))
|
|
((js-is-digit? (char-at s i))
|
|
(if
|
|
frac?
|
|
(js-parse-decimal
|
|
s
|
|
(+ i 1)
|
|
(+ (* acc 10) (js-digit-val (char-at s i)))
|
|
sign
|
|
true
|
|
(* fdiv 10))
|
|
(js-parse-decimal
|
|
s
|
|
(+ i 1)
|
|
(+ (* acc 10) (js-digit-val (char-at s i)))
|
|
sign
|
|
false
|
|
0)))
|
|
(else (* sign (if frac? (/ acc fdiv) acc)))))))
|
|
|
|
(define
|
|
js-is-digit?
|
|
(fn
|
|
(c)
|
|
(and
|
|
(or
|
|
(= c "0")
|
|
(= c "1")
|
|
(= c "2")
|
|
(= c "3")
|
|
(= c "4")
|
|
(= c "5")
|
|
(= c "6")
|
|
(= c "7")
|
|
(= c "8")
|
|
(= c "9")))))
|
|
|
|
(define
|
|
js-digit-val
|
|
(fn
|
|
(c)
|
|
(cond
|
|
((= c "0") 0)
|
|
((= c "1") 1)
|
|
((= c "2") 2)
|
|
((= c "3") 3)
|
|
((= c "4") 4)
|
|
((= c "5") 5)
|
|
((= c "6") 6)
|
|
((= c "7") 7)
|
|
((= c "8") 8)
|
|
((= c "9") 9)
|
|
(else 0))))
|
|
|
|
(define
|
|
js-to-string
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((js-undefined? v) "undefined")
|
|
((= v nil) "null")
|
|
((= v true) "true")
|
|
((= v false) "false")
|
|
((= (type-of v) "string") v)
|
|
((= (type-of v) "number") (js-number-to-string v))
|
|
((= (type-of v) "rational") (js-number-to-string (exact->inexact v)))
|
|
(else
|
|
(if
|
|
(= (type-of v) "dict")
|
|
(cond
|
|
((contains? (keys v) "__js_string_value__")
|
|
(get v "__js_string_value__"))
|
|
((contains? (keys v) "__js_number_value__")
|
|
(js-number-to-string (get v "__js_number_value__")))
|
|
((contains? (keys v) "__js_boolean_value__")
|
|
(if (get v "__js_boolean_value__") "true" "false"))
|
|
(else
|
|
(let
|
|
((tostr-fn (js-get-prop v "toString")))
|
|
(if
|
|
(= (type-of tostr-fn) "lambda")
|
|
(let
|
|
((result (js-call-with-this v tostr-fn ())))
|
|
(if
|
|
(or (= (type-of result) "dict") (js-function? result))
|
|
(let
|
|
((valueof-fn (js-get-prop v "valueOf")))
|
|
(if
|
|
(= (type-of valueof-fn) "lambda")
|
|
(let
|
|
((result2 (js-call-with-this v valueof-fn ())))
|
|
(if
|
|
(or (= (type-of result2) "dict") (js-function? result2))
|
|
(raise
|
|
(js-new-call
|
|
TypeError
|
|
(list
|
|
"Cannot convert object to primitive value")))
|
|
(js-to-string result2)))
|
|
"[object Object]"))
|
|
(js-to-string result)))
|
|
"[object Object]"))))
|
|
(cond
|
|
((= (type-of v) "list")
|
|
(let
|
|
((tostr-fn (js-dict-get-walk (get Array "prototype") "toString")))
|
|
(if
|
|
(= (type-of tostr-fn) "lambda")
|
|
(let
|
|
((result (js-call-with-this v tostr-fn ())))
|
|
(if (= (type-of result) "string") result (js-list-join v ",")))
|
|
(js-list-join v ","))))
|
|
((js-function? v)
|
|
(let
|
|
((tostr-fn (js-dict-get-walk (get js-function-global "prototype") "toString")))
|
|
(if
|
|
(= (type-of tostr-fn) "lambda")
|
|
(let
|
|
((result (js-call-with-this v tostr-fn ())))
|
|
(if (= (type-of result) "string") result "function () { [native code] }"))
|
|
"function () { [native code] }")))
|
|
(else (str v))))))))
|
|
|
|
(define
|
|
js-template-concat
|
|
(fn (&rest parts) (js-template-concat-loop parts 0 "")))
|
|
|
|
(define
|
|
js-template-concat-loop
|
|
(fn
|
|
(parts i acc)
|
|
(if
|
|
(>= i (len parts))
|
|
acc
|
|
(js-template-concat-loop
|
|
parts
|
|
(+ i 1)
|
|
(str acc (js-to-string (nth parts i)))))))
|
|
|
|
(define
|
|
js-big-int-str-loop
|
|
(fn
|
|
(n acc)
|
|
(if
|
|
(< n 1)
|
|
(if (= acc "") "0" acc)
|
|
(let
|
|
((d (floor (- n (* 10 (floor (/ n 10)))))))
|
|
(js-big-int-str-loop
|
|
(floor (/ n 10))
|
|
(str (js-string-slice "0123456789" d (+ d 1)) acc))))))
|
|
|
|
(define
|
|
js-find-decimal-k
|
|
(fn
|
|
(n k)
|
|
(if
|
|
(> k 17)
|
|
17
|
|
(let
|
|
((big-int (round (* n (js-pow-int 10 k)))))
|
|
(if
|
|
(= (/ big-int (js-pow-int 10 k)) n)
|
|
k
|
|
(js-find-decimal-k n (+ k 1)))))))
|
|
|
|
(define
|
|
js-format-decimal-digits
|
|
(fn
|
|
(digits k)
|
|
(if
|
|
(= k 0)
|
|
digits
|
|
(let
|
|
((dlen (len digits)))
|
|
(if
|
|
(> dlen k)
|
|
(str
|
|
(js-string-slice digits 0 (- dlen k))
|
|
"."
|
|
(js-string-slice digits (- dlen k) dlen))
|
|
(if
|
|
(= dlen k)
|
|
(str "0." digits)
|
|
(str "0." (js-string-repeat "0" (- k dlen)) digits)))))))
|
|
|
|
(define
|
|
js-expand-sci-notation
|
|
(fn
|
|
(mant exp-n)
|
|
(let
|
|
((di (js-string-index-of mant "." 0)))
|
|
(let
|
|
((int-part (if (< di 0) mant (js-string-slice mant 0 di)))
|
|
(frac-part
|
|
(if
|
|
(< di 0)
|
|
""
|
|
(js-string-slice mant (+ di 1) (len mant)))))
|
|
(let
|
|
((all-digits (str int-part frac-part))
|
|
(frac-len
|
|
(if
|
|
(< di 0)
|
|
0
|
|
(- (- (len mant) di) 1))))
|
|
(if
|
|
(>= exp-n 0)
|
|
(if
|
|
(>= exp-n frac-len)
|
|
(str all-digits (js-string-repeat "0" (- exp-n frac-len)))
|
|
(let
|
|
((dot-pos (+ (len int-part) exp-n)))
|
|
(str
|
|
(js-string-slice all-digits 0 dot-pos)
|
|
"."
|
|
(js-string-slice all-digits dot-pos (len all-digits)))))
|
|
(str
|
|
"0."
|
|
(js-string-repeat "0" (- (- 0 exp-n) 1))
|
|
all-digits)))))))
|
|
|
|
(define
|
|
js-number-to-string
|
|
(fn
|
|
(n)
|
|
(cond
|
|
((js-number-is-nan n) "NaN")
|
|
((= n (js-infinity-value)) "Infinity")
|
|
((= n (- 0 (js-infinity-value))) "-Infinity")
|
|
(else
|
|
(let
|
|
((pos-n (if (< n 0) (- 0 n) n)))
|
|
(let
|
|
((s0 (js-normalize-num-str (str pos-n))))
|
|
(let
|
|
((n2 (js-to-number s0)))
|
|
(let
|
|
((precise (if (= n2 pos-n) (let ((ei (js-string-index-of s0 "e" 0))) (if (< ei 0) s0 (let ((exp-n (js-to-number (js-string-slice s0 (+ ei 1) (len s0))))) (if (and (>= exp-n -6) (<= exp-n 20)) (js-expand-sci-notation (js-string-slice s0 0 ei) exp-n) (if (>= exp-n 0) (str (js-string-slice s0 0 (+ ei 1)) "+" (str exp-n)) s0))))) (if (and (>= pos-n 1e-06) (< pos-n 1e+21)) (let ((k (js-find-decimal-k pos-n 0))) (let ((big-int (round (* pos-n (js-pow-int 10 k))))) (js-format-decimal-digits (js-big-int-str-loop big-int "") k))) (let ((ei (js-string-index-of s0 "e" 0))) (if (< ei 0) s0 (let ((exp-n (js-to-number (js-string-slice s0 (+ ei 1) (len s0))))) (if (>= exp-n 0) (str (js-string-slice s0 0 (+ ei 1)) "+" (str exp-n)) s0))))))))
|
|
(if (< n 0) (str "-" precise) precise)))))))))
|
|
|
|
(define
|
|
js-normalize-num-str
|
|
(fn
|
|
(s)
|
|
(let
|
|
((ei (js-find-exp-char s)))
|
|
(if
|
|
(< ei 0)
|
|
s
|
|
(let
|
|
((mant (js-string-slice s 0 ei))
|
|
(expraw (js-string-slice s (+ ei 1) (len s))))
|
|
(str mant "e" (js-strip-leading-zeros expraw)))))))
|
|
|
|
(define
|
|
js-strip-leading-zeros
|
|
(fn
|
|
(s)
|
|
(let
|
|
((sign-and-body (js-split-sign s)))
|
|
(let
|
|
((sign (nth sign-and-body 0))
|
|
(body (nth sign-and-body 1)))
|
|
(let
|
|
((stripped (js-strip-zeros-loop body 0 (len body))))
|
|
(if (= stripped "") (str sign "0") (str sign stripped)))))))
|
|
|
|
(define
|
|
js-split-sign
|
|
(fn
|
|
(s)
|
|
(cond
|
|
((= s "") (list "" ""))
|
|
((= (char-at s 0) "-")
|
|
(list "-" (js-string-slice s 1 (len s))))
|
|
((= (char-at s 0) "+")
|
|
(list "" (js-string-slice s 1 (len s))))
|
|
(else (list "" s)))))
|
|
|
|
(define
|
|
js-strip-zeros-loop
|
|
(fn
|
|
(s i n)
|
|
(cond
|
|
((>= i n) "")
|
|
((= (char-at s i) "0") (js-strip-zeros-loop s (+ i 1) n))
|
|
(else (js-string-slice s i n)))))
|
|
|
|
(define
|
|
js-add-unwrap
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((or (= (type-of v) "lambda") (= (type-of v) "function") (= (type-of v) "component"))
|
|
(let ((s (js-to-string v))) s))
|
|
((not (= (type-of v) "dict")) v)
|
|
((contains? (keys v) "__js_string_value__")
|
|
(get v "__js_string_value__"))
|
|
((contains? (keys v) "__js_number_value__")
|
|
(get v "__js_number_value__"))
|
|
((contains? (keys v) "__js_boolean_value__")
|
|
(get v "__js_boolean_value__"))
|
|
((contains? (keys v) "__js_is_date__")
|
|
(js-add-call-method v "toString"))
|
|
(else (js-add-toprim-default v)))))
|
|
|
|
(define
|
|
js-add-toprim-default
|
|
(fn
|
|
(v)
|
|
(let
|
|
((via-valueof (js-add-call-method v "valueOf")))
|
|
(cond
|
|
((not (= (type-of via-valueof) "dict")) via-valueof)
|
|
(else (js-add-call-method v "toString"))))))
|
|
|
|
(define
|
|
js-add-call-method
|
|
(fn
|
|
(v name)
|
|
(let
|
|
((m (js-dict-get-walk v name)))
|
|
(cond
|
|
((js-undefined? m) v)
|
|
((not (js-function? m)) v)
|
|
(else (js-call-with-this v m (list)))))))
|
|
|
|
(define
|
|
js-add
|
|
(fn
|
|
(a b)
|
|
(let
|
|
((ap (js-add-unwrap a)) (bp (js-add-unwrap b)))
|
|
(cond
|
|
((or (= (type-of ap) "string") (= (type-of bp) "string"))
|
|
(str (js-to-string ap) (js-to-string bp)))
|
|
(else (+ (js-to-number ap) (js-to-number bp)))))))
|
|
|
|
(define js-sub (fn (a b) (- (js-to-number a) (js-to-number b))))
|
|
|
|
(define js-mul (fn (a b) (* (js-to-number a) (js-to-number b))))
|
|
|
|
(define
|
|
js-div
|
|
(fn (a b) (/ (js-to-number a) (exact->inexact (js-to-number b)))))
|
|
|
|
(define js-mod (fn (a b) (mod (js-to-number a) (js-to-number b))))
|
|
|
|
(define
|
|
js-unsigned-rshift
|
|
(fn
|
|
(l r)
|
|
(let
|
|
((lu32 (modulo (js-math-trunc (js-to-number l)) 4294967296))
|
|
(shift (modulo (js-math-trunc (js-to-number r)) 32)))
|
|
(floor (/ lu32 (js-math-pow 2 shift))))))
|
|
|
|
(define
|
|
js-to-uint32
|
|
(fn (n) (modulo (js-math-trunc (js-to-number n)) 4294967296)))
|
|
|
|
(define
|
|
js-uint32-to-int32
|
|
(fn (u) (if (>= u 2147483648) (- u 4294967296) u)))
|
|
|
|
(define js-to-int32 (fn (n) (js-uint32-to-int32 (js-to-uint32 n))))
|
|
|
|
(define
|
|
js-bitwise-loop
|
|
(fn
|
|
(op au bu i acc bit)
|
|
(if
|
|
(>= i 32)
|
|
acc
|
|
(let
|
|
((abit (modulo (floor (/ au bit)) 2))
|
|
(bbit (modulo (floor (/ bu bit)) 2)))
|
|
(let
|
|
((rbit
|
|
(cond
|
|
((= op "and") (* abit bbit))
|
|
((= op "or") (if (or (= abit 1) (= bbit 1)) 1 0))
|
|
((= op "xor") (if (= abit bbit) 0 1))
|
|
(else 0))))
|
|
(js-bitwise-loop
|
|
op au bu (+ i 1) (+ acc (* rbit bit)) (* bit 2)))))))
|
|
|
|
(define
|
|
js-bitwise-binop
|
|
(fn
|
|
(op a b)
|
|
(js-uint32-to-int32
|
|
(js-bitwise-loop op (js-to-uint32 a) (js-to-uint32 b) 0 0 1))))
|
|
|
|
(define js-bitand (fn (a b) (js-bitwise-binop "and" a b)))
|
|
|
|
(define js-bitor (fn (a b) (js-bitwise-binop "or" a b)))
|
|
|
|
(define js-bitxor (fn (a b) (js-bitwise-binop "xor" a b)))
|
|
|
|
(define
|
|
js-shl
|
|
(fn
|
|
(a b)
|
|
(let
|
|
((au (js-to-uint32 a))
|
|
(sh (modulo (js-math-trunc (js-to-number b)) 32)))
|
|
(js-uint32-to-int32 (modulo (* au (js-math-pow 2 sh)) 4294967296)))))
|
|
|
|
(define
|
|
js-shr
|
|
(fn
|
|
(a b)
|
|
(let
|
|
((ai (js-to-int32 a))
|
|
(sh (modulo (js-math-trunc (js-to-number b)) 32)))
|
|
(if (= sh 0) ai (floor (/ ai (js-math-pow 2 sh)))))))
|
|
|
|
(define
|
|
js-pow-spec
|
|
(fn
|
|
(b e)
|
|
(let
|
|
((bn (js-to-number b)) (en (js-to-number e)))
|
|
(let
|
|
((inf (js-infinity-value)) (abs-b (if (< bn 0) (- 0 bn) bn)))
|
|
(cond
|
|
((js-number-is-nan en) (js-nan-value))
|
|
((= en 0) 1)
|
|
((js-number-is-nan bn) (js-nan-value))
|
|
((and (= abs-b 1) (or (= en inf) (= en (- 0 inf))))
|
|
(js-nan-value))
|
|
(else (pow bn en)))))))
|
|
|
|
(define js-pow (fn (a b) (js-pow-spec a b)))
|
|
|
|
(define js-neg (fn (a) (* -1 (exact->inexact (js-to-number a)))))
|
|
|
|
(define js-pos (fn (a) (js-to-number a)))
|
|
|
|
(define js-not (fn (a) (not (js-to-boolean a))))
|
|
|
|
(define
|
|
js-bitnot
|
|
(fn (a) (- 0 (+ (js-num-to-int (js-to-number a)) 1))))
|
|
|
|
(define
|
|
js-numeric-type?
|
|
(fn (v) (or (= (type-of v) "number") (= (type-of v) "rational"))))
|
|
|
|
(define
|
|
js-numeric-norm
|
|
(fn (v) (if (= (type-of v) "rational") (exact->inexact v) v)))
|
|
|
|
(define
|
|
js-strict-eq
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((and (js-undefined? a) (js-undefined? b)) true)
|
|
((or (js-undefined? a) (js-undefined? b)) false)
|
|
((and (js-numeric-type? a) (js-numeric-type? b))
|
|
(let
|
|
((an (js-numeric-norm a)) (bn (js-numeric-norm b)))
|
|
(if (or (js-number-is-nan an) (js-number-is-nan bn)) false (= an bn))))
|
|
((not (= (type-of a) (type-of b))) false)
|
|
(else
|
|
(if (or (js-number-is-nan a) (js-number-is-nan b)) false (= a b))))))
|
|
|
|
(define js-strict-neq (fn (a b) (not (js-strict-eq a b))))
|
|
|
|
(define
|
|
js-loose-eq
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((js-strict-eq a b) true)
|
|
((and (= a nil) (js-undefined? b)) true)
|
|
((and (js-undefined? a) (= b nil)) true)
|
|
((and (js-numeric-type? a) (= (type-of b) "string"))
|
|
(let ((an (js-numeric-norm a)) (bn (js-to-number b)))
|
|
(cond
|
|
((or (js-number-is-nan an) (js-number-is-nan bn)) false)
|
|
(else (= an bn)))))
|
|
((and (= (type-of a) "string") (js-numeric-type? b))
|
|
(let ((an (js-to-number a)) (bn (js-numeric-norm b)))
|
|
(cond
|
|
((or (js-number-is-nan an) (js-number-is-nan bn)) false)
|
|
(else (= an bn)))))
|
|
((= (type-of a) "boolean") (js-loose-eq (js-to-number a) b))
|
|
((= (type-of b) "boolean") (js-loose-eq a (js-to-number b)))
|
|
((and (dict? a) (contains? (keys a) "__js_string_value__"))
|
|
(js-loose-eq (get a "__js_string_value__") b))
|
|
((and (dict? b) (contains? (keys b) "__js_string_value__"))
|
|
(js-loose-eq a (get b "__js_string_value__")))
|
|
((and (dict? a) (contains? (keys a) "__js_number_value__"))
|
|
(js-loose-eq (get a "__js_number_value__") b))
|
|
((and (dict? b) (contains? (keys b) "__js_number_value__"))
|
|
(js-loose-eq a (get b "__js_number_value__")))
|
|
((and (dict? a) (contains? (keys a) "__js_boolean_value__"))
|
|
(js-loose-eq (get a "__js_boolean_value__") b))
|
|
((and (dict? b) (contains? (keys b) "__js_boolean_value__"))
|
|
(js-loose-eq a (get b "__js_boolean_value__")))
|
|
(else false))))
|
|
|
|
(define js-loose-neq (fn (a b) (not (js-loose-eq a b))))
|
|
|
|
(define
|
|
js-lt
|
|
(fn
|
|
(a b)
|
|
(let
|
|
((ap (js-add-unwrap a)) (bp (js-add-unwrap b)))
|
|
(cond
|
|
((and (= (type-of ap) "string") (= (type-of bp) "string"))
|
|
(js-str-lt ap bp))
|
|
(else
|
|
(let
|
|
((an (js-to-number ap)) (bn (js-to-number bp)))
|
|
(cond
|
|
((or (js-number-is-nan an) (js-number-is-nan bn)) false)
|
|
(else (< an bn)))))))))
|
|
|
|
(define js-gt (fn (a b) (js-lt b a)))
|
|
|
|
(define
|
|
js-le
|
|
(fn
|
|
(a b)
|
|
(let
|
|
((ap (js-add-unwrap a)) (bp (js-add-unwrap b)))
|
|
(cond
|
|
((and (= (type-of ap) "string") (= (type-of bp) "string"))
|
|
(or (js-str-lt ap bp) (= ap bp)))
|
|
(else
|
|
(let
|
|
((an (js-to-number ap)) (bn (js-to-number bp)))
|
|
(cond
|
|
((or (js-number-is-nan an) (js-number-is-nan bn)) false)
|
|
(else (<= an bn)))))))))
|
|
|
|
(define js-ge (fn (a b) (js-le b a)))
|
|
|
|
(define
|
|
js-str-lt
|
|
(fn (a b) (js-str-lt-at a b 0 (len a) (len b))))
|
|
|
|
(define
|
|
js-str-lt-at
|
|
(fn
|
|
(a b i la lb)
|
|
(cond
|
|
((and (>= i la) (>= i lb)) false)
|
|
((>= i la) true)
|
|
((>= i lb) false)
|
|
((< (char-code-at a i) (char-code-at b i)) true)
|
|
((> (char-code-at a i) (char-code-at b i)) false)
|
|
(else (js-str-lt-at a b (+ i 1) la lb)))))
|
|
|
|
(define char-code-at (fn (s i) (char-code (char-at s i))))
|
|
|
|
(define
|
|
js-array-method
|
|
(fn
|
|
(arr name)
|
|
(cond
|
|
((= name "push")
|
|
(fn
|
|
(&rest args)
|
|
(begin (for-each (fn (x) (append! arr x)) args) (len arr))))
|
|
((= name "pop")
|
|
(fn
|
|
()
|
|
(if
|
|
(= (len arr) 0)
|
|
js-undefined
|
|
(let
|
|
((v (nth arr (- (len arr) 1))))
|
|
(begin (pop-last! arr) v)))))
|
|
((= name "shift")
|
|
(fn
|
|
()
|
|
(if
|
|
(= (len arr) 0)
|
|
js-undefined
|
|
(let ((v (nth arr 0))) (begin (pop-first! arr) v)))))
|
|
((= name "slice")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((start (if (= (len args) 0) 0 (js-num-to-int (nth args 0))))
|
|
(stop
|
|
(if
|
|
(< (len args) 2)
|
|
(len arr)
|
|
(js-num-to-int (nth args 1)))))
|
|
(js-list-slice arr start stop))))
|
|
((= name "indexOf")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(= (len args) 0)
|
|
-1
|
|
(js-list-index-of
|
|
arr
|
|
(nth args 0)
|
|
(if
|
|
(< (len args) 2)
|
|
0
|
|
(js-num-to-int (nth args 1)))))))
|
|
((= name "join")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((sep (if (= (len args) 0) "," (js-to-string (nth args 0)))))
|
|
(js-list-join arr sep))))
|
|
((= name "concat") (fn (&rest args) (js-list-concat arr args)))
|
|
((= name "map")
|
|
(fn (&rest args)
|
|
(let
|
|
((f (if (empty? args) :js-undefined (nth args 0)))
|
|
(this-arg
|
|
(cond
|
|
((< (len args) 2) js-global-this)
|
|
((js-undefined? (nth args 1)) js-global-this)
|
|
((= (nth args 1) nil) js-global-this)
|
|
(else (nth args 1)))))
|
|
(js-list-map-loop f arr this-arg 0 (list)))))
|
|
((= name "filter")
|
|
(fn (&rest args)
|
|
(let
|
|
((f (if (empty? args) :js-undefined (nth args 0)))
|
|
(this-arg
|
|
(cond
|
|
((< (len args) 2) js-global-this)
|
|
((js-undefined? (nth args 1)) js-global-this)
|
|
((= (nth args 1) nil) js-global-this)
|
|
(else (nth args 1)))))
|
|
(js-list-filter-loop f arr this-arg 0 (list)))))
|
|
((= name "forEach")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((f (if (empty? args) :js-undefined (nth args 0)))
|
|
(this-arg
|
|
(cond
|
|
((< (len args) 2) js-global-this)
|
|
((js-undefined? (nth args 1)) js-global-this)
|
|
((= (nth args 1) nil) js-global-this)
|
|
(else (nth args 1)))))
|
|
(begin (js-list-foreach-loop f arr this-arg 0) js-undefined))))
|
|
((= name "reduce")
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 1)
|
|
(if
|
|
(= (len arr) 0)
|
|
(error "Reduce of empty array with no initial value")
|
|
(js-list-reduce-loop
|
|
(nth args 0)
|
|
(nth arr 0)
|
|
arr
|
|
1)))
|
|
(else
|
|
(js-list-reduce-loop
|
|
(nth args 0)
|
|
(nth args 1)
|
|
arr
|
|
0)))))
|
|
((= name "includes")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(= (len args) 0)
|
|
false
|
|
(>=
|
|
(js-list-index-of arr (nth args 0) 0)
|
|
0))))
|
|
((= name "find")
|
|
(fn (&rest args)
|
|
(let
|
|
((f (if (empty? args) :js-undefined (nth args 0)))
|
|
(this-arg
|
|
(cond
|
|
((< (len args) 2) js-global-this)
|
|
((js-undefined? (nth args 1)) js-global-this)
|
|
((= (nth args 1) nil) js-global-this)
|
|
(else (nth args 1)))))
|
|
(js-list-find-loop f arr this-arg 0))))
|
|
((= name "findIndex")
|
|
(fn (&rest args)
|
|
(let
|
|
((f (if (empty? args) :js-undefined (nth args 0)))
|
|
(this-arg
|
|
(cond
|
|
((< (len args) 2) js-global-this)
|
|
((js-undefined? (nth args 1)) js-global-this)
|
|
((= (nth args 1) nil) js-global-this)
|
|
(else (nth args 1)))))
|
|
(js-list-find-index-loop f arr this-arg 0))))
|
|
((= name "some")
|
|
(fn (&rest args)
|
|
(let
|
|
((f (if (empty? args) :js-undefined (nth args 0)))
|
|
(this-arg
|
|
(cond
|
|
((< (len args) 2) js-global-this)
|
|
((js-undefined? (nth args 1)) js-global-this)
|
|
((= (nth args 1) nil) js-global-this)
|
|
(else (nth args 1)))))
|
|
(js-list-some-loop f arr this-arg 0))))
|
|
((= name "every")
|
|
(fn (&rest args)
|
|
(let
|
|
((f (if (empty? args) :js-undefined (nth args 0)))
|
|
(this-arg
|
|
(cond
|
|
((< (len args) 2) js-global-this)
|
|
((js-undefined? (nth args 1)) js-global-this)
|
|
((= (nth args 1) nil) js-global-this)
|
|
(else (nth args 1)))))
|
|
(js-list-every-loop f arr this-arg 0))))
|
|
((= name "reverse")
|
|
(fn () (js-list-reverse-loop arr (- (len arr) 1) (list))))
|
|
((= name "flat")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((depth (if (= (len args) 0) 1 (js-num-to-int (nth args 0)))))
|
|
(js-list-flat-loop arr depth (list)))))
|
|
((= name "fill")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((v (if (= (len args) 0) js-undefined (nth args 0)))
|
|
(s
|
|
(if
|
|
(< (len args) 2)
|
|
0
|
|
(js-num-to-int (nth args 1))))
|
|
(e
|
|
(if
|
|
(< (len args) 3)
|
|
(len arr)
|
|
(js-num-to-int (nth args 2)))))
|
|
(js-list-fill-loop arr v s e)
|
|
arr)))
|
|
((= name "sort")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((cmp (if (= (len args) 0) nil (nth args 0))))
|
|
(js-list-sort! arr cmp)
|
|
arr)))
|
|
((= name "lastIndexOf")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(= (len args) 0)
|
|
-1
|
|
(js-list-last-index-of
|
|
arr
|
|
(nth args 0)
|
|
(if
|
|
(< (len args) 2)
|
|
(- (len arr) 1)
|
|
(js-num-to-int (nth args 1)))))))
|
|
((= name "at")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((i (if (empty? args) 0 (js-num-to-int (nth args 0)))))
|
|
(let
|
|
((idx (if (< i 0) (+ (len arr) i) i)))
|
|
(if
|
|
(or (< idx 0) (>= idx (len arr)))
|
|
:js-undefined (nth arr idx))))))
|
|
((= name "unshift") (fn (&rest args) (+ (len arr) (len args))))
|
|
((= name "splice")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((n (len arr))
|
|
(start-raw
|
|
(if
|
|
(empty? args)
|
|
0
|
|
(js-num-to-int (nth args 0)))))
|
|
(let
|
|
((start (cond ((< start-raw 0) (max 0 (+ n start-raw))) ((> start-raw n) n) (else start-raw))))
|
|
(let
|
|
((delete-count (if (< (len args) 2) (- n start) (max 0 (min (- n start) (js-num-to-int (nth args 1)))))))
|
|
(js-list-slice arr start (+ start delete-count)))))))
|
|
((= name "flatMap")
|
|
(fn
|
|
(f)
|
|
(let
|
|
((mapped (js-list-map-loop f arr js-global-this 0 (list))))
|
|
(js-list-flat-loop mapped 1 (list)))))
|
|
((= name "findLast")
|
|
(fn (f) (js-list-find-last-loop f arr (- (len arr) 1))))
|
|
((= name "findLastIndex")
|
|
(fn
|
|
(f)
|
|
(js-list-find-last-index-loop f arr (- (len arr) 1))))
|
|
((= name "reduceRight")
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 1)
|
|
(if
|
|
(= (len arr) 0)
|
|
(error "Reduce of empty array with no initial value")
|
|
(js-list-reduce-right-loop
|
|
(nth args 0)
|
|
(nth arr (- (len arr) 1))
|
|
arr
|
|
(- (len arr) 2))))
|
|
(else
|
|
(js-list-reduce-right-loop
|
|
(nth args 0)
|
|
(nth args 1)
|
|
arr
|
|
(- (len arr) 1))))))
|
|
((= name "toString") (fn () (js-list-join arr ",")))
|
|
((= name "toLocaleString") (fn () (js-list-join arr ",")))
|
|
((= name "keys")
|
|
(fn
|
|
()
|
|
(let
|
|
((result (list)))
|
|
(begin (js-list-keys-loop arr 0 result) result))))
|
|
((= name "values") (fn () (js-list-slice arr 0 (len arr))))
|
|
((= name "entries")
|
|
(fn
|
|
()
|
|
(let
|
|
((result (list)))
|
|
(begin (js-list-entries-loop arr 0 result) result))))
|
|
((= name "copyWithin")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((n (len arr))
|
|
(target-raw
|
|
(if
|
|
(empty? args)
|
|
0
|
|
(js-num-to-int (nth args 0))))
|
|
(start-raw
|
|
(if
|
|
(< (len args) 2)
|
|
0
|
|
(js-num-to-int (nth args 1))))
|
|
(end-raw
|
|
(if
|
|
(< (len args) 3)
|
|
(len arr)
|
|
(js-num-to-int (nth args 2)))))
|
|
(let
|
|
((target (cond ((< target-raw 0) (max 0 (+ n target-raw))) (else (min n target-raw))))
|
|
(start
|
|
(cond
|
|
((< start-raw 0)
|
|
(max 0 (+ n start-raw)))
|
|
(else (min n start-raw))))
|
|
(end
|
|
(cond
|
|
((< end-raw 0) (max 0 (+ n end-raw)))
|
|
(else (min n end-raw)))))
|
|
(begin (js-list-copy-within! arr target start end) arr)))))
|
|
((= name "toReversed")
|
|
(fn () (js-list-reverse-loop arr (- (len arr) 1) (list))))
|
|
((= name "toSorted")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((cmp (if (empty? args) nil (nth args 0)))
|
|
(copy (js-list-slice arr 0 (len arr))))
|
|
(begin (js-list-sort! copy cmp) copy))))
|
|
(else js-undefined))))
|
|
|
|
(define pop-last! (fn (lst) nil))
|
|
|
|
(define pop-first! (fn (lst) nil))
|
|
|
|
(define
|
|
js-list-slice
|
|
(fn
|
|
(arr start stop)
|
|
(let
|
|
((n (len arr)))
|
|
(let
|
|
((s (if (< start 0) (max 0 (+ n start)) (min start n)))
|
|
(e
|
|
(if
|
|
(< stop 0)
|
|
(max 0 (+ n stop))
|
|
(min stop n))))
|
|
(js-list-slice-loop arr s e (list))))))
|
|
|
|
(define
|
|
js-list-slice-loop
|
|
(fn
|
|
(arr i e acc)
|
|
(cond
|
|
((>= i e) acc)
|
|
(else
|
|
(do
|
|
(append! acc (nth arr i))
|
|
(js-list-slice-loop arr (+ i 1) e acc))))))
|
|
|
|
(define
|
|
js-list-index-of
|
|
(fn
|
|
(arr v i)
|
|
(cond
|
|
((>= i (len arr)) -1)
|
|
((js-strict-eq (nth arr i) v) i)
|
|
(else (js-list-index-of arr v (+ i 1))))))
|
|
|
|
(define
|
|
js-list-join
|
|
(fn
|
|
(arr sep)
|
|
(cond
|
|
((= (len arr) 0) "")
|
|
(else
|
|
(js-list-join-loop
|
|
arr
|
|
sep
|
|
1
|
|
(js-to-string-for-join (nth arr 0)))))))
|
|
|
|
(define
|
|
js-to-string-for-join
|
|
(fn
|
|
(v)
|
|
(cond ((js-undefined? v) "") ((= v nil) "") (else (js-to-string v)))))
|
|
|
|
(define
|
|
js-list-join-loop
|
|
(fn
|
|
(arr sep i acc)
|
|
(cond
|
|
((>= i (len arr)) acc)
|
|
(else
|
|
(js-list-join-loop
|
|
arr
|
|
sep
|
|
(+ i 1)
|
|
(str acc sep (js-to-string-for-join (nth arr i))))))))
|
|
|
|
(define
|
|
js-list-concat
|
|
(fn
|
|
(arr tail)
|
|
(let
|
|
((result (list)))
|
|
(begin
|
|
(for-each (fn (x) (append! result x)) arr)
|
|
(for-each
|
|
(fn
|
|
(other)
|
|
(cond
|
|
((= (type-of other) "list")
|
|
(for-each (fn (x) (append! result x)) other))
|
|
(else (append! result other))))
|
|
tail)
|
|
result))))
|
|
|
|
(define
|
|
js-list-map-loop
|
|
(fn
|
|
(f arr this-arg i acc)
|
|
(cond
|
|
((>= i (len arr)) acc)
|
|
(else
|
|
(do
|
|
(append!
|
|
acc
|
|
(js-call-with-this this-arg f (list (nth arr i) i arr)))
|
|
(js-list-map-loop f arr this-arg (+ i 1) acc))))))
|
|
|
|
(define
|
|
js-list-filter-loop
|
|
(fn
|
|
(f arr this-arg i acc)
|
|
(cond
|
|
((>= i (len arr)) acc)
|
|
(else
|
|
(do
|
|
(let
|
|
((v (nth arr i)))
|
|
(if
|
|
(js-to-boolean (js-call-with-this this-arg f (list v i arr)))
|
|
(append! acc v)
|
|
nil))
|
|
(js-list-filter-loop f arr this-arg (+ i 1) acc))))))
|
|
|
|
(define
|
|
js-list-foreach-loop
|
|
(fn
|
|
(f arr this-arg i)
|
|
(cond
|
|
((>= i (len arr)) nil)
|
|
(else
|
|
(do
|
|
(js-call-with-this this-arg f (list (nth arr i) i arr))
|
|
(js-list-foreach-loop f arr this-arg (+ i 1)))))))
|
|
|
|
(define
|
|
js-list-reduce-loop
|
|
(fn
|
|
(f acc arr i)
|
|
(cond
|
|
((>= i (len arr)) acc)
|
|
(else
|
|
(js-list-reduce-loop
|
|
f
|
|
(js-call-with-this js-undefined f (list acc (nth arr i) i arr))
|
|
arr
|
|
(+ i 1))))))
|
|
|
|
(define
|
|
js-list-find-loop
|
|
(fn
|
|
(f arr this-arg i)
|
|
(cond
|
|
((>= i (len arr)) js-undefined)
|
|
((js-to-boolean (js-call-with-this this-arg f (list (nth arr i) i arr)))
|
|
(nth arr i))
|
|
(else (js-list-find-loop f arr this-arg (+ i 1))))))
|
|
|
|
(define
|
|
js-list-find-index-loop
|
|
(fn
|
|
(f arr this-arg i)
|
|
(cond
|
|
((>= i (len arr)) -1)
|
|
((js-to-boolean (js-call-with-this this-arg f (list (nth arr i) i arr)))
|
|
i)
|
|
(else (js-list-find-index-loop f arr this-arg (+ i 1))))))
|
|
|
|
(define
|
|
js-list-some-loop
|
|
(fn
|
|
(f arr this-arg i)
|
|
(cond
|
|
((>= i (len arr)) false)
|
|
((js-to-boolean (js-call-with-this this-arg f (list (nth arr i) i arr)))
|
|
true)
|
|
(else (js-list-some-loop f arr this-arg (+ i 1))))))
|
|
|
|
(define
|
|
js-list-flat-loop
|
|
(fn
|
|
(arr depth acc)
|
|
(for-each
|
|
(fn
|
|
(x)
|
|
(if
|
|
(and (list? x) (> depth 0))
|
|
(js-list-flat-loop x (- depth 1) acc)
|
|
(append! acc x)))
|
|
arr)
|
|
acc))
|
|
|
|
(define
|
|
js-list-fill-loop
|
|
(fn
|
|
(arr v s e)
|
|
(cond
|
|
((>= s e) nil)
|
|
((>= s (len arr)) nil)
|
|
(else
|
|
(begin
|
|
(js-list-set! arr s v)
|
|
(js-list-fill-loop arr v (+ s 1) e))))))
|
|
|
|
(define
|
|
js-list-sort!
|
|
(fn
|
|
(arr cmp)
|
|
(let ((n (len arr))) (js-list-sort-outer! arr cmp 0 n))))
|
|
|
|
(define
|
|
js-list-sort-outer!
|
|
(fn
|
|
(arr cmp i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(js-list-sort-inner! arr cmp 0 (- n i 1))
|
|
(js-list-sort-outer! arr cmp (+ i 1) n))))))
|
|
|
|
(define
|
|
js-list-sort-inner!
|
|
(fn
|
|
(arr cmp i end)
|
|
(cond
|
|
((>= i end) nil)
|
|
(else
|
|
(begin
|
|
(let
|
|
((a (nth arr i)) (b (nth arr (+ i 1))))
|
|
(let
|
|
((result (if (= cmp nil) (if (js-str-lt (js-to-string b) (js-to-string a)) 1 -1) (js-to-number (cmp a b)))))
|
|
(when
|
|
(> result 0)
|
|
(begin
|
|
(js-list-set! arr i b)
|
|
(js-list-set! arr (+ i 1) a)))))
|
|
(js-list-sort-inner! arr cmp (+ i 1) end))))))
|
|
|
|
(define
|
|
js-list-last-index-of
|
|
(fn
|
|
(arr x i)
|
|
(cond
|
|
((< i 0) -1)
|
|
((= (nth arr i) x) i)
|
|
(else (js-list-last-index-of arr x (- i 1))))))
|
|
|
|
(define
|
|
js-list-every-loop
|
|
(fn
|
|
(f arr this-arg i)
|
|
(cond
|
|
((>= i (len arr)) true)
|
|
((not (js-to-boolean (js-call-with-this this-arg f (list (nth arr i) i arr))))
|
|
false)
|
|
(else (js-list-every-loop f arr this-arg (+ i 1))))))
|
|
|
|
(define
|
|
js-list-reverse-loop
|
|
(fn
|
|
(arr i acc)
|
|
(cond
|
|
((< i 0) acc)
|
|
(else
|
|
(begin
|
|
(append! acc (nth arr i))
|
|
(js-list-reverse-loop arr (- i 1) acc))))))
|
|
|
|
(define
|
|
js-list-find-last-loop
|
|
(fn
|
|
(f arr i)
|
|
(cond
|
|
((< i 0) :js-undefined)
|
|
((js-to-boolean (f (nth arr i))) (nth arr i))
|
|
(else (js-list-find-last-loop f arr (- i 1))))))
|
|
|
|
(define
|
|
js-list-find-last-index-loop
|
|
(fn
|
|
(f arr i)
|
|
(cond
|
|
((< i 0) -1)
|
|
((js-to-boolean (f (nth arr i))) i)
|
|
(else (js-list-find-last-index-loop f arr (- i 1))))))
|
|
|
|
(define
|
|
js-list-reduce-right-loop
|
|
(fn
|
|
(f acc arr i)
|
|
(if
|
|
(< i 0)
|
|
acc
|
|
(js-list-reduce-right-loop
|
|
f
|
|
(js-call-with-this js-undefined f (list acc (nth arr i) i arr))
|
|
arr
|
|
(- i 1)))))
|
|
|
|
(define
|
|
js-list-keys-loop
|
|
(fn
|
|
(arr i result)
|
|
(if
|
|
(>= i (len arr))
|
|
result
|
|
(begin
|
|
(append! result i)
|
|
(js-list-keys-loop arr (+ i 1) result)))))
|
|
|
|
(define
|
|
js-list-entries-loop
|
|
(fn
|
|
(arr i result)
|
|
(if
|
|
(>= i (len arr))
|
|
result
|
|
(begin
|
|
(append! result (list i (nth arr i)))
|
|
(js-list-entries-loop arr (+ i 1) result)))))
|
|
|
|
(define
|
|
js-list-copy-within!
|
|
(fn
|
|
(arr target start end)
|
|
(let
|
|
((snap (js-list-slice arr start end)))
|
|
(js-list-copy-within-loop! arr target snap 0))))
|
|
|
|
(define
|
|
js-list-copy-within-loop!
|
|
(fn
|
|
(arr target snap i)
|
|
(cond
|
|
((>= i (len snap)) arr)
|
|
((>= (+ target i) (len arr)) arr)
|
|
(else
|
|
(begin
|
|
(set-nth! arr (+ target i) (nth snap i))
|
|
(js-list-copy-within-loop! arr target snap (+ i 1)))))))
|
|
|
|
(define
|
|
js-string-repeat
|
|
(fn
|
|
(s n acc)
|
|
(if
|
|
(<= n 0)
|
|
acc
|
|
(js-string-repeat s (- n 1) (str acc s)))))
|
|
|
|
(define
|
|
js-string-pad
|
|
(fn
|
|
(s target pad at-start)
|
|
(let
|
|
((slen (len s)))
|
|
(if
|
|
(or (<= target slen) (= (len pad) 0))
|
|
s
|
|
(let
|
|
((needed (- target slen)))
|
|
(let
|
|
((padding (js-string-pad-build pad needed "")))
|
|
(if at-start (str padding s) (str s padding))))))))
|
|
|
|
(define
|
|
js-string-pad-build
|
|
(fn
|
|
(pad needed acc)
|
|
(cond
|
|
((<= needed 0) acc)
|
|
((>= (len acc) needed) (js-string-slice acc 0 needed))
|
|
(else (js-string-pad-build pad needed (str acc pad))))))
|
|
|
|
(define
|
|
js-string-method
|
|
(fn
|
|
(s name)
|
|
(cond
|
|
((= name "charAt")
|
|
(fn
|
|
(i)
|
|
(let
|
|
((idx (js-num-to-int i)))
|
|
(if
|
|
(and (>= idx 0) (< idx (len s)))
|
|
(char-at s idx)
|
|
""))))
|
|
((= name "charCodeAt")
|
|
(fn
|
|
(i)
|
|
(let
|
|
((idx (js-num-to-int (js-to-number i))))
|
|
(if
|
|
(and (>= idx 0) (< idx (len s)))
|
|
(char-code (char-at s idx))
|
|
(js-nan-value)))))
|
|
((= name "indexOf")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(empty? args)
|
|
-1
|
|
(js-string-index-of
|
|
s
|
|
(js-to-string (nth args 0))
|
|
(if
|
|
(< (len args) 2)
|
|
0
|
|
(max 0 (js-num-to-int (nth args 1))))))))
|
|
((= name "slice")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((start (if (= (len args) 0) 0 (js-num-to-int (nth args 0))))
|
|
(stop
|
|
(if
|
|
(< (len args) 2)
|
|
(len s)
|
|
(js-num-to-int (nth args 1)))))
|
|
(js-string-slice s start stop))))
|
|
((= name "substring")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((start (if (= (len args) 0) 0 (max 0 (js-num-to-int (nth args 0)))))
|
|
(stop
|
|
(if
|
|
(< (len args) 2)
|
|
(len s)
|
|
(max 0 (js-num-to-int (nth args 1))))))
|
|
(let
|
|
((lo (min start stop)) (hi (max start stop)))
|
|
(js-string-slice s lo (min hi (len s)))))))
|
|
((= name "toUpperCase") (fn () (js-upper-case s)))
|
|
((= name "toLowerCase") (fn () (js-lower-case s)))
|
|
((= name "split")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((sep (if (= (len args) 0) :js-undefined (nth args 0)))
|
|
(limit-raw (if (< (len args) 2) :js-undefined (nth args 1))))
|
|
(let
|
|
((limit
|
|
(cond
|
|
((js-undefined? limit-raw) -1)
|
|
(else (js-num-to-int (js-to-number limit-raw))))))
|
|
(cond
|
|
((js-undefined? sep) (js-make-list s))
|
|
((= limit 0) (js-make-list))
|
|
(else
|
|
(let
|
|
((result (js-string-split s (js-to-string sep))))
|
|
(if (< limit 0) result (js-list-take result limit)))))))))
|
|
((= name "concat")
|
|
(fn (&rest args) (js-string-concat-loop s args 0)))
|
|
((= name "includes")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((needle (if (= (len args) 0) "" (js-to-string (nth args 0)))))
|
|
(>= (js-string-index-of s needle 0) 0))))
|
|
((= name "startsWith")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((needle (if (= (len args) 0) "" (js-to-string (nth args 0))))
|
|
(start
|
|
(if
|
|
(< (len args) 2)
|
|
0
|
|
(js-num-to-int (nth args 1)))))
|
|
(js-string-matches? s needle start 0))))
|
|
((= name "endsWith")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((needle (if (= (len args) 0) "" (js-to-string (nth args 0)))))
|
|
(let
|
|
((end-len (len s)) (n-len (len needle)))
|
|
(if
|
|
(> n-len end-len)
|
|
false
|
|
(js-string-matches? s needle (- end-len n-len) 0))))))
|
|
((= name "trim") (fn () (js-trim s)))
|
|
((= name "trimStart") (fn () (js-trim-left s)))
|
|
((= name "trimEnd") (fn () (js-trim-right s)))
|
|
((= name "repeat")
|
|
(fn (n) (js-string-repeat s (js-num-to-int n) "")))
|
|
((= name "padStart")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((target (if (= (len args) 0) 0 (js-num-to-int (nth args 0))))
|
|
(pad
|
|
(if
|
|
(< (len args) 2)
|
|
" "
|
|
(js-to-string (nth args 1)))))
|
|
(js-string-pad s target pad true))))
|
|
((= name "padEnd")
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((target (if (= (len args) 0) 0 (js-num-to-int (nth args 0))))
|
|
(pad
|
|
(if
|
|
(< (len args) 2)
|
|
" "
|
|
(js-to-string (nth args 1)))))
|
|
(js-string-pad s target pad false))))
|
|
((= name "toString") (fn () s))
|
|
((= name "valueOf") (fn () s))
|
|
((= name "replace")
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((< (len args) 2) s)
|
|
((js-regex? (nth args 0))
|
|
(let
|
|
((rx (nth args 0)) (repl (nth args 1)))
|
|
(let
|
|
((src (get rx "source")))
|
|
(let
|
|
((idx (js-string-index-of (if (get rx "ignoreCase") (js-lower-case s) s) (if (get rx "ignoreCase") (js-lower-case src) src) 0)))
|
|
(if
|
|
(= idx -1)
|
|
s
|
|
(let
|
|
((matched (js-string-slice s idx (+ idx (len src)))))
|
|
(str
|
|
(js-string-slice s 0 idx)
|
|
(if
|
|
(js-function? repl)
|
|
(repl matched)
|
|
(js-to-string repl))
|
|
(js-string-slice s (+ idx (len src)) (len s)))))))))
|
|
(else
|
|
(let
|
|
((needle (js-to-string (nth args 0)))
|
|
(repl (nth args 1)))
|
|
(let
|
|
((idx (js-string-index-of s needle 0)))
|
|
(if
|
|
(= idx -1)
|
|
s
|
|
(str
|
|
(js-string-slice s 0 idx)
|
|
(if
|
|
(js-function? repl)
|
|
(repl needle)
|
|
(js-to-string repl))
|
|
(js-string-slice s (+ idx (len needle)) (len s))))))))))
|
|
((= name "search")
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0) -1)
|
|
((js-regex? (nth args 0))
|
|
(let
|
|
((rx (nth args 0))
|
|
(src (get (nth args 0) "source")))
|
|
(js-string-index-of
|
|
(if (get rx "ignoreCase") (js-lower-case s) s)
|
|
(if (get rx "ignoreCase") (js-lower-case src) src)
|
|
0)))
|
|
(else
|
|
(js-string-index-of
|
|
s
|
|
(js-to-string (nth args 0))
|
|
0)))))
|
|
((= name "match")
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0) nil)
|
|
((js-regex? (nth args 0))
|
|
(js-regex-stub-exec (nth args 0) s))
|
|
(else
|
|
(let
|
|
((needle (js-to-string (nth args 0))))
|
|
(let
|
|
((idx (js-string-index-of s needle 0)))
|
|
(if
|
|
(= idx -1)
|
|
nil
|
|
(let ((res (list))) (append! res needle) res))))))))
|
|
((= name "matchAll")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(empty? args)
|
|
(list)
|
|
(let
|
|
((needle (js-to-string (nth args 0))))
|
|
(let
|
|
((loop (fn (start acc) (let ((idx (js-string-index-of s needle start))) (if (= idx -1) acc (let ((m (list))) (begin (append! m needle) (dict-set! m "index" idx) (loop (+ idx (max 1 (len needle))) (begin (append! acc m) acc)))))))))
|
|
(loop 0 (list)))))))
|
|
((= name "at")
|
|
(fn
|
|
(i)
|
|
(let
|
|
((idx (js-num-to-int i)))
|
|
(let
|
|
((actual (if (< idx 0) (+ (len s) idx) idx)))
|
|
(if
|
|
(or (< actual 0) (>= actual (len s)))
|
|
:js-undefined (char-at s actual))))))
|
|
((= name "codePointAt")
|
|
(fn
|
|
(i)
|
|
(let
|
|
((idx (js-num-to-int i)))
|
|
(if
|
|
(or (< idx 0) (>= idx (len s)))
|
|
:js-undefined (char-code (char-at s idx))))))
|
|
((= name "lastIndexOf")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(empty? args)
|
|
-1
|
|
(let
|
|
((needle (js-to-string (nth args 0))))
|
|
(let
|
|
((default-start (- (len s) (len needle)))
|
|
(from
|
|
(if
|
|
(< (len args) 2)
|
|
-1
|
|
(js-num-to-int (nth args 1)))))
|
|
(js-string-last-index-of
|
|
s
|
|
needle
|
|
(if
|
|
(< from 0)
|
|
default-start
|
|
(min from default-start))))))))
|
|
((= name "localeCompare")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(empty? args)
|
|
0
|
|
(let
|
|
((other (js-to-string (nth args 0))))
|
|
(cond
|
|
((< s other) -1)
|
|
((> s other) 1)
|
|
(else 0))))))
|
|
((= name "replaceAll")
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(< (len args) 2)
|
|
s
|
|
(let
|
|
((needle-arg (nth args 0))
|
|
(repl (nth args 1)))
|
|
(let
|
|
((needle (if (js-regex? needle-arg) (get needle-arg "source") (js-to-string needle-arg))))
|
|
(js-string-replace-all
|
|
s
|
|
needle
|
|
(if (js-function? repl) repl (js-to-string repl))))))))
|
|
((= name "normalize") (fn (&rest args) s))
|
|
((= name "toLocaleLowerCase") (fn (&rest args) (js-lower-case s)))
|
|
((= name "toLocaleUpperCase") (fn (&rest args) (js-upper-case s)))
|
|
((= name "isWellFormed") (fn () true))
|
|
((= name "toWellFormed") (fn () s))
|
|
(else js-undefined))))
|
|
|
|
(define
|
|
js-string-slice
|
|
(fn
|
|
(s start stop)
|
|
(let
|
|
((n (len s)))
|
|
(let
|
|
((lo (if (< start 0) (max 0 (+ n start)) (min start n)))
|
|
(hi
|
|
(if
|
|
(< stop 0)
|
|
(max 0 (+ n stop))
|
|
(min stop n))))
|
|
(if (>= lo hi) "" (js-string-slice-loop s lo hi ""))))))
|
|
|
|
(define
|
|
js-string-slice-loop
|
|
(fn
|
|
(s i e acc)
|
|
(cond
|
|
((>= i e) acc)
|
|
(else
|
|
(js-string-slice-loop s (+ i 1) e (str acc (char-at s i)))))))
|
|
|
|
(define
|
|
js-string-index-of
|
|
(fn
|
|
(s needle i)
|
|
(cond
|
|
((> (+ i (len needle)) (len s)) -1)
|
|
((js-string-matches? s needle i 0) i)
|
|
(else (js-string-index-of s needle (+ i 1))))))
|
|
|
|
(define
|
|
js-string-last-index-of
|
|
(fn
|
|
(s needle start)
|
|
(cond
|
|
((< start 0) -1)
|
|
((= needle "") start)
|
|
((js-string-matches? s needle start 0) start)
|
|
(else (js-string-last-index-of s needle (- start 1))))))
|
|
|
|
(define
|
|
js-string-replace-all
|
|
(fn
|
|
(s needle repl)
|
|
(if
|
|
(= needle "")
|
|
s
|
|
(let
|
|
((idx (js-string-index-of s needle 0)))
|
|
(if
|
|
(= idx -1)
|
|
s
|
|
(str
|
|
(js-string-slice s 0 idx)
|
|
(if (js-function? repl) (repl needle) repl)
|
|
(js-string-replace-all
|
|
(js-string-slice s (+ idx (len needle)) (len s))
|
|
needle
|
|
repl)))))))
|
|
|
|
(define
|
|
js-string-matches?
|
|
(fn
|
|
(s needle si ni)
|
|
(cond
|
|
((>= ni (len needle)) true)
|
|
((not (= (char-at s (+ si ni)) (char-at needle ni))) false)
|
|
(else (js-string-matches? s needle si (+ ni 1))))))
|
|
|
|
(define
|
|
js-list-take
|
|
(fn
|
|
(lst n)
|
|
(if
|
|
(or (<= n 0) (empty? lst))
|
|
(list)
|
|
(cons (first lst) (js-list-take (rest lst) (- n 1))))))
|
|
|
|
(define
|
|
js-string-split
|
|
(fn
|
|
(s sep)
|
|
(cond
|
|
((= sep "") (js-string-split-chars s 0 (list)))
|
|
(else (js-string-split-loop s sep 0 0 (list))))))
|
|
|
|
(define
|
|
js-string-split-chars
|
|
(fn
|
|
(s i acc)
|
|
(cond
|
|
((>= i (len s)) acc)
|
|
(else
|
|
(do
|
|
(append! acc (char-at s i))
|
|
(js-string-split-chars s (+ i 1) acc))))))
|
|
|
|
(define
|
|
js-string-split-loop
|
|
(fn
|
|
(s sep start i acc)
|
|
(cond
|
|
((> (+ i (len sep)) (len s))
|
|
(do (append! acc (js-string-slice s start (len s))) acc))
|
|
((js-string-matches? s sep i 0)
|
|
(do
|
|
(append! acc (js-string-slice s start i))
|
|
(js-string-split-loop s sep (+ i (len sep)) (+ i (len sep)) acc)))
|
|
(else (js-string-split-loop s sep start (+ i 1) acc)))))
|
|
|
|
(define
|
|
js-string-concat-loop
|
|
(fn
|
|
(acc args i)
|
|
(cond
|
|
((>= i (len args)) acc)
|
|
(else
|
|
(js-string-concat-loop
|
|
(str acc (js-to-string (nth args i)))
|
|
args
|
|
(+ i 1))))))
|
|
|
|
(begin
|
|
(define
|
|
js-get-prop
|
|
(fn
|
|
(obj key)
|
|
(cond
|
|
((= obj nil) js-undefined)
|
|
((js-undefined? obj) js-undefined)
|
|
((= (type-of obj) "list")
|
|
(cond
|
|
((= key "length") (len obj))
|
|
((= (type-of key) "number")
|
|
(if
|
|
(and (>= key 0) (< key (len obj)))
|
|
(nth obj (js-num-to-int key))
|
|
js-undefined))
|
|
((and (= (type-of key) "string") (js-is-numeric-string? key))
|
|
(let
|
|
((idx (js-num-to-int (js-string-to-number key))))
|
|
(if
|
|
(and (>= idx 0) (< idx (len obj)))
|
|
(nth obj idx)
|
|
js-undefined)))
|
|
((= key "push") (js-array-method obj "push"))
|
|
((= key "pop") (js-array-method obj "pop"))
|
|
((= key "shift") (js-array-method obj "shift"))
|
|
((= key "slice") (js-array-method obj "slice"))
|
|
((= key "indexOf") (js-array-method obj "indexOf"))
|
|
((= key "join") (js-array-method obj "join"))
|
|
((= key "concat") (js-array-method obj "concat"))
|
|
((= key "map") (js-array-method obj "map"))
|
|
((= key "filter") (js-array-method obj "filter"))
|
|
((= key "forEach") (js-array-method obj "forEach"))
|
|
((= key "reduce") (js-array-method obj "reduce"))
|
|
((= key "includes") (js-array-method obj "includes"))
|
|
((= key "find") (js-array-method obj "find"))
|
|
((= key "findIndex") (js-array-method obj "findIndex"))
|
|
((= key "some") (js-array-method obj "some"))
|
|
((= key "every") (js-array-method obj "every"))
|
|
((= key "reverse") (js-array-method obj "reverse"))
|
|
((= key "flat") (js-array-method obj "flat"))
|
|
((= key "fill") (js-array-method obj "fill"))
|
|
((= key "sort") (js-array-method obj "sort"))
|
|
((= key "lastIndexOf") (js-array-method obj "lastIndexOf"))
|
|
((= key "at") (js-array-method obj "at"))
|
|
((= key "unshift") (js-array-method obj "unshift"))
|
|
((= key "splice") (js-array-method obj "splice"))
|
|
((= key "flatMap") (js-array-method obj "flatMap"))
|
|
((= key "findLast") (js-array-method obj "findLast"))
|
|
((= key "findLastIndex") (js-array-method obj "findLastIndex"))
|
|
((= key "reduceRight") (js-array-method obj "reduceRight"))
|
|
((= key "toString") (js-dict-get-walk (get Array "prototype") "toString"))
|
|
((= key "toLocaleString") (js-array-method obj "toLocaleString"))
|
|
((= key "keys") (js-array-method obj "keys"))
|
|
((= key "values") (js-array-method obj "values"))
|
|
((= key "entries") (js-array-method obj "entries"))
|
|
((= key "copyWithin") (js-array-method obj "copyWithin"))
|
|
((= key "toReversed") (js-array-method obj "toReversed"))
|
|
((= key "toSorted") (js-array-method obj "toSorted"))
|
|
(else (js-dict-get-walk (get Array "prototype") (js-to-string key)))))
|
|
((= (type-of obj) "string")
|
|
(cond
|
|
((= key "length") (len obj))
|
|
((= (type-of key) "number")
|
|
(if
|
|
(and (>= key 0) (< key (len obj)))
|
|
(char-at obj (js-num-to-int key))
|
|
js-undefined))
|
|
((= key "charAt") (js-string-method obj "charAt"))
|
|
((= key "charCodeAt") (js-string-method obj "charCodeAt"))
|
|
((= key "indexOf") (js-string-method obj "indexOf"))
|
|
((= key "slice") (js-string-method obj "slice"))
|
|
((= key "substring") (js-string-method obj "substring"))
|
|
((= key "toUpperCase") (js-string-method obj "toUpperCase"))
|
|
((= key "toLowerCase") (js-string-method obj "toLowerCase"))
|
|
((= key "split") (js-string-method obj "split"))
|
|
((= key "concat") (js-string-method obj "concat"))
|
|
((= key "includes") (js-string-method obj "includes"))
|
|
((= key "startsWith") (js-string-method obj "startsWith"))
|
|
((= key "endsWith") (js-string-method obj "endsWith"))
|
|
((= key "trim") (js-string-method obj "trim"))
|
|
((= key "trimStart") (js-string-method obj "trimStart"))
|
|
((= key "trimEnd") (js-string-method obj "trimEnd"))
|
|
((= key "repeat") (js-string-method obj "repeat"))
|
|
((= key "padStart") (js-string-method obj "padStart"))
|
|
((= key "padEnd") (js-string-method obj "padEnd"))
|
|
((= key "toString") (js-string-method obj "toString"))
|
|
((= key "valueOf") (js-string-method obj "valueOf"))
|
|
((= key "replace") (js-string-method obj "replace"))
|
|
((= key "search") (js-string-method obj "search"))
|
|
((= key "match") (js-string-method obj "match"))
|
|
((= key "at") (js-string-method obj "at"))
|
|
((= key "codePointAt") (js-string-method obj "codePointAt"))
|
|
((= key "lastIndexOf") (js-string-method obj "lastIndexOf"))
|
|
((= key "localeCompare") (js-string-method obj "localeCompare"))
|
|
((= key "replaceAll") (js-string-method obj "replaceAll"))
|
|
((= key "normalize") (js-string-method obj "normalize"))
|
|
((= key "toLocaleLowerCase")
|
|
(js-string-method obj "toLocaleLowerCase"))
|
|
((= key "toLocaleUpperCase")
|
|
(js-string-method obj "toLocaleUpperCase"))
|
|
((= key "isWellFormed") (js-string-method obj "isWellFormed"))
|
|
((= key "toWellFormed") (js-string-method obj "toWellFormed"))
|
|
(else
|
|
(let
|
|
((proto (get String "prototype")))
|
|
(if
|
|
(and (dict? proto) (contains? (keys proto) key))
|
|
(get proto key)
|
|
js-undefined)))))
|
|
((= (type-of obj) "dict")
|
|
(js-dict-get-walk obj (js-to-string key)))
|
|
((and (= obj Promise) (dict-has? __js_promise_statics__ (js-to-string key)))
|
|
(get __js_promise_statics__ (js-to-string key)))
|
|
((and (= obj Error) (= (js-to-string key) "isError"))
|
|
js-error-is-error)
|
|
((and (js-function? obj) (or (= key "prototype") (= key "name") (= key "length") (= key "call") (= key "apply") (= key "bind") (= key "constructor")))
|
|
(cond
|
|
((= key "prototype") (js-get-ctor-proto obj))
|
|
((= key "name") (js-extract-fn-name obj))
|
|
((= key "length") (js-fn-length obj))
|
|
((= key "constructor") js-function-global)
|
|
(else (js-invoke-function-bound obj key))))
|
|
(else js-undefined))))
|
|
(define
|
|
js-dict-get-walk
|
|
(fn
|
|
(obj skey)
|
|
(cond
|
|
((= obj nil) js-undefined)
|
|
((js-undefined? obj) js-undefined)
|
|
((or (= (type-of obj) "lambda") (= (type-of obj) "function") (= (type-of obj) "component"))
|
|
(js-dict-get-walk (get js-function-global "prototype") skey))
|
|
((not (= (type-of obj) "dict")) js-undefined)
|
|
((dict-has? obj skey) (get obj skey))
|
|
((dict-has? obj "__proto__")
|
|
(js-dict-get-walk (get obj "__proto__") skey))
|
|
((not (= obj (get Object "prototype")))
|
|
(js-dict-get-walk (get Object "prototype") skey))
|
|
(else js-undefined)))))
|
|
|
|
(define
|
|
js-num-to-int
|
|
(fn
|
|
(v)
|
|
(let
|
|
((n (js-to-number v)))
|
|
(cond
|
|
((js-number-is-nan n) 0)
|
|
((= n (js-infinity-value)) 0)
|
|
((= n (- 0 (js-infinity-value))) 0)
|
|
((>= n 0) (floor n))
|
|
(else (- 0 (floor (- 0 n))))))))
|
|
|
|
(define dict-has? (fn (d k) (contains? (keys d) k)))
|
|
|
|
(define
|
|
js-make-obj
|
|
(fn ()
|
|
(let ((d (dict)))
|
|
(begin
|
|
(dict-set! d "__js_order__" (list))
|
|
(dict-set! d "__proto__" (get Object "prototype"))
|
|
d))))
|
|
|
|
(define
|
|
js-obj-order-add!
|
|
(fn
|
|
(obj k)
|
|
(cond
|
|
((not (dict? obj)) nil)
|
|
((not (contains? (keys obj) "__js_order__")) nil)
|
|
(else
|
|
(let
|
|
((order (get obj "__js_order__")))
|
|
(if (contains? order k) nil (append! order k)))))))
|
|
|
|
(define
|
|
js-obj-order-remove!
|
|
(fn
|
|
(obj k)
|
|
(cond
|
|
((not (dict? obj)) nil)
|
|
((not (contains? (keys obj) "__js_order__")) nil)
|
|
(else
|
|
(dict-set!
|
|
obj
|
|
"__js_order__"
|
|
(filter (fn (x) (not (= x k))) (get obj "__js_order__")))))))
|
|
|
|
(define
|
|
js-obj-set!
|
|
(fn
|
|
(obj key val)
|
|
(let
|
|
((sk (js-to-string key)))
|
|
(begin
|
|
(if (not (contains? (keys obj) sk)) (js-obj-order-add! obj sk) nil)
|
|
(dict-set! obj sk val)
|
|
val))))
|
|
|
|
(define
|
|
js-obj-spread!
|
|
(fn
|
|
(target src)
|
|
(cond
|
|
((or (= src nil) (js-undefined? src)) target)
|
|
((dict? src)
|
|
(begin
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(if
|
|
(js-key-internal? k)
|
|
nil
|
|
(js-obj-set! target k (get src k))))
|
|
(js-object-keys src))
|
|
target))
|
|
((= (type-of src) "string")
|
|
(let
|
|
((n (len src)))
|
|
(begin (js-obj-spread-string-loop! target src 0 n) target)))
|
|
((list? src)
|
|
(let
|
|
((n (len src)))
|
|
(begin (js-obj-spread-list-loop! target src 0 n) target)))
|
|
(else target))))
|
|
|
|
(define
|
|
js-obj-spread-string-loop!
|
|
(fn
|
|
(target s i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(js-obj-set! target (js-to-string i) (char-at s i))
|
|
(js-obj-spread-string-loop! target s (+ i 1) n))))))
|
|
|
|
(define
|
|
js-obj-spread-list-loop!
|
|
(fn
|
|
(target arr i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(js-obj-set! target (js-to-string i) (nth arr i))
|
|
(js-obj-spread-list-loop! target arr (+ i 1) n))))))
|
|
|
|
(begin
|
|
(define
|
|
js-set-prop
|
|
(fn
|
|
(obj key val)
|
|
(cond
|
|
((js-undefined? obj) (error "js-set-prop: cannot set on undefined"))
|
|
((= (type-of obj) "dict")
|
|
(let
|
|
((sk (js-to-string key)))
|
|
(begin
|
|
(if (not (contains? (keys obj) sk)) (js-obj-order-add! obj sk) nil)
|
|
(dict-set! obj sk val)
|
|
val)))
|
|
((= (type-of obj) "list") (do (js-list-set! obj key val) val))
|
|
((and
|
|
(or (= (type-of obj) "lambda") (= (type-of obj) "function") (= (type-of obj) "component"))
|
|
(= (js-to-string key) "prototype"))
|
|
(let
|
|
((id (js-ctor-id obj)))
|
|
(begin (dict-set! __js_proto_table__ id val) val)))
|
|
(else val))))
|
|
(define
|
|
js-list-set!
|
|
(fn
|
|
(lst key val)
|
|
(cond
|
|
((= (type-of key) "number")
|
|
(let
|
|
((i (js-num-to-int key)) (n (len lst)))
|
|
(cond
|
|
((< i 0) nil)
|
|
((>= i 1000000) nil)
|
|
((< i n) (set-nth! lst i val))
|
|
((= i n) (append! lst val))
|
|
(else (do (js-pad-list! lst n i) (append! lst val))))))
|
|
((and (= (type-of key) "string") (js-is-numeric-string? key))
|
|
(js-list-set! lst (js-string-to-number key) val))
|
|
((= key "length")
|
|
(let
|
|
((target (js-num-to-int (js-to-number val))) (n (len lst)))
|
|
(cond
|
|
((< target 0) nil)
|
|
((>= target 1000000) nil)
|
|
((> target n) (js-pad-list! lst n target))
|
|
(else nil))))
|
|
(else nil))))
|
|
(define
|
|
js-pad-list!
|
|
(fn
|
|
(lst from target)
|
|
(cond
|
|
((>= from target) nil)
|
|
(else
|
|
(do
|
|
(append! lst js-undefined)
|
|
(js-pad-list! lst (+ from 1) target)))))))
|
|
|
|
(define js-and (fn (a b-thunk) (if (js-to-boolean a) (b-thunk) a)))
|
|
|
|
(define js-or (fn (a b-thunk) (if (js-to-boolean a) a (b-thunk))))
|
|
|
|
(define
|
|
js-console-log
|
|
(fn (&rest args) (for-each (fn (a) (log-info (js-to-string a))) args)))
|
|
|
|
(define console {:log js-console-log})
|
|
|
|
(define js-math-abs (fn (x) (abs (js-to-number x))))
|
|
|
|
(define js-math-floor (fn (x) (floor (js-to-number x))))
|
|
|
|
(define js-math-ceil (fn (x) (ceil (js-to-number x))))
|
|
|
|
(define js-math-round (fn (x) (floor (+ (js-to-number x) 0.5))))
|
|
|
|
(define
|
|
js-math-max
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((empty? args) -inf)
|
|
(else (js-math-max-loop (first args) (rest args))))))
|
|
|
|
(define
|
|
js-math-max-loop
|
|
(fn
|
|
(acc xs)
|
|
(cond
|
|
((empty? xs) acc)
|
|
(else
|
|
(let
|
|
((h (js-to-number (first xs))))
|
|
(js-math-max-loop (if (> h acc) h acc) (rest xs)))))))
|
|
|
|
(define
|
|
js-math-min
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((empty? args) inf)
|
|
(else (js-math-min-loop (first args) (rest args))))))
|
|
|
|
(define
|
|
js-math-min-loop
|
|
(fn
|
|
(acc xs)
|
|
(cond
|
|
((empty? xs) acc)
|
|
(else
|
|
(let
|
|
((h (js-to-number (first xs))))
|
|
(js-math-min-loop (if (< h acc) h acc) (rest xs)))))))
|
|
|
|
(define js-math-random (fn () 0))
|
|
|
|
(define js-math-sqrt (fn (x) (sqrt (js-to-number x))))
|
|
|
|
(define js-math-pow (fn (a b) (js-pow-spec a b)))
|
|
|
|
(define
|
|
js-math-trunc
|
|
(fn
|
|
(x)
|
|
(let
|
|
((n (js-to-number x)))
|
|
(if (< n 0) (ceil n) (floor n)))))
|
|
|
|
(define
|
|
js-math-sign
|
|
(fn
|
|
(x)
|
|
(let
|
|
((n (js-to-number x)))
|
|
(cond
|
|
((> n 0) 1)
|
|
((< n 0) -1)
|
|
(else n)))))
|
|
|
|
(define
|
|
js-math-cbrt
|
|
(fn
|
|
(x)
|
|
(let
|
|
((n (js-to-number x)))
|
|
(if
|
|
(< n 0)
|
|
(- 0 (pow (- 0 n) (/ 1 3)))
|
|
(pow n (/ 1 3))))))
|
|
|
|
(define
|
|
js-math-hypot
|
|
(fn (&rest args) (sqrt (js-math-hypot-loop args 0))))
|
|
|
|
(define
|
|
js-math-hypot-loop
|
|
(fn
|
|
(args acc)
|
|
(if
|
|
(empty? args)
|
|
acc
|
|
(let
|
|
((n (js-to-number (first args))))
|
|
(js-math-hypot-loop (rest args) (+ acc (* n n)))))))
|
|
|
|
(begin
|
|
(define js-math-sin (fn (x) (sin (js-to-number x))))
|
|
(define js-math-cos (fn (x) (cos (js-to-number x))))
|
|
(define js-math-tan (fn (x) (tan (js-to-number x))))
|
|
(define js-math-asin (fn (x) (asin (js-to-number x))))
|
|
(define js-math-acos (fn (x) (acos (js-to-number x))))
|
|
(define js-math-atan (fn (x) (atan (js-to-number x))))
|
|
(define
|
|
js-math-atan2
|
|
(fn (y x) (atan2 (js-to-number y) (js-to-number x))))
|
|
(define js-math-sinh (fn (x) (sinh (js-to-number x))))
|
|
(define js-math-cosh (fn (x) (cosh (js-to-number x))))
|
|
(define js-math-tanh (fn (x) (tanh (js-to-number x))))
|
|
(define js-math-asinh (fn (x) (asinh (js-to-number x))))
|
|
(define js-math-acosh (fn (x) (acosh (js-to-number x))))
|
|
(define js-math-atanh (fn (x) (atanh (js-to-number x))))
|
|
(define js-math-exp (fn (x) (exp (js-to-number x))))
|
|
(define js-math-log (fn (x) (log (js-to-number x))))
|
|
(define js-math-log2 (fn (x) (log2 (js-to-number x))))
|
|
(define js-math-log10 (fn (x) (log10 (js-to-number x))))
|
|
(define js-math-expm1 (fn (x) (expm1 (js-to-number x))))
|
|
(define js-math-log1p (fn (x) (log1p (js-to-number x))))
|
|
(define
|
|
js-math-clz32
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((x (if (empty? args) 0 (js-to-number (nth args 0)))))
|
|
(let
|
|
((n (modulo (floor x) 4294967296)))
|
|
(if (= n 0) 32 (- 31 (floor (log2 n))))))))
|
|
(define
|
|
js-math-imul
|
|
(fn
|
|
(a b)
|
|
(let
|
|
((a32 (modulo (floor (js-to-number a)) 4294967296))
|
|
(b32 (modulo (floor (js-to-number b)) 4294967296)))
|
|
(let
|
|
((result (modulo (* a32 b32) 4294967296)))
|
|
(if (>= result 2147483648) (- result 4294967296) result)))))
|
|
(define js-math-fround (fn (x) (js-to-number x)))
|
|
(define Math {:atan js-math-atan :sign js-math-sign :LN2 0.693147 :cos js-math-cos :imul js-math-imul :min js-math-min :acos js-math-acos :log10 js-math-log10 :LOG10E 0.434294 :tanh js-math-tanh :abs js-math-abs :round js-math-round :log js-math-log :sqrt js-math-sqrt :cosh js-math-cosh :tan js-math-tan :floor js-math-floor :exp js-math-exp :asin js-math-asin :clz32 js-math-clz32 :random js-math-random :LN10 2.30259 :SQRT1_2 0.707107 :sinh js-math-sinh :E 2.71828 :fround js-math-fround :cbrt js-math-cbrt :log1p js-math-log1p :SQRT2 1.41421 :max js-math-max :log2 js-math-log2 :ceil js-math-ceil :pow js-math-pow :sin js-math-sin :hypot js-math-hypot :LOG2E 1.4427 :atanh js-math-atanh :asinh js-math-asinh :acosh js-math-acosh :PI 3.14159 :atan2 js-math-atan2 :trunc js-math-trunc :expm1 js-math-expm1}))
|
|
|
|
(define
|
|
js-number-is-finite
|
|
(fn
|
|
(v)
|
|
(and
|
|
(number? v)
|
|
(not (js-number-is-nan v))
|
|
(not (= v inf))
|
|
(not (= v -inf)))))
|
|
|
|
(define
|
|
js-number-is-nan
|
|
(fn
|
|
(v)
|
|
(and (number? v) (or (= (inspect v) "nan") (= (inspect v) "-nan")))))
|
|
|
|
(define
|
|
js-number-is-integer
|
|
(fn
|
|
(v)
|
|
(and (number? v) (js-number-is-finite v) (= v (js-math-trunc v)))))
|
|
|
|
(define
|
|
js-number-is-safe-integer
|
|
(fn (v) (and (js-number-is-integer v) (<= (js-math-abs v) 9007199254740991))))
|
|
|
|
(define
|
|
js-global-is-finite
|
|
(fn (v) (js-number-is-finite (js-to-number v))))
|
|
|
|
(define js-global-is-nan (fn (v) (js-number-is-nan (js-to-number v))))
|
|
|
|
(define
|
|
js-number-this-val
|
|
(fn ()
|
|
(let ((this-val (js-this)))
|
|
(cond
|
|
((or (= (type-of this-val) "number") (= (type-of this-val) "rational"))
|
|
(js-numeric-norm this-val))
|
|
((and (= (type-of this-val) "dict") (contains? (keys this-val) "__js_number_value__"))
|
|
(get this-val "__js_number_value__"))
|
|
(else
|
|
(raise (js-new-call TypeError (js-args "Number.prototype method requires a Number"))))))))
|
|
|
|
(define Number {:MIN_SAFE_INTEGER -9007199254740991 :MIN_VALUE 4.94066e-324 :isNaN js-number-is-nan :isSafeInteger js-number-is-safe-integer :NEGATIVE_INFINITY (- 0 (js-infinity-value)) :NaN (js-nan-value) :prototype {:toFixed {:__callable__ (fn (d) (js-number-to-fixed (js-number-this-val) (if (= d nil) 0 (js-to-number d)))) :length 1 :name "toFixed"} :toExponential {:__callable__ (fn (&rest args) (js-number-to-string (js-number-this-val))) :length 1 :name "toExponential"} :toLocaleString {:__callable__ (fn () (js-number-to-string (js-number-this-val))) :length 0 :name "toLocaleString"} :toString {:__callable__ (fn (&rest args) (let ((this-val (js-number-this-val)) (radix (if (empty? args) 10 (js-to-number (nth args 0))))) (js-num-to-str-radix this-val (if (or (= radix nil) (js-undefined? radix)) 10 radix)))) :length 1 :name "toString"} :toPrecision {:__callable__ (fn (&rest args) (js-number-to-string (js-number-this-val))) :length 1 :name "toPrecision"} :valueOf {:__callable__ (fn (&rest args) (js-number-this-val)) :length 0 :name "valueOf"}} :isInteger js-number-is-integer :__callable__ js-to-number :MAX_VALUE (js-max-value-approx) :POSITIVE_INFINITY (js-infinity-value) :isFinite js-number-is-finite :MAX_SAFE_INTEGER 9007199254740991 :EPSILON 2.22045e-16})
|
|
|
|
(dict-set! Number "length" 1)
|
|
|
|
(dict-set! Number "name" "Number")
|
|
|
|
(dict-set! (get Number "prototype") "constructor" Number)
|
|
|
|
(dict-set!
|
|
Number
|
|
"__callable__"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((raw (if (= (len args) 0) 0 (js-to-number (nth args 0)))))
|
|
(let
|
|
((this-val (js-this)))
|
|
(if
|
|
(and
|
|
(dict? this-val)
|
|
(contains? (keys this-val) "__proto__")
|
|
(= (get this-val "__proto__") (get Number "prototype")))
|
|
(begin (dict-set! this-val "__js_number_value__" raw) this-val)
|
|
raw)))))
|
|
|
|
(dict-set!
|
|
(get Number "prototype")
|
|
"valueOf"
|
|
(fn
|
|
()
|
|
(let
|
|
((this-val (js-this)))
|
|
(if
|
|
(and
|
|
(dict? this-val)
|
|
(contains? (keys this-val) "__js_number_value__"))
|
|
(get this-val "__js_number_value__")
|
|
this-val))))
|
|
|
|
(dict-set!
|
|
(get Number "prototype")
|
|
"toString"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-raw (js-this)))
|
|
(let
|
|
((this-val (if (and (dict? this-raw) (contains? (keys this-raw) "__js_number_value__")) (get this-raw "__js_number_value__") this-raw)))
|
|
(let
|
|
((radix (if (empty? args) 10 (js-to-number (nth args 0)))))
|
|
(js-num-to-str-radix
|
|
this-val
|
|
(if (or (= radix nil) (js-undefined? radix)) 10 radix)))))))
|
|
|
|
(define isFinite js-global-is-finite)
|
|
|
|
(define isNaN js-global-is-nan)
|
|
|
|
(define __js_microtask_queue__ (dict))
|
|
|
|
(dict-set! __js_microtask_queue__ "q" (list))
|
|
|
|
(define
|
|
js-mt-push!
|
|
(fn
|
|
(thunk)
|
|
(dict-set!
|
|
__js_microtask_queue__
|
|
"q"
|
|
(append (get __js_microtask_queue__ "q") (list thunk)))))
|
|
|
|
(define
|
|
js-mt-pop!
|
|
(fn
|
|
()
|
|
(let
|
|
((q (get __js_microtask_queue__ "q")))
|
|
(if
|
|
(empty? q)
|
|
nil
|
|
(let
|
|
((h (first q)))
|
|
(dict-set! __js_microtask_queue__ "q" (rest q))
|
|
h)))))
|
|
|
|
(define js-mt-empty? (fn () (empty? (get __js_microtask_queue__ "q"))))
|
|
|
|
(define
|
|
js-drain-microtasks!
|
|
(fn
|
|
()
|
|
(cond
|
|
((js-mt-empty?) :js-undefined)
|
|
(else (let ((t (js-mt-pop!))) (t) (js-drain-microtasks!))))))
|
|
|
|
(define
|
|
js-promise?
|
|
(fn
|
|
(v)
|
|
(and
|
|
(= (type-of v) "dict")
|
|
(dict-has? v "__js_promise__")
|
|
(= (get v "__js_promise__") true))))
|
|
|
|
(define
|
|
js-make-promise
|
|
(fn
|
|
()
|
|
(let
|
|
((p (dict)))
|
|
(dict-set! p "__js_promise__" true)
|
|
(dict-set! p "state" "pending")
|
|
(dict-set! p "value" :js-undefined)
|
|
(dict-set! p "callbacks" (list))
|
|
p)))
|
|
|
|
(define
|
|
js-promise-resolve!
|
|
(fn
|
|
(p value)
|
|
(cond
|
|
((not (= (get p "state") "pending")) :js-undefined)
|
|
((js-promise? value)
|
|
(js-promise-then-internal!
|
|
value
|
|
(fn (v) (js-promise-resolve! p v))
|
|
(fn (r) (js-promise-reject! p r))))
|
|
(else
|
|
(begin
|
|
(dict-set! p "state" "fulfilled")
|
|
(dict-set! p "value" value)
|
|
(js-promise-flush-callbacks! p))))))
|
|
|
|
(define
|
|
js-promise-reject!
|
|
(fn
|
|
(p reason)
|
|
(cond
|
|
((not (= (get p "state") "pending")) :js-undefined)
|
|
(else
|
|
(begin
|
|
(dict-set! p "state" "rejected")
|
|
(dict-set! p "value" reason)
|
|
(js-promise-flush-callbacks! p))))))
|
|
|
|
(define
|
|
js-iterable-to-list
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((list? v) v)
|
|
((= (type-of v) "string") (js-string-to-list v 0 (list)))
|
|
((dict? v)
|
|
(cond
|
|
((contains? (keys v) "length") (js-arraylike-to-list v))
|
|
(else
|
|
(let
|
|
((result (list)))
|
|
(begin
|
|
(for-each (fn (k) (append! result (get v k))) (keys v))
|
|
result)))))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-arraylike-to-list
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((list? v) v)
|
|
((= (type-of v) "string") (js-string-to-list v 0 (list)))
|
|
((dict? v)
|
|
(let
|
|
((n-val (get v "length")))
|
|
(if
|
|
(or (= n-val nil) (js-undefined? n-val))
|
|
(list)
|
|
(let
|
|
((n (js-to-number n-val)))
|
|
(js-arraylike-to-list-loop v 0 n (list))))))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-arraylike-to-list-loop
|
|
(fn
|
|
(v i n acc)
|
|
(if
|
|
(>= i n)
|
|
acc
|
|
(let
|
|
((val (get v (str i))))
|
|
(do
|
|
(append! acc (if (= val nil) :js-undefined val))
|
|
(js-arraylike-to-list-loop v (+ i 1) n acc))))))
|
|
|
|
(define
|
|
js-string-to-list
|
|
(fn
|
|
(s i acc)
|
|
(if
|
|
(>= i (len s))
|
|
acc
|
|
(begin
|
|
(append! acc (char-at s i))
|
|
(js-string-to-list s (+ i 1) acc)))))
|
|
|
|
(define
|
|
js-key-internal?
|
|
(fn
|
|
(k)
|
|
(or (= k "__js_order__") (= k "__proto__"))))
|
|
|
|
(define
|
|
js-for-in-keys
|
|
(fn
|
|
(o)
|
|
(let
|
|
((result (list)))
|
|
(begin (js-for-in-walk o result) result))))
|
|
|
|
(define
|
|
js-for-in-walk
|
|
(fn
|
|
(o acc)
|
|
(cond
|
|
((not (dict? o)) nil)
|
|
((= o (get Object "prototype")) nil)
|
|
((= o (get Array "prototype")) nil)
|
|
((= o (get Number "prototype")) nil)
|
|
((= o (get String "prototype")) nil)
|
|
((= o (get Boolean "prototype")) nil)
|
|
((= o (get Date "prototype")) nil)
|
|
((= o (get RegExp "prototype")) nil)
|
|
((= o (get Map "prototype")) nil)
|
|
((= o (get Set "prototype")) nil)
|
|
((= o (get js-function-global "prototype")) nil)
|
|
(else
|
|
(let
|
|
((own (js-object-keys o)))
|
|
(begin
|
|
(for-each
|
|
(fn (k) (if (contains? acc k) nil (append! acc k)))
|
|
own)
|
|
(cond
|
|
((contains? (keys o) "__proto__")
|
|
(js-for-in-walk (get o "__proto__") acc))
|
|
(else nil))))))))
|
|
|
|
(define
|
|
js-object-keys
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((or (= o nil) (js-undefined? o))
|
|
(raise (js-new-call TypeError (js-args "Object.keys called on null or undefined"))))
|
|
((= (type-of o) "string")
|
|
(let ((result (list)) (n (len o)))
|
|
(begin
|
|
(js-string-keys-loop result 0 n)
|
|
result)))
|
|
((list? o)
|
|
(let ((result (list)) (n (len o)))
|
|
(begin
|
|
(js-string-keys-loop result 0 n)
|
|
result)))
|
|
((dict? o)
|
|
(cond
|
|
((contains? (keys o) "__js_order__")
|
|
(let
|
|
((result (list)))
|
|
(begin
|
|
(for-each
|
|
(fn (k) (if (js-key-internal? k) nil (append! result k)))
|
|
(get o "__js_order__"))
|
|
result)))
|
|
(else
|
|
(let
|
|
((result (list)))
|
|
(begin
|
|
(for-each
|
|
(fn (k) (if (js-key-internal? k) nil (append! result k)))
|
|
(keys o))
|
|
result)))))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-string-keys-loop
|
|
(fn
|
|
(acc i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(append! acc (js-to-string i))
|
|
(js-string-keys-loop acc (+ i 1) n))))))
|
|
|
|
(define
|
|
js-object-values
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((or (= o nil) (js-undefined? o))
|
|
(raise (js-new-call TypeError (js-args "Object.values called on null or undefined"))))
|
|
((= (type-of o) "string")
|
|
(let ((result (list)) (n (len o)))
|
|
(begin
|
|
(js-string-values-loop result o 0 n)
|
|
result)))
|
|
((dict? o)
|
|
(let
|
|
((result (list)))
|
|
(for-each
|
|
(fn (k) (if (js-key-internal? k) nil (append! result (get o k))))
|
|
(js-object-keys o))
|
|
result))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-string-values-loop
|
|
(fn
|
|
(acc s i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(append! acc (char-at s i))
|
|
(js-string-values-loop acc s (+ i 1) n))))))
|
|
|
|
(define
|
|
js-object-entries
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((or (= o nil) (js-undefined? o))
|
|
(raise (js-new-call TypeError (js-args "Object.entries called on null or undefined"))))
|
|
((= (type-of o) "string")
|
|
(let ((result (list)) (n (len o)))
|
|
(begin
|
|
(js-string-entries-loop result o 0 n)
|
|
result)))
|
|
((dict? o)
|
|
(let
|
|
((result (list)))
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(if
|
|
(js-key-internal? k)
|
|
nil
|
|
(let
|
|
((pair (list)))
|
|
(begin
|
|
(append! pair k)
|
|
(append! pair (get o k))
|
|
(append! result pair)))))
|
|
(js-object-keys o))
|
|
result))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-string-entries-loop
|
|
(fn
|
|
(acc s i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(let ((pair (list)))
|
|
(begin
|
|
(append! pair (js-to-string i))
|
|
(append! pair (char-at s i))
|
|
(append! acc pair)
|
|
(js-string-entries-loop acc s (+ i 1) n)))))))
|
|
|
|
(define
|
|
js-object-assign
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0)
|
|
(raise (js-new-call TypeError (js-args "Object.assign called on null or undefined"))))
|
|
(else
|
|
(let
|
|
((raw-target (nth args 0)))
|
|
(cond
|
|
((or (= raw-target nil) (js-undefined? raw-target))
|
|
(raise (js-new-call TypeError (js-args "Object.assign called on null or undefined"))))
|
|
(else
|
|
(let
|
|
((target (js-coerce-this-arg raw-target)))
|
|
(for-each
|
|
(fn
|
|
(src)
|
|
(cond
|
|
((or (= src nil) (js-undefined? src)) nil)
|
|
((dict? src)
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(if (js-key-internal? k) nil (dict-set! target k (get src k))))
|
|
(js-object-keys src)))
|
|
((= (type-of src) "string")
|
|
(let
|
|
((n (len src)))
|
|
(begin (js-object-assign-string-loop target src 0 n))))))
|
|
(rest args))
|
|
target))))))))
|
|
|
|
(define
|
|
js-object-assign-string-loop
|
|
(fn
|
|
(target s i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(dict-set! target (js-to-string i) (char-at s i))
|
|
(js-object-assign-string-loop target s (+ i 1) n))))))
|
|
|
|
(define js-object-freeze (fn (o) o))
|
|
|
|
(define __js_ctor_proto__ (dict))
|
|
|
|
(define
|
|
js-object-get-prototype-of
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((= o nil) (error "TypeError: Cannot convert null to object"))
|
|
((js-undefined? o)
|
|
(error "TypeError: Cannot convert undefined to object"))
|
|
((dict? o)
|
|
(cond
|
|
((contains? (keys o) "__proto__") (get o "__proto__"))
|
|
(else nil)))
|
|
((js-function? o)
|
|
(let
|
|
((id (js-ctor-id o)))
|
|
(cond
|
|
((dict-has? __js_ctor_proto__ id)
|
|
(get __js_ctor_proto__ id))
|
|
(else nil))))
|
|
(else nil))))
|
|
|
|
(define
|
|
js-object-set-prototype-of
|
|
(fn
|
|
(o proto)
|
|
(begin (when (dict? o) (dict-set! o "__proto__" proto)) o)))
|
|
|
|
(define
|
|
js-object-create
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((proto (if (empty? args) nil (nth args 0))))
|
|
(let
|
|
((obj (dict)))
|
|
(begin
|
|
(when (not (= proto nil)) (dict-set! obj "__proto__" proto))
|
|
(when
|
|
(and (>= (len args) 2) (dict? (nth args 1)))
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(dict-set!
|
|
obj
|
|
k
|
|
(get (get (nth args 1) k) "value")))
|
|
(keys (nth args 1))))
|
|
obj)))))
|
|
|
|
(define
|
|
js-object-define-property
|
|
(fn
|
|
(o key desc)
|
|
(begin
|
|
(when
|
|
(and (dict? o) (dict? desc) (contains? (keys desc) "value"))
|
|
(dict-set! o (js-to-string key) (get desc "value")))
|
|
o)))
|
|
|
|
(define
|
|
js-object-define-properties
|
|
(fn
|
|
(o descs)
|
|
(begin
|
|
(when
|
|
(and (dict? o) (dict? descs))
|
|
(for-each
|
|
(fn (k) (js-object-define-property o k (get descs k)))
|
|
(keys descs)))
|
|
o)))
|
|
|
|
(define
|
|
js-object-get-own-property-names
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((or (= o nil) (js-undefined? o))
|
|
(raise (js-new-call TypeError (js-args "Object.getOwnPropertyNames called on null or undefined"))))
|
|
((list? o)
|
|
(let
|
|
((r (list)))
|
|
(begin
|
|
(js-list-keys-loop o 0 r)
|
|
(append! r "length")
|
|
r)))
|
|
((= (type-of o) "string")
|
|
(let ((result (list)) (n (len o)))
|
|
(begin
|
|
(js-string-keys-loop result 0 n)
|
|
(append! result "length")
|
|
result)))
|
|
((dict? o) (js-own-property-names-ordered o))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-own-property-names-ordered
|
|
(fn
|
|
(o)
|
|
(let
|
|
((all (js-object-keys o))
|
|
(ints (list))
|
|
(rest (list)))
|
|
(begin
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(if (js-int-key? k) (append! ints k) (append! rest k)))
|
|
all)
|
|
(append (js-sort-int-keys ints) rest)))))
|
|
|
|
(define
|
|
js-int-key?
|
|
(fn
|
|
(k)
|
|
(cond
|
|
((not (= (type-of k) "string")) false)
|
|
((= (len k) 0) false)
|
|
(else (js-int-key-loop? k 0 (len k))))))
|
|
|
|
(define
|
|
js-int-key-loop?
|
|
(fn
|
|
(s i n)
|
|
(cond
|
|
((>= i n) true)
|
|
((let ((c (char-code-at s i))) (and (>= c 48) (<= c 57)))
|
|
(js-int-key-loop? s (+ i 1) n))
|
|
(else false))))
|
|
|
|
(define
|
|
js-sort-int-keys
|
|
(fn
|
|
(lst)
|
|
(let
|
|
((nums (map js-string-to-number lst)))
|
|
(begin
|
|
(js-sort-numbers! nums)
|
|
(map (fn (n) (str (js-num-to-int n))) nums)))))
|
|
|
|
(define
|
|
js-sort-numbers!
|
|
(fn
|
|
(lst)
|
|
(let ((n (len lst)))
|
|
(js-bubble-sort! lst 0 n))))
|
|
|
|
(define
|
|
js-bubble-sort!
|
|
(fn
|
|
(lst i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin (js-bubble-sort-inner! lst 0 (- n i 1)) (js-bubble-sort! lst (+ i 1) n))))))
|
|
|
|
(define
|
|
js-bubble-sort-inner!
|
|
(fn
|
|
(lst j stop)
|
|
(cond
|
|
((>= j stop) nil)
|
|
((> (nth lst j) (nth lst (+ j 1)))
|
|
(let
|
|
((a (nth lst j)) (b (nth lst (+ j 1))))
|
|
(begin
|
|
(set-nth! lst j b)
|
|
(set-nth! lst (+ j 1) a)
|
|
(js-bubble-sort-inner! lst (+ j 1) stop))))
|
|
(else (js-bubble-sort-inner! lst (+ j 1) stop)))))
|
|
|
|
(define
|
|
js-object-get-own-property-descriptor
|
|
(fn
|
|
(o key)
|
|
(let
|
|
((sk (js-to-string key)))
|
|
(cond
|
|
((and (dict? o) (js-key-internal? sk)) :js-undefined)
|
|
((and (dict? o) (contains? (keys o) sk))
|
|
{:configurable true :enumerable true :value (get o sk) :writable true})
|
|
((list? o)
|
|
(cond
|
|
((= sk "length")
|
|
{:configurable false :enumerable false :value (len o) :writable true})
|
|
((js-int-key? sk)
|
|
(let
|
|
((i (js-num-to-int (js-string-to-number sk))))
|
|
(cond
|
|
((and (>= i 0) (< i (len o)))
|
|
{:configurable true :enumerable true :value (nth o i) :writable true})
|
|
(else :js-undefined))))
|
|
(else :js-undefined)))
|
|
((and (= (type-of o) "string"))
|
|
(cond
|
|
((= sk "length")
|
|
{:configurable false :enumerable false :value (len o) :writable false})
|
|
((js-int-key? sk)
|
|
(let
|
|
((i (js-num-to-int (js-string-to-number sk))))
|
|
(cond
|
|
((and (>= i 0) (< i (len o)))
|
|
{:configurable false :enumerable true :value (char-at o i) :writable false})
|
|
(else :js-undefined))))
|
|
(else :js-undefined)))
|
|
(else :js-undefined)))))
|
|
|
|
(define
|
|
js-object-get-own-property-descriptors
|
|
(fn
|
|
(o)
|
|
(let
|
|
((out (dict)))
|
|
(begin
|
|
(when
|
|
(dict? o)
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(dict-set! out k (js-object-get-own-property-descriptor o k)))
|
|
(keys o)))
|
|
out))))
|
|
|
|
(define js-object-is-extensible (fn (o) (not (js-undefined? o))))
|
|
|
|
(define js-object-is-frozen (fn (o) false))
|
|
|
|
(define js-object-is-sealed (fn (o) false))
|
|
|
|
(define js-object-prevent-extensions (fn (o) o))
|
|
|
|
(define js-object-seal (fn (o) o))
|
|
|
|
(define
|
|
js-object-is
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((and (js-number-is-nan a) (js-number-is-nan b)) true)
|
|
((and (= a 0) (= b 0))
|
|
(let ((ia (inspect a)) (ib (inspect b))) (= ia ib)))
|
|
(else (js-strict-eq a b)))))
|
|
|
|
(define
|
|
js-object-from-entries
|
|
(fn
|
|
(iter)
|
|
(let
|
|
((out (dict)) (lst (js-iterable-to-list iter)))
|
|
(begin
|
|
(for-each
|
|
(fn
|
|
(pair)
|
|
(when
|
|
(and (list? pair) (>= (len pair) 2))
|
|
(dict-set!
|
|
out
|
|
(js-to-string (nth pair 0))
|
|
(nth pair 1))))
|
|
lst)
|
|
out))))
|
|
|
|
(define
|
|
js-object-has-own
|
|
(fn
|
|
(o key)
|
|
(cond
|
|
((dict? o) (contains? (keys o) (js-to-string key)))
|
|
((list? o)
|
|
(let
|
|
((idx (js-to-number key)))
|
|
(and (>= idx 0) (< idx (len o)) (integer? idx))))
|
|
(else false))))
|
|
|
|
(define Object {:keys js-object-keys :getPrototypeOf js-object-get-prototype-of :isSealed js-object-is-sealed :seal js-object-seal :create js-object-create :isExtensible js-object-is-extensible :is js-object-is :setPrototypeOf js-object-set-prototype-of :getOwnPropertyNames js-object-get-own-property-names :getOwnPropertyDescriptors js-object-get-own-property-descriptors :defineProperty js-object-define-property :fromEntries js-object-from-entries :getOwnPropertyDescriptor js-object-get-own-property-descriptor :assign js-object-assign :isFrozen js-object-is-frozen :freeze js-object-freeze :values js-object-values :hasOwn js-object-has-own :prototype {:hasOwnProperty (fn (k) (let ((o (js-this))) (js-object-has-own o k))) :toLocaleString (fn () "[object Object]") :isPrototypeOf (fn (o) (let ((this-val (js-this))) (cond ((not (dict? o)) false) (else (let ((proto (if (contains? (keys o) "__proto__") (get o "__proto__") nil))) (cond ((= proto this-val) true) ((= proto nil) false) (else ((get (get Object "prototype") "isPrototypeOf") proto)))))))) :toString (fn () (js-object-tostring-class (js-this))) :propertyIsEnumerable (fn (k) (let ((o (js-this))) (js-object-has-own o k))) :valueOf (fn () (js-this))} :__callable__ (fn (&rest args) (let ((this-val (js-this))) (let ((is-new (and (dict? this-val) (contains? (keys this-val) "__proto__") (= (get this-val "__proto__") (get Object "prototype"))))) (cond ((= (len args) 0) (if is-new this-val (dict))) ((or (= (nth args 0) nil) (js-undefined? (nth args 0))) (if is-new this-val (dict))) ((= (type-of (nth args 0)) "string") (js-new-call String (list (nth args 0)))) ((= (js-typeof (nth args 0)) "number") (js-new-call Number (list (nth args 0)))) ((= (js-typeof (nth args 0)) "boolean") (js-new-call Boolean (list (nth args 0)))) (else (nth args 0)))))) :preventExtensions js-object-prevent-extensions :entries js-object-entries :defineProperties js-object-define-properties})
|
|
|
|
(dict-set! Object "length" 1)
|
|
|
|
(dict-set! Object "name" "Object")
|
|
|
|
(dict-set! (get Object "prototype") "constructor" Object)
|
|
|
|
(define
|
|
js-delete-prop
|
|
(fn
|
|
(obj key)
|
|
(cond
|
|
((dict? obj)
|
|
(let
|
|
((sk (js-to-string key)))
|
|
(begin
|
|
(js-obj-order-remove! obj sk)
|
|
(dict-delete! obj sk)
|
|
true)))
|
|
(else true))))
|
|
|
|
(define
|
|
js-optchain-get
|
|
(fn
|
|
(obj key)
|
|
(if
|
|
(or (= obj nil) (js-undefined? obj))
|
|
js-undefined
|
|
(js-get-prop obj key))))
|
|
|
|
(define
|
|
js-optchain-call
|
|
(fn
|
|
(fn-val args)
|
|
(if
|
|
(or (= fn-val nil) (js-undefined? fn-val))
|
|
js-undefined
|
|
(js-call-plain fn-val args))))
|
|
|
|
(define
|
|
js-array-spread-build
|
|
(fn
|
|
(&rest items)
|
|
(let
|
|
((result (list)))
|
|
(for-each
|
|
(fn
|
|
(item)
|
|
(let
|
|
((kind (nth item 0)))
|
|
(cond
|
|
((= kind "js-spread")
|
|
(for-each
|
|
(fn (x) (append! result x))
|
|
(js-iterable-to-list (nth item 1))))
|
|
(else (append! result (nth item 1))))))
|
|
items)
|
|
result)))
|
|
|
|
(define js-array-is-array (fn (v) (list? v)))
|
|
|
|
(define js-array-of (fn (&rest args) args))
|
|
|
|
(define
|
|
js-array-proto-fn-length
|
|
(fn
|
|
(name)
|
|
(cond
|
|
((= name "concat") 1)
|
|
((= name "copyWithin") 2)
|
|
((= name "every") 1)
|
|
((= name "fill") 1)
|
|
((= name "filter") 1)
|
|
((= name "find") 1)
|
|
((= name "findIndex") 1)
|
|
((= name "findLast") 1)
|
|
((= name "findLastIndex") 1)
|
|
((= name "flat") 0)
|
|
((= name "flatMap") 1)
|
|
((= name "forEach") 1)
|
|
((= name "includes") 1)
|
|
((= name "indexOf") 1)
|
|
((= name "join") 1)
|
|
((= name "lastIndexOf") 1)
|
|
((= name "map") 1)
|
|
((= name "push") 1)
|
|
((= name "reduce") 1)
|
|
((= name "reduceRight") 1)
|
|
((= name "slice") 2)
|
|
((= name "some") 1)
|
|
((= name "sort") 1)
|
|
((= name "splice") 2)
|
|
((= name "unshift") 1)
|
|
((= name "at") 1)
|
|
((= name "toSorted") 1)
|
|
((= name "toReversed") 0)
|
|
((= name "with") 2)
|
|
(else 0))))
|
|
|
|
(define
|
|
js-array-proto-fn
|
|
(fn
|
|
(name)
|
|
{:__callable__
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-val (js-this)))
|
|
(let
|
|
((recv (cond ((list? this-val) this-val) ((and (dict? this-val) (contains? (keys this-val) "length")) (js-arraylike-to-list this-val)) (else this-val))))
|
|
(js-invoke-method recv name args))))
|
|
:length (js-array-proto-fn-length name)
|
|
:name name}))
|
|
|
|
(define
|
|
js-array-from
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0) (list))
|
|
(else
|
|
(let
|
|
((src (js-iterable-to-list (nth args 0)))
|
|
(map-fn
|
|
(if (< (len args) 2) nil (nth args 1)))
|
|
(this-arg
|
|
(if (or (< (len args) 3) (js-undefined? (nth args 2)) (= (nth args 2) nil))
|
|
js-global-this
|
|
(nth args 2))))
|
|
(if
|
|
(= map-fn nil)
|
|
(let
|
|
((result (list)))
|
|
(for-each (fn (x) (append! result x)) src)
|
|
result)
|
|
(let
|
|
((result (list)) (i 0))
|
|
(for-each
|
|
(fn
|
|
(x)
|
|
(begin
|
|
(append! result (js-call-with-this this-arg map-fn (list x i)))
|
|
(set! i (+ i 1))))
|
|
src)
|
|
result)))))))
|
|
|
|
(define Array {:of js-array-of :from js-array-from :isArray js-array-is-array :prototype {:reverse (js-array-proto-fn "reverse") :fill (js-array-proto-fn "fill") :flatMap (js-array-proto-fn "flatMap") :keys (js-array-proto-fn "keys") :forEach (js-array-proto-fn "forEach") :toString (js-array-proto-fn "toString") :copyWithin (js-array-proto-fn "copyWithin") :toReversed (js-array-proto-fn "toReversed") :pop (js-array-proto-fn "pop") :at (js-array-proto-fn "at") :push (js-array-proto-fn "push") :map (js-array-proto-fn "map") :some (js-array-proto-fn "some") :flat (js-array-proto-fn "flat") :toSorted (js-array-proto-fn "toSorted") :indexOf (js-array-proto-fn "indexOf") :unshift (js-array-proto-fn "unshift") :every (js-array-proto-fn "every") :sort (js-array-proto-fn "sort") :findIndex (js-array-proto-fn "findIndex") :toLocaleString (js-array-proto-fn "toLocaleString") :find (js-array-proto-fn "find") :includes (js-array-proto-fn "includes") :findLastIndex (js-array-proto-fn "findLastIndex") :slice (js-array-proto-fn "slice") :reduce (js-array-proto-fn "reduce") :values (js-array-proto-fn "values") :join (js-array-proto-fn "join") :reduceRight (js-array-proto-fn "reduceRight") :shift (js-array-proto-fn "shift") :filter (js-array-proto-fn "filter") :findLast (js-array-proto-fn "findLast") :concat (js-array-proto-fn "concat") :lastIndexOf (js-array-proto-fn "lastIndexOf") :splice (js-array-proto-fn "splice") :entries (js-array-proto-fn "entries")} :__callable__ (fn (&rest args) (cond ((= (len args) 0) (list)) ((and (= (len args) 1) (number? (nth args 0))) (js-make-list-of-length (js-num-to-int (nth args 0)) :js-undefined)) (else args)))})
|
|
|
|
(dict-set! Array "length" 1)
|
|
|
|
(dict-set! (get Array "prototype") "constructor" Array)
|
|
|
|
(dict-set! Array "name" "Array")
|
|
|
|
(dict-set!
|
|
(get Array "prototype")
|
|
"toString"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-val (js-this)))
|
|
(let
|
|
((items (cond ((list? this-val) this-val) ((and (dict? this-val) (contains? (keys this-val) "length")) (js-arraylike-to-list this-val)) (else (list)))))
|
|
(js-list-join items ",")))))
|
|
|
|
(define
|
|
js-string-from-char-code
|
|
(fn (&rest args) (js-string-from-char-code-loop args 0 "")))
|
|
|
|
(define
|
|
js-string-from-code-point-loop
|
|
(fn
|
|
(args i acc)
|
|
(if
|
|
(>= i (len args))
|
|
acc
|
|
(let
|
|
((cp (floor (js-to-number (nth args i)))))
|
|
(if
|
|
(< cp 65536)
|
|
(js-string-from-code-point-loop
|
|
args
|
|
(+ i 1)
|
|
(str acc (js-code-to-char (js-num-to-int cp))))
|
|
(let
|
|
((hi (+ 55296 (floor (/ (- cp 65536) 1024))))
|
|
(lo (+ 56320 (modulo (- cp 65536) 1024))))
|
|
(js-string-from-code-point-loop
|
|
args
|
|
(+ i 1)
|
|
(str
|
|
(str acc (js-code-to-char (js-num-to-int hi)))
|
|
(js-code-to-char (js-num-to-int lo))))))))))
|
|
|
|
(define
|
|
js-string-from-code-point
|
|
(fn (&rest args) (js-string-from-code-point-loop args 0 "")))
|
|
|
|
(define
|
|
js-string-from-char-code-loop
|
|
(fn
|
|
(args i acc)
|
|
(if
|
|
(>= i (len args))
|
|
acc
|
|
(let
|
|
((n (js-to-number (nth args i))))
|
|
(let
|
|
((code (if (js-global-is-nan n) 0 (modulo (js-math-trunc n) 65536))))
|
|
(js-string-from-char-code-loop
|
|
args
|
|
(+ i 1)
|
|
(str acc (char-from-code code))))))))
|
|
|
|
(define
|
|
js-string-proto-fn-length
|
|
(fn
|
|
(name)
|
|
(cond
|
|
((= name "concat") 1)
|
|
((= name "indexOf") 1)
|
|
((= name "lastIndexOf") 1)
|
|
((= name "slice") 2)
|
|
((= name "substring") 2)
|
|
((= name "substr") 2)
|
|
((= name "split") 2)
|
|
((= name "replace") 2)
|
|
((= name "replaceAll") 2)
|
|
((= name "match") 1)
|
|
((= name "matchAll") 1)
|
|
((= name "search") 1)
|
|
((= name "charAt") 1)
|
|
((= name "charCodeAt") 1)
|
|
((= name "codePointAt") 1)
|
|
((= name "at") 1)
|
|
((= name "padStart") 1)
|
|
((= name "padEnd") 1)
|
|
((= name "repeat") 1)
|
|
((= name "startsWith") 1)
|
|
((= name "endsWith") 1)
|
|
((= name "includes") 1)
|
|
((= name "localeCompare") 1)
|
|
((= name "normalize") 0)
|
|
(else 0))))
|
|
|
|
(define
|
|
js-string-proto-fn
|
|
(fn
|
|
(name)
|
|
{:__callable__
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-val (js-this)))
|
|
(let
|
|
((s (cond ((or (= this-val nil) (js-undefined? this-val)) (raise (js-new-call TypeError (js-args (str "String.prototype." name " called on null or undefined"))))) ((= (type-of this-val) "string") this-val) ((and (= (type-of this-val) "dict") (contains? (keys this-val) "__js_string_value__")) (get this-val "__js_string_value__")) (else (js-to-string this-val)))))
|
|
(js-invoke-method s name args))))
|
|
:length (js-string-proto-fn-length name)
|
|
:name name}))
|
|
|
|
(define String {:raw (fn (&rest args) (if (empty? args) "" (js-to-string (nth args 0)))) :prototype {:replace (js-string-proto-fn "replace") :toLocaleUpperCase (js-string-proto-fn "toLocaleUpperCase") :trimStart (js-string-proto-fn "trimStart") :includes (js-string-proto-fn "includes") :charAt (js-string-proto-fn "charAt") :match (js-string-proto-fn "match") :charCodeAt (js-string-proto-fn "charCodeAt") :slice (js-string-proto-fn "slice") :toString (js-string-proto-fn "toString") :toLocaleLowerCase (js-string-proto-fn "toLocaleLowerCase") :toUpperCase (js-string-proto-fn "toUpperCase") :trimEnd (js-string-proto-fn "trimEnd") :repeat (js-string-proto-fn "repeat") :padStart (js-string-proto-fn "padStart") :search (js-string-proto-fn "search") :substring (js-string-proto-fn "substring") :replaceAll (js-string-proto-fn "replaceAll") :trim (js-string-proto-fn "trim") :valueOf (js-string-proto-fn "valueOf") :at (js-string-proto-fn "at") :normalize (js-string-proto-fn "normalize") :split (js-string-proto-fn "split") :endsWith (js-string-proto-fn "endsWith") :indexOf (js-string-proto-fn "indexOf") :localeCompare (js-string-proto-fn "localeCompare") :toLowerCase (js-string-proto-fn "toLowerCase") :concat (js-string-proto-fn "concat") :startsWith (js-string-proto-fn "startsWith") :padEnd (js-string-proto-fn "padEnd") :codePointAt (js-string-proto-fn "codePointAt") :lastIndexOf (js-string-proto-fn "lastIndexOf")} :__callable__ (fn (&rest args) (if (= (len args) 0) "" (js-to-string (nth args 0)))) :fromCharCode js-string-from-char-code})
|
|
|
|
(dict-set! String "length" 1)
|
|
|
|
(dict-set! (get String "prototype") "constructor" String)
|
|
|
|
(dict-set! String "name" "String")
|
|
|
|
(dict-set! String "fromCodePoint" js-string-from-code-point)
|
|
|
|
(dict-set! String "fromCharCode" js-string-from-char-code)
|
|
|
|
(dict-set!
|
|
String
|
|
"__callable__"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((raw (if (= (len args) 0) "" (js-to-string (nth args 0)))))
|
|
(let
|
|
((this-val (js-this)))
|
|
(if
|
|
(and
|
|
(dict? this-val)
|
|
(contains? (keys this-val) "__proto__")
|
|
(= (get this-val "__proto__") (get String "prototype")))
|
|
(begin
|
|
(dict-set! this-val "__js_string_value__" raw)
|
|
(dict-set! this-val "length" (len raw))
|
|
this-val)
|
|
raw)))))
|
|
|
|
(define Boolean {:__callable__ (fn (&rest args) (if (= (len args) 0) false (js-to-boolean (nth args 0))))})
|
|
|
|
(dict-set!
|
|
(get String "prototype")
|
|
"matchAll"
|
|
(js-string-proto-fn "matchAll"))
|
|
|
|
(dict-set! Boolean "length" 1)
|
|
|
|
(dict-set! Boolean "name" "Boolean")
|
|
|
|
(dict-set! Boolean "prototype" {:constructor Boolean})
|
|
|
|
(dict-set!
|
|
Boolean
|
|
"__callable__"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((val (if (> (len args) 0) (js-to-boolean (nth args 0)) false)))
|
|
(let
|
|
((this-val (js-this)))
|
|
(if
|
|
(dict? this-val)
|
|
(begin
|
|
(dict-set! this-val "__js_boolean_value__" val)
|
|
(dict-set! this-val "__proto__" (get Boolean "prototype"))
|
|
this-val)
|
|
(if val true false))))))
|
|
|
|
(dict-set!
|
|
(get Boolean "prototype")
|
|
"valueOf"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-val (js-this)))
|
|
(cond
|
|
((= (type-of this-val) "boolean") this-val)
|
|
((and
|
|
(= (type-of this-val) "dict")
|
|
(contains? (keys this-val) "__js_boolean_value__"))
|
|
(get this-val "__js_boolean_value__"))
|
|
(else (raise (js-new-call TypeError (js-args "Boolean.prototype.valueOf requires a Boolean"))))))))
|
|
|
|
(dict-set!
|
|
(get Boolean "prototype")
|
|
"toString"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-val (js-this)))
|
|
(cond
|
|
((= (type-of this-val) "boolean") (if this-val "true" "false"))
|
|
((and (= (type-of this-val) "dict") (contains? (keys this-val) "__js_boolean_value__"))
|
|
(if (get this-val "__js_boolean_value__") "true" "false"))
|
|
(else (raise (js-new-call TypeError (js-args "Boolean.prototype.toString requires a Boolean"))))))))
|
|
|
|
(define
|
|
parseInt
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0) (js-nan-value))
|
|
(else
|
|
(let
|
|
((s (js-to-string (nth args 0)))
|
|
(radix-arg
|
|
(if
|
|
(< (len args) 2)
|
|
10
|
|
(js-to-number (nth args 1)))))
|
|
(let
|
|
((radix (if (or (js-number-is-nan radix-arg) (= radix-arg 0)) 10 radix-arg)))
|
|
(js-parse-int-str (js-trim s) (js-math-trunc radix))))))))
|
|
|
|
(define
|
|
js-parse-int-str
|
|
(fn
|
|
(s radix)
|
|
(cond
|
|
((= s "") (js-nan-value))
|
|
(else
|
|
(let
|
|
((first (char-at s 0)))
|
|
(cond
|
|
((= first "-")
|
|
(let
|
|
((r (js-parse-int-digits (js-string-slice s 1 (len s)) radix 0 false)))
|
|
(if (js-number-is-nan r) r (- 0 r))))
|
|
((= first "+")
|
|
(js-parse-int-digits
|
|
(js-string-slice s 1 (len s))
|
|
radix
|
|
0
|
|
false))
|
|
(else (js-parse-int-digits s radix 0 false))))))))
|
|
|
|
(define
|
|
js-parse-int-digits
|
|
(fn
|
|
(s radix acc sawdigit)
|
|
(if
|
|
(= (len s) 0)
|
|
(if sawdigit acc (js-nan-value))
|
|
(let
|
|
((c (char-at s 0)))
|
|
(let
|
|
((d (js-digit-value c radix)))
|
|
(if
|
|
(= d -1)
|
|
(if sawdigit acc (js-nan-value))
|
|
(js-parse-int-digits
|
|
(js-string-slice s 1 (len s))
|
|
radix
|
|
(+ (* acc radix) d)
|
|
true)))))))
|
|
|
|
(define
|
|
js-digit-value
|
|
(fn
|
|
(c radix)
|
|
(let
|
|
((code (char-code c)))
|
|
(let
|
|
((d (cond ((and (>= code 48) (<= code 57)) (- code 48)) ((and (>= code 97) (<= code 122)) (+ 10 (- code 97))) ((and (>= code 65) (<= code 90)) (+ 10 (- code 65))) (else -1))))
|
|
(if (or (= d -1) (>= d radix)) -1 d)))))
|
|
|
|
(define
|
|
parseFloat
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(= (len args) 0)
|
|
(js-nan-value)
|
|
(let
|
|
((s (js-trim (js-to-string (nth args 0)))))
|
|
(cond
|
|
((= s "") (js-nan-value))
|
|
((= s "Infinity") (js-infinity-value))
|
|
((= s "+Infinity") (js-infinity-value))
|
|
((= s "-Infinity") (- 0 (js-infinity-value)))
|
|
(else (js-parse-float-prefix s)))))))
|
|
|
|
(define
|
|
js-parse-float-prefix
|
|
(fn
|
|
(s)
|
|
(cond
|
|
((js-float-has-infinity-prefix? s 0)
|
|
(js-infinity-value))
|
|
((and
|
|
(>= (len s) 1)
|
|
(= (char-at s 0) "+")
|
|
(js-float-has-infinity-prefix? s 1))
|
|
(js-infinity-value))
|
|
((and
|
|
(>= (len s) 1)
|
|
(= (char-at s 0) "-")
|
|
(js-float-has-infinity-prefix? s 1))
|
|
(- 0 (js-infinity-value)))
|
|
(else
|
|
(let
|
|
((end (js-float-prefix-end s 0 false false false)))
|
|
(cond
|
|
((= end 0) (js-nan-value))
|
|
((not (js-str-has-digit? s 0 end)) (js-nan-value))
|
|
(else (js-parse-num-safe (js-string-slice s 0 end)))))))))
|
|
|
|
(define
|
|
js-str-has-digit?
|
|
(fn
|
|
(s i n)
|
|
(cond
|
|
((>= i n) false)
|
|
((let ((c (char-at s i))) (and (>= (char-code c) 48) (<= (char-code c) 57)))
|
|
true)
|
|
(else (js-str-has-digit? s (+ i 1) n)))))
|
|
|
|
(define
|
|
js-float-has-infinity-prefix?
|
|
(fn
|
|
(s i)
|
|
(and
|
|
(>= (len s) (+ i 8))
|
|
(= (js-string-slice s i (+ i 8)) "Infinity"))))
|
|
|
|
(define
|
|
js-float-prefix-end
|
|
(fn
|
|
(s i sawdigit sawdot sawe)
|
|
(cond
|
|
((>= i (len s)) i)
|
|
(else
|
|
(let
|
|
((c (char-at s i)))
|
|
(cond
|
|
((or (= c "0") (= c "1") (= c "2") (= c "3") (= c "4") (= c "5") (= c "6") (= c "7") (= c "8") (= c "9"))
|
|
(js-float-prefix-end s (+ i 1) true sawdot sawe))
|
|
((and (= c ".") (not sawdot) (not sawe))
|
|
(js-float-prefix-end s (+ i 1) sawdigit true sawe))
|
|
((and (or (= c "e") (= c "E")) sawdigit (not sawe))
|
|
(js-float-prefix-end s (+ i 1) false sawdot true))
|
|
((and (or (= c "+") (= c "-")) (= i 0))
|
|
(js-float-prefix-end s (+ i 1) sawdigit sawdot sawe))
|
|
((and (or (= c "+") (= c "-")) sawe)
|
|
(let
|
|
((prev (char-at s (- i 1))))
|
|
(if
|
|
(or (= prev "e") (= prev "E"))
|
|
(js-float-prefix-end
|
|
s
|
|
(+ i 1)
|
|
sawdigit
|
|
sawdot
|
|
sawe)
|
|
i)))
|
|
(else i)))))))
|
|
|
|
(define
|
|
encodeURIComponent
|
|
(fn
|
|
(v)
|
|
(let ((s (js-to-string v))) (js-uri-encode-loop s 0 ""))))
|
|
|
|
(define
|
|
decodeURIComponent
|
|
(fn (v) (let ((s (js-to-string v))) (js-uri-decode s 0 "" false))))
|
|
|
|
(define encodeURI (fn (v) (js-to-string v)))
|
|
|
|
(define
|
|
decodeURI
|
|
(fn (v) (let ((s (js-to-string v))) (js-uri-decode s 0 "" true))))
|
|
|
|
(define
|
|
js-uri-malformed!
|
|
(fn () (raise (js-new-call URIError (js-args "URI malformed")))))
|
|
|
|
(define
|
|
js-uri-reserved-byte?
|
|
(fn
|
|
(b)
|
|
(or
|
|
(= b 35)
|
|
(= b 36)
|
|
(= b 38)
|
|
(= b 43)
|
|
(= b 44)
|
|
(= b 47)
|
|
(= b 58)
|
|
(= b 59)
|
|
(= b 61)
|
|
(= b 63)
|
|
(= b 64))))
|
|
|
|
(define
|
|
js-uri-hex-val
|
|
(fn
|
|
(c)
|
|
(let
|
|
((cc (char-code c)))
|
|
(cond
|
|
((and (>= cc 48) (<= cc 57)) (- cc 48))
|
|
((and (>= cc 65) (<= cc 70)) (- cc 55))
|
|
((and (>= cc 97) (<= cc 102)) (- cc 87))
|
|
(else -1)))))
|
|
|
|
(define
|
|
js-uri-hex-pair
|
|
(fn
|
|
(s i)
|
|
(cond
|
|
((>= (+ i 1) (len s)) -1)
|
|
(else
|
|
(let
|
|
((d1 (js-uri-hex-val (char-at s i)))
|
|
(d2 (js-uri-hex-val (char-at s (+ i 1)))))
|
|
(cond
|
|
((or (= d1 -1) (= d2 -1)) -1)
|
|
(else (+ (* d1 16) d2))))))))
|
|
|
|
(define
|
|
js-uri-decode
|
|
(fn
|
|
(s i acc preserveReserved)
|
|
(cond
|
|
((>= i (len s)) acc)
|
|
((not (= (char-at s i) "%"))
|
|
(js-uri-decode
|
|
s
|
|
(+ i 1)
|
|
(str acc (char-at s i))
|
|
preserveReserved))
|
|
((> (+ i 3) (len s)) (js-uri-malformed!))
|
|
(else
|
|
(let
|
|
((b (js-uri-hex-pair s (+ i 1))))
|
|
(cond
|
|
((= b -1) (js-uri-malformed!))
|
|
((< b 128)
|
|
(cond
|
|
((and preserveReserved (js-uri-reserved-byte? b))
|
|
(js-uri-decode
|
|
s
|
|
(+ i 3)
|
|
(str acc (char-at s i) (char-at s (+ i 1)) (char-at s (+ i 2)))
|
|
preserveReserved))
|
|
(else
|
|
(js-uri-decode
|
|
s
|
|
(+ i 3)
|
|
(str acc (char-from-code b))
|
|
preserveReserved))))
|
|
(else (js-uri-decode-multi s i acc preserveReserved b))))))))
|
|
|
|
(define
|
|
js-uri-decode-multi
|
|
(fn
|
|
(s i acc preserveReserved b1)
|
|
(let
|
|
((n
|
|
(cond
|
|
((< b1 192) -1)
|
|
((< b1 224) 2)
|
|
((< b1 240) 3)
|
|
((< b1 248) 4)
|
|
(else -1)))
|
|
(head-bits
|
|
(cond
|
|
((< b1 192) 0)
|
|
((< b1 224) (mod b1 32))
|
|
((< b1 240) (mod b1 16))
|
|
((< b1 248) (mod b1 8))
|
|
(else 0))))
|
|
(cond
|
|
((= n -1) (js-uri-malformed!))
|
|
(else
|
|
(js-uri-decode-multi-loop s i acc preserveReserved n 1 head-bits))))))
|
|
|
|
(define
|
|
js-uri-decode-multi-loop
|
|
(fn
|
|
(s i acc preserveReserved n k cp)
|
|
(cond
|
|
((>= k n)
|
|
(cond
|
|
((and (>= cp 55296) (<= cp 57343)) (js-uri-malformed!))
|
|
((> cp 1114111) (js-uri-malformed!))
|
|
(else
|
|
(js-uri-decode
|
|
s
|
|
(+ i (* 3 n))
|
|
(str acc (char-from-code cp))
|
|
preserveReserved))))
|
|
(else
|
|
(let
|
|
((p (+ i (* 3 k))))
|
|
(cond
|
|
((>= (+ p 3) (+ (len s) 1)) (js-uri-malformed!))
|
|
((not (= (char-at s p) "%")) (js-uri-malformed!))
|
|
(else
|
|
(let
|
|
((b (js-uri-hex-pair s (+ p 1))))
|
|
(cond
|
|
((= b -1) (js-uri-malformed!))
|
|
((or (< b 128) (>= b 192)) (js-uri-malformed!))
|
|
(else
|
|
(js-uri-decode-multi-loop
|
|
s
|
|
i
|
|
acc
|
|
preserveReserved
|
|
n
|
|
(+ k 1)
|
|
(+ (* cp 64) (mod b 64)))))))))))))
|
|
|
|
(define
|
|
js-uri-encode-loop
|
|
(fn
|
|
(s i acc)
|
|
(cond
|
|
((>= i (len s)) acc)
|
|
(else
|
|
(let
|
|
((c (char-at s i)))
|
|
(let
|
|
((code (char-code c)))
|
|
(cond
|
|
((= c " ")
|
|
(js-uri-encode-loop s (+ i 1) (str acc "%20")))
|
|
((and (>= code 48) (<= code 57))
|
|
(js-uri-encode-loop s (+ i 1) (str acc c)))
|
|
((and (>= code 65) (<= code 90))
|
|
(js-uri-encode-loop s (+ i 1) (str acc c)))
|
|
((and (>= code 97) (<= code 122))
|
|
(js-uri-encode-loop s (+ i 1) (str acc c)))
|
|
((or (= c "-") (= c "_") (= c ".") (= c "~") (= c "!") (= c "*") (= c "'") (= c "(") (= c ")"))
|
|
(js-uri-encode-loop s (+ i 1) (str acc c)))
|
|
(else
|
|
(js-uri-encode-loop
|
|
s
|
|
(+ i 1)
|
|
(str acc "%" (js-hex-2 code)))))))))))
|
|
|
|
(define
|
|
js-hex-2
|
|
(fn
|
|
(n)
|
|
(let
|
|
((hi (js-math-trunc (/ n 16))) (lo (mod n 16)))
|
|
(str (js-hex-digit hi) (js-hex-digit lo)))))
|
|
|
|
(define
|
|
js-hex-digit
|
|
(fn
|
|
(d)
|
|
(cond
|
|
((< d 10) (js-to-string d))
|
|
(else (js-code-to-char (+ 55 d))))))
|
|
|
|
(define
|
|
js-json-stringify
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((value (if (= (len args) 0) :js-undefined (nth args 0)))
|
|
(replacer (if (< (len args) 2) :js-undefined (nth args 1)))
|
|
(space-raw (if (< (len args) 3) :js-undefined (nth args 2))))
|
|
(let
|
|
((rep-fn (if (js-function? replacer) replacer nil))
|
|
(rep-keys (if (list? replacer) (js-json-prop-list replacer) nil))
|
|
(gap (js-json-space-gap space-raw)))
|
|
(let
|
|
((wrapper (dict)))
|
|
(begin
|
|
(dict-set! wrapper "" value)
|
|
(js-json-serialize-property "" wrapper rep-fn rep-keys gap "")))))))
|
|
|
|
(define
|
|
js-json-prop-list
|
|
(fn
|
|
(arr)
|
|
(let
|
|
((out (list)))
|
|
(begin
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(cond
|
|
((= (type-of k) "string")
|
|
(if (js-list-contains? out k) nil (append! out k)))
|
|
((number? k)
|
|
(let ((s (js-number-to-string k)))
|
|
(if (js-list-contains? out s) nil (append! out s))))
|
|
((dict? k)
|
|
(cond
|
|
((contains? (keys k) "__js_string_value__")
|
|
(let ((s (get k "__js_string_value__")))
|
|
(if (js-list-contains? out s) nil (append! out s))))
|
|
((contains? (keys k) "__js_number_value__")
|
|
(let ((s (js-number-to-string (get k "__js_number_value__"))))
|
|
(if (js-list-contains? out s) nil (append! out s))))
|
|
(else nil)))
|
|
(else nil)))
|
|
arr)
|
|
out))))
|
|
|
|
(define
|
|
js-list-contains?
|
|
(fn
|
|
(lst v)
|
|
(cond
|
|
((empty? lst) false)
|
|
((= (first lst) v) true)
|
|
(else (js-list-contains? (rest lst) v)))))
|
|
|
|
(define
|
|
js-json-space-gap
|
|
(fn
|
|
(sp)
|
|
(cond
|
|
((js-undefined? sp) "")
|
|
((= sp nil) "")
|
|
((number? sp)
|
|
(let
|
|
((n (cond ((js-number-is-nan sp) 0) ((< sp 0) 0) ((> sp 10) 10) (else (floor sp)))))
|
|
(js-string-repeat " " n)))
|
|
((and (dict? sp) (contains? (keys sp) "__js_number_value__"))
|
|
(js-json-space-gap (get sp "__js_number_value__")))
|
|
((and (dict? sp) (contains? (keys sp) "__js_string_value__"))
|
|
(js-json-space-gap (get sp "__js_string_value__")))
|
|
((= (type-of sp) "string")
|
|
(if (> (len sp) 10) (js-string-slice sp 0 10) sp))
|
|
(else ""))))
|
|
|
|
(define
|
|
js-string-repeat
|
|
(fn
|
|
(s n)
|
|
(if (<= n 0) "" (str s (js-string-repeat s (- n 1))))))
|
|
|
|
(define
|
|
js-json-unwrap-primitive
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((not (dict? v)) v)
|
|
((contains? (keys v) "__js_number_value__")
|
|
(get v "__js_number_value__"))
|
|
((contains? (keys v) "__js_string_value__")
|
|
(get v "__js_string_value__"))
|
|
((contains? (keys v) "__js_boolean_value__")
|
|
(get v "__js_boolean_value__"))
|
|
(else v))))
|
|
|
|
(define
|
|
js-json-serialize-property
|
|
(fn
|
|
(key holder rep-fn rep-keys gap indent)
|
|
(let
|
|
((value0 (if (dict? holder) (get holder key) (if (list? holder) (nth holder (js-num-to-int (js-to-number key))) :js-undefined))))
|
|
(let
|
|
((value1
|
|
(cond
|
|
((and
|
|
(or (dict? value0) (list? value0))
|
|
(let ((tj (js-get-prop value0 "toJSON")))
|
|
(and (not (js-undefined? tj)) (js-function? tj))))
|
|
(js-call-with-this value0 (js-get-prop value0 "toJSON") (list key)))
|
|
(else value0))))
|
|
(let
|
|
((value
|
|
(if rep-fn
|
|
(js-call-with-this holder rep-fn (list key value1))
|
|
value1)))
|
|
(let
|
|
((vu (js-json-unwrap-primitive value)))
|
|
(cond
|
|
((= vu nil) "null")
|
|
((js-undefined? vu) :js-undefined)
|
|
((= (type-of vu) "boolean") (if vu "true" "false"))
|
|
((or (number? vu) (= (type-of vu) "rational"))
|
|
(let ((n (if (= (type-of vu) "rational") (exact->inexact vu) vu)))
|
|
(cond
|
|
((js-number-is-nan n) "null")
|
|
((= n (js-infinity-value)) "null")
|
|
((= n (- 0 (js-infinity-value))) "null")
|
|
(else (js-number-to-string n)))))
|
|
((= (type-of vu) "string") (js-json-escape-string vu))
|
|
((js-function? vu) :js-undefined)
|
|
((list? vu)
|
|
(js-json-serialize-array vu rep-fn rep-keys gap indent))
|
|
((dict? vu)
|
|
(js-json-serialize-object vu rep-fn rep-keys gap indent))
|
|
(else :js-undefined))))))))
|
|
|
|
(define
|
|
js-json-serialize-array
|
|
(fn
|
|
(arr rep-fn rep-keys gap indent)
|
|
(let
|
|
((step-back indent) (new-indent (str indent gap)) (parts (list)))
|
|
(begin
|
|
(js-json-array-loop arr rep-fn rep-keys gap new-indent 0 parts)
|
|
(cond
|
|
((empty? parts) "[]")
|
|
((= gap "")
|
|
(str "[" (join "," parts) "]"))
|
|
(else
|
|
(str
|
|
"[\n"
|
|
new-indent
|
|
(join (str ",\n" new-indent) parts)
|
|
"\n"
|
|
step-back
|
|
"]")))))))
|
|
|
|
(define
|
|
js-json-array-loop
|
|
(fn
|
|
(arr rep-fn rep-keys gap new-indent i parts)
|
|
(cond
|
|
((>= i (len arr)) nil)
|
|
(else
|
|
(let
|
|
((s (js-json-serialize-property (js-number-to-string i) arr rep-fn rep-keys gap new-indent)))
|
|
(begin
|
|
(if (js-undefined? s) (append! parts "null") (append! parts s))
|
|
(js-json-array-loop arr rep-fn rep-keys gap new-indent (+ i 1) parts)))))))
|
|
|
|
(define
|
|
js-json-serialize-object
|
|
(fn
|
|
(obj rep-fn rep-keys gap indent)
|
|
(let
|
|
((step-back indent) (new-indent (str indent gap)) (parts (list))
|
|
(sep (if (= gap "") ":" ": "))
|
|
(key-list (if rep-keys rep-keys (js-object-keys obj))))
|
|
(begin
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(cond
|
|
((js-key-internal? k) nil)
|
|
(else
|
|
(let
|
|
((s (js-json-serialize-property k obj rep-fn rep-keys gap new-indent)))
|
|
(if
|
|
(js-undefined? s)
|
|
nil
|
|
(append! parts (str (js-json-escape-string k) sep s)))))))
|
|
key-list)
|
|
(cond
|
|
((empty? parts) "{}")
|
|
((= gap "")
|
|
(str "{" (join "," parts) "}"))
|
|
(else
|
|
(str
|
|
"{\n"
|
|
new-indent
|
|
(join (str ",\n" new-indent) parts)
|
|
"\n"
|
|
step-back
|
|
"}")))))))
|
|
|
|
|
|
(define
|
|
js-json-escape-string
|
|
(fn (s) (str "\"" (js-json-escape-loop s 0 "") "\"")))
|
|
|
|
(define
|
|
js-json-escape-loop
|
|
(fn
|
|
(s i acc)
|
|
(if
|
|
(>= i (len s))
|
|
acc
|
|
(let
|
|
((c (char-at s i)))
|
|
(cond
|
|
((= c "\"")
|
|
(js-json-escape-loop s (+ i 1) (str acc "\\\"")))
|
|
((= c "\\")
|
|
(js-json-escape-loop s (+ i 1) (str acc "\\\\")))
|
|
((= c "\n")
|
|
(js-json-escape-loop s (+ i 1) (str acc "\\n")))
|
|
((= c "\r")
|
|
(js-json-escape-loop s (+ i 1) (str acc "\\r")))
|
|
((= c "\t")
|
|
(js-json-escape-loop s (+ i 1) (str acc "\\t")))
|
|
(else (js-json-escape-loop s (+ i 1) (str acc c))))))))
|
|
|
|
(define
|
|
js-json-parse
|
|
(fn
|
|
(&rest args)
|
|
(if
|
|
(= (len args) 0)
|
|
(raise (js-new-call SyntaxError (js-args "Unexpected token undefined")))
|
|
(let
|
|
((st (dict)))
|
|
(dict-set! st "s" (js-to-string (nth args 0)))
|
|
(dict-set! st "i" 0)
|
|
(let
|
|
((result (js-json-parse-value st)))
|
|
(begin
|
|
(js-json-skip-ws! st)
|
|
(if
|
|
(< (get st "i") (len (get st "s")))
|
|
(raise
|
|
(js-new-call SyntaxError
|
|
(js-args (str "Unexpected token at position " (get st "i")))))
|
|
result)))))))
|
|
|
|
(define
|
|
js-json-skip-ws!
|
|
(fn
|
|
(st)
|
|
(let
|
|
((s (get st "s")) (i (get st "i")))
|
|
(cond
|
|
((>= i (len s)) nil)
|
|
((or (= (char-at s i) " ") (= (char-at s i) "\t") (= (char-at s i) "\n") (= (char-at s i) "\r"))
|
|
(begin (dict-set! st "i" (+ i 1)) (js-json-skip-ws! st)))
|
|
(else nil)))))
|
|
|
|
(define
|
|
js-json-parse-value
|
|
(fn
|
|
(st)
|
|
(js-json-skip-ws! st)
|
|
(let
|
|
((s (get st "s")) (i (get st "i")))
|
|
(cond
|
|
((>= i (len s)) (raise (js-new-call SyntaxError (js-args "JSON: unexpected end"))))
|
|
((= (char-at s i) "\"") (js-json-parse-string st))
|
|
((= (char-at s i) "[") (js-json-parse-array st))
|
|
((= (char-at s i) "{") (js-json-parse-object st))
|
|
((= (char-at s i) "t")
|
|
(begin (dict-set! st "i" (+ i 4)) true))
|
|
((= (char-at s i) "f")
|
|
(begin (dict-set! st "i" (+ i 5)) false))
|
|
((= (char-at s i) "n")
|
|
(begin (dict-set! st "i" (+ i 4)) nil))
|
|
(else (js-json-parse-number st))))))
|
|
|
|
(define
|
|
js-json-parse-string
|
|
(fn
|
|
(st)
|
|
(let
|
|
((s (get st "s")))
|
|
(dict-set! st "i" (+ (get st "i") 1))
|
|
(let
|
|
((buf (list)))
|
|
(js-json-parse-string-loop st s buf)
|
|
(dict-set! st "i" (+ (get st "i") 1))
|
|
(join "" buf)))))
|
|
|
|
(define
|
|
js-json-parse-string-loop
|
|
(fn
|
|
(st s buf)
|
|
(let
|
|
((i (get st "i")))
|
|
(cond
|
|
((>= i (len s))
|
|
(raise (js-new-call SyntaxError (js-args "JSON: unterminated string"))))
|
|
((= (char-at s i) "\"") nil)
|
|
((< (char-code (char-at s i)) 32)
|
|
(raise
|
|
(js-new-call SyntaxError
|
|
(js-args "JSON: control character in string"))))
|
|
((= (char-at s i) "\\")
|
|
(begin
|
|
(when
|
|
(< (+ i 1) (len s))
|
|
(let
|
|
((e (char-at s (+ i 1))))
|
|
(cond
|
|
((= e "n") (append! buf "\n"))
|
|
((= e "t") (append! buf "\t"))
|
|
((= e "r") (append! buf "\r"))
|
|
((= e "\"") (append! buf "\""))
|
|
((= e "\\") (append! buf "\\"))
|
|
((= e "/") (append! buf "/"))
|
|
(else (append! buf e)))))
|
|
(dict-set! st "i" (+ i 2))
|
|
(js-json-parse-string-loop st s buf)))
|
|
(else
|
|
(begin
|
|
(append! buf (char-at s i))
|
|
(dict-set! st "i" (+ i 1))
|
|
(js-json-parse-string-loop st s buf)))))))
|
|
|
|
(define
|
|
js-json-parse-number
|
|
(fn
|
|
(st)
|
|
(let
|
|
((s (get st "s")) (i (get st "i")))
|
|
(let
|
|
((start i))
|
|
(js-json-parse-number-loop st s)
|
|
(js-to-number (js-string-slice s start (get st "i")))))))
|
|
|
|
(define
|
|
js-json-parse-number-loop
|
|
(fn
|
|
(st s)
|
|
(let
|
|
((i (get st "i")))
|
|
(cond
|
|
((>= i (len s)) nil)
|
|
((or (js-is-digit? (char-at s i)) (= (char-at s i) "-") (= (char-at s i) "+") (= (char-at s i) ".") (= (char-at s i) "e") (= (char-at s i) "E"))
|
|
(begin
|
|
(dict-set! st "i" (+ i 1))
|
|
(js-json-parse-number-loop st s)))
|
|
(else nil)))))
|
|
|
|
(define
|
|
js-json-parse-array
|
|
(fn
|
|
(st)
|
|
(let
|
|
((result (list)))
|
|
(dict-set! st "i" (+ (get st "i") 1))
|
|
(js-json-skip-ws! st)
|
|
(cond
|
|
((and (< (get st "i") (len (get st "s"))) (= (char-at (get st "s") (get st "i")) "]"))
|
|
(begin (dict-set! st "i" (+ (get st "i") 1)) result))
|
|
(else (begin (js-json-parse-array-loop st result) result))))))
|
|
|
|
(define
|
|
js-json-parse-array-loop
|
|
(fn
|
|
(st result)
|
|
(append! result (js-json-parse-value st))
|
|
(js-json-skip-ws! st)
|
|
(let
|
|
((c (char-at (get st "s") (get st "i"))))
|
|
(cond
|
|
((= c ",")
|
|
(begin
|
|
(dict-set! st "i" (+ (get st "i") 1))
|
|
(js-json-skip-ws! st)
|
|
(js-json-parse-array-loop st result)))
|
|
((= c "]") (dict-set! st "i" (+ (get st "i") 1)))
|
|
(else (raise (js-new-call SyntaxError (js-args "JSON: expected , or ]"))))))))
|
|
|
|
(define
|
|
js-json-parse-object
|
|
(fn
|
|
(st)
|
|
(let
|
|
((result (dict)))
|
|
(dict-set! st "i" (+ (get st "i") 1))
|
|
(js-json-skip-ws! st)
|
|
(cond
|
|
((and (< (get st "i") (len (get st "s"))) (= (char-at (get st "s") (get st "i")) "}"))
|
|
(begin (dict-set! st "i" (+ (get st "i") 1)) result))
|
|
(else (begin (js-json-parse-object-loop st result) result))))))
|
|
|
|
(define
|
|
js-json-parse-object-loop
|
|
(fn
|
|
(st result)
|
|
(js-json-skip-ws! st)
|
|
(let
|
|
((k (js-json-parse-string st)))
|
|
(js-json-skip-ws! st)
|
|
(when
|
|
(not (= (char-at (get st "s") (get st "i")) ":"))
|
|
(raise (js-new-call SyntaxError (js-args "JSON: expected :"))))
|
|
(dict-set! st "i" (+ (get st "i") 1))
|
|
(let ((v (js-json-parse-value st))) (dict-set! result k v))
|
|
(js-json-skip-ws! st)
|
|
(let
|
|
((c (char-at (get st "s") (get st "i"))))
|
|
(cond
|
|
((= c ",")
|
|
(begin
|
|
(dict-set! st "i" (+ (get st "i") 1))
|
|
(js-json-parse-object-loop st result)))
|
|
((= c "}") (dict-set! st "i" (+ (get st "i") 1)))
|
|
(else (raise (js-new-call SyntaxError (js-args "JSON: expected , or }")))))))))
|
|
|
|
(define JSON {:stringify js-json-stringify :parse js-json-parse})
|
|
|
|
(define
|
|
js-promise-flush-callbacks!
|
|
(fn
|
|
(p)
|
|
(let
|
|
((cbs (get p "callbacks")))
|
|
(dict-set! p "callbacks" (list))
|
|
(for-each
|
|
(fn (cb) (js-mt-push! (fn () (js-promise-run-callback! p cb))))
|
|
cbs))))
|
|
|
|
(define
|
|
js-promise-run-callback!
|
|
(fn
|
|
(p cb)
|
|
(let
|
|
((on-fulfilled (nth cb 0))
|
|
(on-rejected (nth cb 1))
|
|
(result-promise (nth cb 2))
|
|
(state (get p "state"))
|
|
(value (get p "value")))
|
|
(cond
|
|
((= state "fulfilled")
|
|
(if
|
|
(js-function? on-fulfilled)
|
|
(js-promise-run-handler! result-promise on-fulfilled value)
|
|
(js-promise-resolve! result-promise value)))
|
|
((= state "rejected")
|
|
(if
|
|
(js-function? on-rejected)
|
|
(js-promise-run-handler! result-promise on-rejected value)
|
|
(js-promise-reject! result-promise value)))
|
|
(else :js-undefined)))))
|
|
|
|
(define
|
|
js-promise-run-handler!
|
|
(fn
|
|
(result-promise handler arg)
|
|
(let
|
|
((outcome (js-promise-try-call handler arg)))
|
|
(cond
|
|
((get outcome "threw")
|
|
(js-promise-reject! result-promise (get outcome "error")))
|
|
(else (js-promise-resolve! result-promise (get outcome "value")))))))
|
|
|
|
(define
|
|
js-call-arity-tolerant
|
|
(fn
|
|
(handler arg)
|
|
(cond
|
|
((= (type-of handler) "lambda")
|
|
(let
|
|
((params (lambda-params handler)))
|
|
(cond
|
|
((empty? params) (handler))
|
|
((= (first params) "&rest") (handler arg))
|
|
(else (handler arg)))))
|
|
(else (handler arg)))))
|
|
|
|
(define
|
|
js-promise-try-call
|
|
(fn
|
|
(handler arg)
|
|
(let
|
|
((out (dict)))
|
|
(dict-set! out "threw" false)
|
|
(dict-set! out "value" :js-undefined)
|
|
(dict-set! out "error" :js-undefined)
|
|
(guard
|
|
(e
|
|
(else
|
|
(begin
|
|
(dict-set! out "threw" true)
|
|
(dict-set! out "error" e)
|
|
out)))
|
|
(dict-set! out "value" (js-call-arity-tolerant handler arg))
|
|
out))))
|
|
|
|
(define
|
|
js-promise-then-internal!
|
|
(fn
|
|
(p on-fulfilled on-rejected)
|
|
(let
|
|
((new-p (js-make-promise)) (cb (list on-fulfilled on-rejected)))
|
|
(let
|
|
((cb3 (append cb (list new-p))))
|
|
(cond
|
|
((= (get p "state") "pending")
|
|
(dict-set!
|
|
p
|
|
"callbacks"
|
|
(append (get p "callbacks") (list cb3))))
|
|
(else (js-mt-push! (fn () (js-promise-run-callback! p cb3))))))
|
|
new-p)))
|
|
|
|
(define
|
|
js-promise-then!
|
|
(fn
|
|
(p args)
|
|
(let
|
|
((on-f (if (>= (len args) 1) (nth args 0) :js-undefined))
|
|
(on-r
|
|
(if
|
|
(>= (len args) 2)
|
|
(nth args 1)
|
|
:js-undefined)))
|
|
(js-promise-then-internal! p on-f on-r))))
|
|
|
|
(define
|
|
js-promise-catch!
|
|
(fn
|
|
(p args)
|
|
(let
|
|
((on-r (if (>= (len args) 1) (nth args 0) :js-undefined)))
|
|
(js-promise-then-internal! p :js-undefined on-r))))
|
|
|
|
(define
|
|
js-promise-finally!
|
|
(fn
|
|
(p args)
|
|
(let
|
|
((on-fin (if (>= (len args) 1) (nth args 0) :js-undefined)))
|
|
(let
|
|
((pass-val (fn (v) (begin (when (js-function? on-fin) (on-fin)) v)))
|
|
(pass-err
|
|
(fn
|
|
(r)
|
|
(begin
|
|
(when (js-function? on-fin) (on-fin))
|
|
(let
|
|
((throw-p (js-make-promise)))
|
|
(js-promise-reject! throw-p r)
|
|
throw-p)))))
|
|
(js-promise-then-internal! p pass-val pass-err)))))
|
|
|
|
(define
|
|
js-invoke-promise-method
|
|
(fn
|
|
(p name args)
|
|
(cond
|
|
((= name "then") (js-promise-then! p args))
|
|
((= name "catch") (js-promise-catch! p args))
|
|
((= name "finally") (js-promise-finally! p args))
|
|
(else (error (str "TypeError: Promise." name " is not a function"))))))
|
|
|
|
(define
|
|
js-promise-builtin-method?
|
|
(fn (name) (or (= name "then") (= name "catch") (= name "finally"))))
|
|
|
|
(define
|
|
Promise
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((executor (if (empty? args) :js-undefined (first args)))
|
|
(p (js-make-promise)))
|
|
(let
|
|
((resolve-fn (fn (&rest a) (let ((v (if (empty? a) :js-undefined (first a)))) (js-promise-resolve! p v) :js-undefined)))
|
|
(reject-fn
|
|
(fn
|
|
(&rest a)
|
|
(let
|
|
((r (if (empty? a) :js-undefined (first a))))
|
|
(js-promise-reject! p r)
|
|
:js-undefined))))
|
|
(cond
|
|
((js-function? executor)
|
|
(guard
|
|
(e (else (js-promise-reject! p e)))
|
|
(executor resolve-fn reject-fn)))
|
|
(else :js-undefined))
|
|
p))))
|
|
|
|
(define
|
|
js-promise-resolve-static
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((v (if (empty? args) :js-undefined (first args))))
|
|
(cond
|
|
((js-promise? v) v)
|
|
(else (let ((p (js-make-promise))) (js-promise-resolve! p v) p))))))
|
|
|
|
(define
|
|
js-promise-reject-static
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((r (if (empty? args) :js-undefined (first args)))
|
|
(p (js-make-promise)))
|
|
(js-promise-reject! p r)
|
|
p)))
|
|
|
|
(define
|
|
js-make-list-of-length
|
|
(fn (n fill) (js-make-list-loop (list) n fill)))
|
|
|
|
(define
|
|
js-make-list-loop
|
|
(fn
|
|
(acc n fill)
|
|
(cond
|
|
((<= n 0) acc)
|
|
(else
|
|
(begin
|
|
(append! acc fill)
|
|
(js-make-list-loop acc (- n 1) fill))))))
|
|
|
|
(define
|
|
js-promise-all-loop!
|
|
(fn
|
|
(result-p items state idx)
|
|
(cond
|
|
((>= idx (len items)) :js-undefined)
|
|
(else
|
|
(let
|
|
((item (nth items idx)) (i idx))
|
|
(let
|
|
((child (if (js-promise? item) item (js-promise-resolve-static item))))
|
|
(js-promise-then-internal!
|
|
child
|
|
(fn
|
|
(v)
|
|
(let
|
|
((results (get state "results")))
|
|
(set-nth! results i v)
|
|
(dict-set!
|
|
state
|
|
"remaining"
|
|
(- (get state "remaining") 1))
|
|
(cond
|
|
((= (get state "remaining") 0)
|
|
(js-promise-resolve! result-p results))
|
|
(else :js-undefined))))
|
|
(fn (r) (js-promise-reject! result-p r))))
|
|
(js-promise-all-loop! result-p items state (+ idx 1)))))))
|
|
|
|
(define
|
|
js-promise-all-static
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((items (if (empty? args) (list) (first args)))
|
|
(p (js-make-promise)))
|
|
(cond
|
|
((= (len items) 0)
|
|
(begin (js-promise-resolve! p (list)) p))
|
|
(else
|
|
(let
|
|
((n (len items)) (state (dict)))
|
|
(dict-set! state "remaining" n)
|
|
(dict-set!
|
|
state
|
|
"results"
|
|
(js-make-list-of-length n :js-undefined))
|
|
(js-promise-all-loop! p items state 0)
|
|
p))))))
|
|
|
|
(define
|
|
js-promise-race-static
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((items (if (empty? args) (list) (first args)))
|
|
(p (js-make-promise)))
|
|
(for-each
|
|
(fn
|
|
(item)
|
|
(let
|
|
((child (if (js-promise? item) item (js-promise-resolve-static item))))
|
|
(js-promise-then-internal!
|
|
child
|
|
(fn (v) (js-promise-resolve! p v))
|
|
(fn (r) (js-promise-reject! p r)))))
|
|
items)
|
|
p)))
|
|
|
|
(define __js_promise_statics__ (dict))
|
|
|
|
(dict-set! __js_promise_statics__ "resolve" js-promise-resolve-static)
|
|
|
|
(dict-set! __js_promise_statics__ "reject" js-promise-reject-static)
|
|
|
|
(dict-set! __js_promise_statics__ "all" js-promise-all-static)
|
|
|
|
(dict-set! __js_promise_statics__ "race" js-promise-race-static)
|
|
|
|
(define
|
|
js-async-wrap
|
|
(fn
|
|
(thunk)
|
|
(let
|
|
((p (js-make-promise)))
|
|
(guard
|
|
(e (else (js-promise-reject! p e)))
|
|
(let
|
|
((v (thunk)))
|
|
(cond
|
|
((js-promise? v)
|
|
(js-promise-then-internal!
|
|
v
|
|
(fn (x) (js-promise-resolve! p x))
|
|
(fn (r) (js-promise-reject! p r))))
|
|
(else (js-promise-resolve! p v)))))
|
|
p)))
|
|
|
|
(define
|
|
js-await-value
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((not (js-promise? v)) v)
|
|
(else
|
|
(begin
|
|
(js-drain-microtasks!)
|
|
(let
|
|
((state (get v "state")))
|
|
(cond
|
|
((= state "fulfilled") (get v "value"))
|
|
((= state "rejected") (raise (get v "value")))
|
|
(else
|
|
(begin
|
|
(js-drain-microtasks!)
|
|
(let
|
|
((state2 (get v "state")))
|
|
(cond
|
|
((= state2 "fulfilled") (get v "value"))
|
|
((= state2 "rejected") (raise (get v "value")))
|
|
(else (error "await on pending Promise (no scheduler)")))))))))))))
|
|
|
|
(define __drain (fn () (js-drain-microtasks!) :js-undefined))
|
|
|
|
(define __js_regex_platform__ (dict))
|
|
|
|
(define
|
|
js-regex-platform-override!
|
|
(fn (op impl) (dict-set! __js_regex_platform__ op impl)))
|
|
|
|
(define
|
|
js-regex?
|
|
(fn (v) (and (dict? v) (contains? (keys v) "__js_regex__"))))
|
|
|
|
(define
|
|
js-regex-has-flag?
|
|
(fn (flags ch) (>= (js-string-index-of flags ch 0) 0)))
|
|
|
|
(define
|
|
js-regex-new
|
|
(fn
|
|
(pattern flags)
|
|
(let
|
|
((rx (dict))
|
|
(fl (if (js-undefined? flags) "" (if (= flags nil) "" flags))))
|
|
(dict-set! rx "__js_regex__" true)
|
|
(dict-set! rx "source" pattern)
|
|
(dict-set! rx "flags" fl)
|
|
(dict-set! rx "global" (js-regex-has-flag? fl "g"))
|
|
(dict-set! rx "ignoreCase" (js-regex-has-flag? fl "i"))
|
|
(dict-set! rx "multiline" (js-regex-has-flag? fl "m"))
|
|
(dict-set! rx "sticky" (js-regex-has-flag? fl "y"))
|
|
(dict-set! rx "unicode" (js-regex-has-flag? fl "u"))
|
|
(dict-set! rx "dotAll" (js-regex-has-flag? fl "s"))
|
|
(dict-set! rx "hasIndices" (js-regex-has-flag? fl "d"))
|
|
(dict-set! rx "lastIndex" 0)
|
|
rx)))
|
|
|
|
(define
|
|
js-regex-stub-test
|
|
(fn
|
|
(rx s)
|
|
(let
|
|
((src (get rx "source")) (ci (get rx "ignoreCase")))
|
|
(let
|
|
((hay (if ci (js-lower-case s) s))
|
|
(needle (if ci (js-lower-case src) src)))
|
|
(>= (js-string-index-of hay needle 0) 0)))))
|
|
|
|
(define
|
|
js-regex-stub-exec
|
|
(fn
|
|
(rx s)
|
|
(let
|
|
((src (get rx "source")) (ci (get rx "ignoreCase")))
|
|
(let
|
|
((hay (if ci (js-lower-case s) s))
|
|
(needle (if ci (js-lower-case src) src)))
|
|
(let
|
|
((idx (js-string-index-of hay needle 0)))
|
|
(if
|
|
(= idx -1)
|
|
nil
|
|
(let
|
|
((matched (js-string-slice s idx (+ idx (len src))))
|
|
(res (list)))
|
|
(append! res matched)
|
|
res)))))))
|
|
|
|
(define
|
|
js-regex-invoke-method
|
|
(fn
|
|
(rx name args)
|
|
(cond
|
|
((= name "test")
|
|
(let
|
|
((impl (get __js_regex_platform__ "test"))
|
|
(arg
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0)))))
|
|
(cond
|
|
((or (js-undefined? impl) (= impl nil))
|
|
(js-regex-stub-test rx arg))
|
|
(else (impl rx arg)))))
|
|
((= name "exec")
|
|
(let
|
|
((impl (get __js_regex_platform__ "exec"))
|
|
(arg
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0)))))
|
|
(cond
|
|
((or (js-undefined? impl) (= impl nil))
|
|
(js-regex-stub-exec rx arg))
|
|
(else (impl rx arg)))))
|
|
((= name "toString")
|
|
(str "/" (get rx "source") "/" (get rx "flags")))
|
|
(else js-undefined))))
|
|
|
|
(define
|
|
js-list-find-index
|
|
(fn
|
|
(lst v i n)
|
|
(cond
|
|
((>= i n) -1)
|
|
((= (nth lst i) v) i)
|
|
(else (js-list-find-index lst v (+ i 1) n)))))
|
|
|
|
(define
|
|
js-list-remove-at!
|
|
(fn
|
|
(lst i)
|
|
(let
|
|
((n (len lst)) (kept (list)))
|
|
(begin
|
|
(js-list-remove-at-loop lst i n 0 kept)
|
|
kept))))
|
|
|
|
(define
|
|
js-list-remove-at-loop
|
|
(fn
|
|
(src skip n j out)
|
|
(cond
|
|
((>= j n) nil)
|
|
((= j skip) (js-list-remove-at-loop src skip n (+ j 1) out))
|
|
(else
|
|
(begin
|
|
(append! out (nth src j))
|
|
(js-list-remove-at-loop src skip n (+ j 1) out))))))
|
|
|
|
(define
|
|
js-map-ctor-fn
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(cond
|
|
((not (= (type-of this) "dict"))
|
|
(raise (js-new-call TypeError (js-args "Map must be constructed with new"))))
|
|
(else
|
|
(begin
|
|
(dict-set! this "__map_keys__" (list))
|
|
(dict-set! this "__map_vals__" (list))
|
|
(dict-set! this "size" 0)
|
|
(if
|
|
(and
|
|
(>= (len args) 1)
|
|
(not (js-undefined? (nth args 0)))
|
|
(not (= (nth args 0) nil)))
|
|
(js-map-init this (nth args 0))
|
|
nil)
|
|
this))))))
|
|
|
|
(define
|
|
js-map-init
|
|
(fn
|
|
(m iter)
|
|
(let
|
|
((entries (js-iterable-to-list iter)))
|
|
(for-each
|
|
(fn
|
|
(entry)
|
|
(cond
|
|
((list? entry)
|
|
(js-map-do-set m (nth entry 0) (nth entry 1)))
|
|
(else nil)))
|
|
entries))))
|
|
|
|
(define
|
|
js-map-do-set
|
|
(fn
|
|
(m k v)
|
|
(let
|
|
((ks (get m "__map_keys__")) (vs (get m "__map_vals__")))
|
|
(let
|
|
((idx (js-list-find-index ks k 0 (len ks))))
|
|
(cond
|
|
((>= idx 0) (begin (set-nth! vs idx v) m))
|
|
(else
|
|
(begin
|
|
(append! ks k)
|
|
(append! vs v)
|
|
(dict-set! m "size" (len ks))
|
|
m)))))))
|
|
|
|
(define
|
|
js-map-do-get
|
|
(fn
|
|
(m k)
|
|
(let
|
|
((ks (get m "__map_keys__")) (vs (get m "__map_vals__")))
|
|
(let
|
|
((idx (js-list-find-index ks k 0 (len ks))))
|
|
(cond ((>= idx 0) (nth vs idx)) (else js-undefined))))))
|
|
|
|
(define
|
|
js-map-do-has
|
|
(fn
|
|
(m k)
|
|
(let
|
|
((ks (get m "__map_keys__")))
|
|
(>= (js-list-find-index ks k 0 (len ks)) 0))))
|
|
|
|
(define
|
|
js-map-do-delete
|
|
(fn
|
|
(m k)
|
|
(let
|
|
((ks (get m "__map_keys__")) (vs (get m "__map_vals__")))
|
|
(let
|
|
((idx (js-list-find-index ks k 0 (len ks))))
|
|
(cond
|
|
((< idx 0) false)
|
|
(else
|
|
(let
|
|
((new-ks (js-list-remove-at! ks idx))
|
|
(new-vs (js-list-remove-at! vs idx)))
|
|
(begin
|
|
(dict-set! m "__map_keys__" new-ks)
|
|
(dict-set! m "__map_vals__" new-vs)
|
|
(dict-set! m "size" (len new-ks))
|
|
true))))))))
|
|
|
|
(define
|
|
js-map-do-clear
|
|
(fn
|
|
(m)
|
|
(begin
|
|
(dict-set! m "__map_keys__" (list))
|
|
(dict-set! m "__map_vals__" (list))
|
|
(dict-set! m "size" 0)
|
|
js-undefined)))
|
|
|
|
(define
|
|
js-map-do-foreach
|
|
(fn
|
|
(m cb &rest opts)
|
|
(let
|
|
((ks (get m "__map_keys__"))
|
|
(vs (get m "__map_vals__"))
|
|
(this-arg
|
|
(cond
|
|
((empty? opts) js-global-this)
|
|
((js-undefined? (nth opts 0)) js-global-this)
|
|
((= (nth opts 0) nil) js-global-this)
|
|
(else (nth opts 0)))))
|
|
(begin
|
|
(js-map-foreach-loop ks vs cb this-arg m 0 (len ks))
|
|
js-undefined))))
|
|
|
|
(define
|
|
js-map-foreach-loop
|
|
(fn
|
|
(ks vs cb this-arg m i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(js-call-with-this this-arg cb (list (nth vs i) (nth ks i) m))
|
|
(js-map-foreach-loop ks vs cb this-arg m (+ i 1) n))))))
|
|
|
|
(define
|
|
Map
|
|
{:length 0
|
|
:name "Map"
|
|
:__callable__ js-map-ctor-fn
|
|
:prototype
|
|
{:get (fn (k) (js-map-do-get (js-this) k))
|
|
:set (fn (k v) (js-map-do-set (js-this) k v))
|
|
:has (fn (k) (js-map-do-has (js-this) k))
|
|
:delete (fn (k) (js-map-do-delete (js-this) k))
|
|
:clear (fn () (js-map-do-clear (js-this)))
|
|
:forEach (fn (&rest args) (let ((cb (if (empty? args) :js-undefined (nth args 0))) (ta (if (>= (len args) 2) (nth args 1) :js-undefined))) (js-map-do-foreach (js-this) cb ta)))
|
|
:keys (fn () (let ((ks (get (js-this) "__map_keys__"))) (js-list-copy ks)))
|
|
:values (fn () (let ((vs (get (js-this) "__map_vals__"))) (js-list-copy vs)))
|
|
:entries
|
|
(fn ()
|
|
(let
|
|
((ks (get (js-this) "__map_keys__"))
|
|
(vs (get (js-this) "__map_vals__"))
|
|
(out (list)))
|
|
(begin
|
|
(js-map-entries-loop ks vs 0 (len ks) out)
|
|
out)))}})
|
|
|
|
(dict-set! (get Map "prototype") "constructor" Map)
|
|
|
|
(define
|
|
js-list-copy
|
|
(fn
|
|
(src)
|
|
(let
|
|
((out (list)))
|
|
(begin (for-each (fn (x) (append! out x)) src) out))))
|
|
|
|
(define
|
|
js-map-entries-loop
|
|
(fn
|
|
(ks vs i n out)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(append! out (list (nth ks i) (nth vs i)))
|
|
(js-map-entries-loop ks vs (+ i 1) n out))))))
|
|
|
|
(define
|
|
js-set-ctor-fn
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(cond
|
|
((not (= (type-of this) "dict"))
|
|
(raise (js-new-call TypeError (js-args "Set must be constructed with new"))))
|
|
(else
|
|
(begin
|
|
(dict-set! this "__set_items__" (list))
|
|
(dict-set! this "size" 0)
|
|
(if
|
|
(and
|
|
(>= (len args) 1)
|
|
(not (js-undefined? (nth args 0)))
|
|
(not (= (nth args 0) nil)))
|
|
(js-set-init this (nth args 0))
|
|
nil)
|
|
this))))))
|
|
|
|
(define
|
|
js-set-init
|
|
(fn
|
|
(s iter)
|
|
(let
|
|
((items (js-iterable-to-list iter)))
|
|
(for-each (fn (x) (js-set-do-add s x)) items))))
|
|
|
|
(define
|
|
js-set-do-add
|
|
(fn
|
|
(s v)
|
|
(let
|
|
((items (get s "__set_items__")))
|
|
(let
|
|
((idx (js-list-find-index items v 0 (len items))))
|
|
(cond
|
|
((>= idx 0) s)
|
|
(else
|
|
(begin
|
|
(append! items v)
|
|
(dict-set! s "size" (len items))
|
|
s)))))))
|
|
|
|
(define
|
|
js-set-do-has
|
|
(fn
|
|
(s v)
|
|
(let
|
|
((items (get s "__set_items__")))
|
|
(>= (js-list-find-index items v 0 (len items)) 0))))
|
|
|
|
(define
|
|
js-set-do-delete
|
|
(fn
|
|
(s v)
|
|
(let
|
|
((items (get s "__set_items__")))
|
|
(let
|
|
((idx (js-list-find-index items v 0 (len items))))
|
|
(cond
|
|
((< idx 0) false)
|
|
(else
|
|
(let
|
|
((new-items (js-list-remove-at! items idx)))
|
|
(begin
|
|
(dict-set! s "__set_items__" new-items)
|
|
(dict-set! s "size" (len new-items))
|
|
true))))))))
|
|
|
|
(define
|
|
js-set-do-clear
|
|
(fn
|
|
(s)
|
|
(begin
|
|
(dict-set! s "__set_items__" (list))
|
|
(dict-set! s "size" 0)
|
|
js-undefined)))
|
|
|
|
(define
|
|
js-set-do-foreach
|
|
(fn
|
|
(s cb &rest opts)
|
|
(let
|
|
((items (get s "__set_items__"))
|
|
(this-arg
|
|
(cond
|
|
((empty? opts) js-global-this)
|
|
((js-undefined? (nth opts 0)) js-global-this)
|
|
((= (nth opts 0) nil) js-global-this)
|
|
(else (nth opts 0)))))
|
|
(begin
|
|
(js-set-foreach-loop items cb this-arg s 0 (len items))
|
|
js-undefined))))
|
|
|
|
(define
|
|
js-set-foreach-loop
|
|
(fn
|
|
(items cb this-arg s i n)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(js-call-with-this
|
|
this-arg
|
|
cb
|
|
(list (nth items i) (nth items i) s))
|
|
(js-set-foreach-loop items cb this-arg s (+ i 1) n))))))
|
|
|
|
(define
|
|
Set
|
|
{:length 0
|
|
:name "Set"
|
|
:__callable__ js-set-ctor-fn
|
|
:prototype
|
|
{:add (fn (v) (js-set-do-add (js-this) v))
|
|
:has (fn (v) (js-set-do-has (js-this) v))
|
|
:delete (fn (v) (js-set-do-delete (js-this) v))
|
|
:clear (fn () (js-set-do-clear (js-this)))
|
|
:forEach (fn (&rest args) (let ((cb (if (empty? args) :js-undefined (nth args 0))) (ta (if (>= (len args) 2) (nth args 1) :js-undefined))) (js-set-do-foreach (js-this) cb ta)))
|
|
:keys (fn () (js-list-copy (get (js-this) "__set_items__")))
|
|
:values (fn () (js-list-copy (get (js-this) "__set_items__")))
|
|
:entries
|
|
(fn ()
|
|
(let
|
|
((items (get (js-this) "__set_items__")) (out (list)))
|
|
(begin
|
|
(js-set-entries-loop items 0 (len items) out)
|
|
out)))}})
|
|
|
|
(dict-set! (get Set "prototype") "constructor" Set)
|
|
|
|
(define
|
|
js-set-entries-loop
|
|
(fn
|
|
(items i n out)
|
|
(cond
|
|
((>= i n) nil)
|
|
(else
|
|
(begin
|
|
(append! out (list (nth items i) (nth items i)))
|
|
(js-set-entries-loop items (+ i 1) n out))))))
|
|
|
|
(begin
|
|
(dict-set! Object "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! Array "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! Number "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! String "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! Boolean "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! Map "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! Set "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! Date "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! RegExp "__proto__" (get js-function-global "prototype"))
|
|
(dict-set! __js_ctor_proto__ (js-ctor-id TypeError) Error)
|
|
(dict-set! __js_ctor_proto__ (js-ctor-id RangeError) Error)
|
|
(dict-set! __js_ctor_proto__ (js-ctor-id SyntaxError) Error)
|
|
(dict-set! __js_ctor_proto__ (js-ctor-id ReferenceError) Error)
|
|
(dict-set! __js_ctor_proto__ (js-ctor-id URIError) Error)
|
|
(dict-set! __js_ctor_proto__ (js-ctor-id EvalError) Error)
|
|
(dict-set! (js-get-ctor-proto TypeError) "__proto__" (js-get-ctor-proto Error))
|
|
(dict-set! (js-get-ctor-proto RangeError) "__proto__" (js-get-ctor-proto Error))
|
|
(dict-set! (js-get-ctor-proto SyntaxError) "__proto__" (js-get-ctor-proto Error))
|
|
(dict-set! (js-get-ctor-proto ReferenceError) "__proto__" (js-get-ctor-proto Error))
|
|
(dict-set! (js-get-ctor-proto URIError) "__proto__" (js-get-ctor-proto Error))
|
|
(dict-set! (js-get-ctor-proto EvalError) "__proto__" (js-get-ctor-proto Error))
|
|
(dict-set! (js-get-ctor-proto Error) "__proto__" (get Object "prototype"))
|
|
(dict-set! (js-get-ctor-proto Error) "name" "Error")
|
|
(dict-set! (js-get-ctor-proto Error) "message" "")
|
|
(dict-set! (js-get-ctor-proto Error) "constructor" Error)
|
|
(dict-set! (js-get-ctor-proto TypeError) "name" "TypeError")
|
|
(dict-set! (js-get-ctor-proto TypeError) "constructor" TypeError)
|
|
(dict-set! (js-get-ctor-proto RangeError) "name" "RangeError")
|
|
(dict-set! (js-get-ctor-proto RangeError) "constructor" RangeError)
|
|
(dict-set! (js-get-ctor-proto SyntaxError) "name" "SyntaxError")
|
|
(dict-set! (js-get-ctor-proto SyntaxError) "constructor" SyntaxError)
|
|
(dict-set! (js-get-ctor-proto ReferenceError) "name" "ReferenceError")
|
|
(dict-set! (js-get-ctor-proto ReferenceError) "constructor" ReferenceError)
|
|
(dict-set! (js-get-ctor-proto URIError) "name" "URIError")
|
|
(dict-set! (js-get-ctor-proto URIError) "constructor" URIError)
|
|
(dict-set! (js-get-ctor-proto EvalError) "name" "EvalError")
|
|
(dict-set! (js-get-ctor-proto EvalError) "constructor" EvalError)
|
|
(dict-set! (get Array "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get Number "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get String "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get Boolean "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get Map "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get Set "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get Date "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get Date "prototype") "constructor" Date)
|
|
(dict-set! (get RegExp "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get RegExp "prototype") "constructor" RegExp)
|
|
(dict-set! (get js-function-global "prototype") "__proto__" (get Object "prototype"))
|
|
(dict-set! (get Number "prototype") "__js_number_value__" 0)
|
|
(dict-set! (get String "prototype") "__js_string_value__" "")
|
|
(dict-set! (get Boolean "prototype") "__js_boolean_value__" false))
|
|
|
|
(define js-global {:undefined js-undefined :JSON JSON :parseInt parseInt :Object Object :isNaN js-global-is-nan :Infinity inf :NaN 0 :String String :Boolean Boolean :Array Array :Math Math :parseFloat parseFloat :Number Number :console console :isFinite js-global-is-finite :Map Map :Set Set :Date Date :RegExp RegExp :Function js-function-global :Error Error :TypeError TypeError :RangeError RangeError :SyntaxError SyntaxError :ReferenceError ReferenceError :URIError URIError :EvalError EvalError :encodeURI encodeURI :decodeURI decodeURI :encodeURIComponent encodeURIComponent :decodeURIComponent decodeURIComponent :eval js-global-eval :Promise Promise :Symbol :js-undefined :AggregateError :js-undefined :SuppressedError :js-undefined :globalThis nil})
|
|
|
|
(set! js-global-this js-global)
|