giles
fb0ca374a3
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
js-unmap-fn-name had mappings for older Math methods but not the trig/hyperbolic/log family added later. Added 22 mappings for sin, cos, tan, asin, acos, atan, atan2, sinh, cosh, tanh, asinh, acosh, atanh, exp, log, log2, log10, expm1, log1p, clz32, imul, fround. built-ins/Math: 42/45 → 45/45 (100%). conformance.sh: 148/148.
4593 lines
131 KiB
Plaintext
4593 lines
131 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) (error "TypeError: Function constructor not supported")) :prototype {:call (fn (&rest args) :js-undefined) :length 0 :bind (fn (&rest args) (fn () :js-undefined)) :toString (fn () "function () { [native code] }") :apply (fn (&rest args) :js-undefined) :name ""}})
|
|
|
|
;; ── 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) (if (empty? args) :js-undefined (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-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") (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-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-invoke-function-method
|
|
(fn
|
|
(recv key args)
|
|
(cond
|
|
((= key "call")
|
|
(let
|
|
((this-arg (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 this-arg recv rest)))
|
|
((= key "apply")
|
|
(let
|
|
((this-arg (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 this-arg recv rest))))
|
|
((= key "bind")
|
|
(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)))))
|
|
(fn
|
|
(&rest more)
|
|
(js-call-with-this this-arg recv (js-list-concat bound more)))))
|
|
((= key "toString") "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
|
|
(error
|
|
(str
|
|
"TypeError: "
|
|
(js-to-string key)
|
|
" is not a function (on number)"))))))
|
|
|
|
(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
|
|
(error
|
|
(str
|
|
"TypeError: "
|
|
(js-to-string key)
|
|
" is not a function (on boolean)"))))))
|
|
|
|
(define
|
|
js-num-to-str-radix
|
|
(fn
|
|
(n radix)
|
|
(cond
|
|
((and (number? n) (not (= n n))) "NaN")
|
|
((= n (/ 1 0)) "Infinity")
|
|
((= n (/ -1 0)) "-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)
|
|
(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 (= (type-of obj) "dict")) false)
|
|
((not (js-function? ctor))
|
|
(error "TypeError: Right-hand side of instanceof is not callable"))
|
|
(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
|
|
Error
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(begin
|
|
(if
|
|
(= (type-of this) "dict")
|
|
(do
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0))))
|
|
(dict-set! this "name" "Error"))
|
|
nil)
|
|
this))))
|
|
|
|
;; ── Math object ───────────────────────────────────────────────────
|
|
|
|
(define
|
|
TypeError
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(begin
|
|
(if
|
|
(= (type-of this) "dict")
|
|
(do
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0))))
|
|
(dict-set! this "name" "TypeError"))
|
|
nil)
|
|
this))))
|
|
(define
|
|
RangeError
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(begin
|
|
(if
|
|
(= (type-of this) "dict")
|
|
(do
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0))))
|
|
(dict-set! this "name" "RangeError"))
|
|
nil)
|
|
this))))
|
|
(define
|
|
SyntaxError
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(begin
|
|
(if
|
|
(= (type-of this) "dict")
|
|
(do
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0))))
|
|
(dict-set! this "name" "SyntaxError"))
|
|
nil)
|
|
this))))
|
|
(define
|
|
ReferenceError
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(begin
|
|
(if
|
|
(= (type-of this) "dict")
|
|
(do
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0))))
|
|
(dict-set! this "name" "ReferenceError"))
|
|
nil)
|
|
this))))
|
|
(define
|
|
URIError
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(begin
|
|
(if
|
|
(= this :js-undefined)
|
|
nil
|
|
(do
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if (empty? args) "" (js-to-string (nth args 0))))
|
|
(dict-set! this "name" "URIError")))
|
|
this))))
|
|
(define
|
|
EvalError
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this (js-this)))
|
|
(begin
|
|
(if
|
|
(= this :js-undefined)
|
|
nil
|
|
(do
|
|
(dict-set!
|
|
this
|
|
"message"
|
|
(if (empty? args) "" (js-to-string (nth args 0))))
|
|
(dict-set! this "name" "EvalError")))
|
|
this))))
|
|
(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) "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-to-boolean
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((js-undefined? v) false)
|
|
((= v nil) false)
|
|
((= v false) false)
|
|
((= v 0) 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) "string") (js-string-to-number v))
|
|
((= (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
|
|
(not (= (type-of result) "dict"))
|
|
(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
|
|
(not (= (type-of result2) "dict"))
|
|
(js-to-number result2)
|
|
(js-nan-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-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) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
|
|
|
|
(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))
|
|
(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
|
|
(= (type-of result) "dict")
|
|
(let
|
|
((valueof-fn (js-get-prop v "valueOf")))
|
|
(if
|
|
(= (type-of valueof-fn) "lambda")
|
|
(let
|
|
((result2 (js-call-with-this v valueof-fn ())))
|
|
(if
|
|
(= (type-of result2) "dict")
|
|
(raise
|
|
(js-new-call
|
|
TypeError
|
|
(list
|
|
"Cannot convert object to primitive value")))
|
|
(js-to-string result2)))
|
|
"[object Object]"))
|
|
(js-to-string result)))
|
|
"[object Object]"))))
|
|
(if (= (type-of v) "list") (js-list-join v ",") (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
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((or (= (type-of a) "string") (= (type-of b) "string"))
|
|
(str (js-to-string a) (js-to-string b)))
|
|
(else (+ (js-to-number a) (js-to-number b))))))
|
|
|
|
(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-pow (fn (a b) (pow (js-to-number a) (js-to-number 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-strict-eq
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((and (js-undefined? a) (js-undefined? b)) true)
|
|
((or (js-undefined? a) (js-undefined? b)) false)
|
|
((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 (= (type-of a) "number") (= (type-of b) "string"))
|
|
(= a (js-to-number b)))
|
|
((and (= (type-of a) "string") (= (type-of b) "number"))
|
|
(= (js-to-number a) b))
|
|
((= (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)
|
|
(cond
|
|
((and (= (type-of a) "string") (= (type-of b) "string"))
|
|
(js-str-lt a b))
|
|
(else (< (js-to-number a) (js-to-number b))))))
|
|
|
|
(define js-gt (fn (a b) (js-lt b a)))
|
|
|
|
(define js-le (fn (a b) (not (js-lt b a))))
|
|
|
|
(define js-ge (fn (a b) (not (js-lt a b))))
|
|
|
|
(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 (f) (js-list-map-loop f arr 0 (list))))
|
|
((= name "filter")
|
|
(fn (f) (js-list-filter-loop f arr 0 (list))))
|
|
((= name "forEach")
|
|
(fn
|
|
(f)
|
|
(begin (js-list-foreach-loop f arr 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 (f) (js-list-find-loop f arr 0)))
|
|
((= name "findIndex")
|
|
(fn (f) (js-list-find-index-loop f arr 0)))
|
|
((= name "some") (fn (f) (js-list-some-loop f arr 0)))
|
|
((= name "every") (fn (f) (js-list-every-loop f arr 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 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 i acc)
|
|
(cond
|
|
((>= i (len arr)) acc)
|
|
(else
|
|
(do
|
|
(append! acc (f (nth arr i)))
|
|
(js-list-map-loop f arr (+ i 1) acc))))))
|
|
|
|
(define
|
|
js-list-filter-loop
|
|
(fn
|
|
(f arr i acc)
|
|
(cond
|
|
((>= i (len arr)) acc)
|
|
(else
|
|
(do
|
|
(let
|
|
((v (nth arr i)))
|
|
(if (js-to-boolean (f v)) (append! acc v) nil))
|
|
(js-list-filter-loop f arr (+ i 1) acc))))))
|
|
|
|
(define
|
|
js-list-foreach-loop
|
|
(fn
|
|
(f arr i)
|
|
(cond
|
|
((>= i (len arr)) nil)
|
|
(else
|
|
(do (f (nth arr i)) (js-list-foreach-loop f arr (+ i 1)))))))
|
|
|
|
(define
|
|
js-list-reduce-loop
|
|
(fn
|
|
(f acc arr i)
|
|
(cond
|
|
((>= i (len arr)) acc)
|
|
(else
|
|
(js-list-reduce-loop f (f acc (nth arr i)) arr (+ i 1))))))
|
|
|
|
(define
|
|
js-list-find-loop
|
|
(fn
|
|
(f arr i)
|
|
(cond
|
|
((>= i (len arr)) js-undefined)
|
|
((js-to-boolean (f (nth arr i))) (nth arr i))
|
|
(else (js-list-find-loop f arr (+ i 1))))))
|
|
|
|
(define
|
|
js-list-find-index-loop
|
|
(fn
|
|
(f arr i)
|
|
(cond
|
|
((>= i (len arr)) -1)
|
|
((js-to-boolean (f (nth arr i))) i)
|
|
(else (js-list-find-index-loop f arr (+ i 1))))))
|
|
|
|
(define
|
|
js-list-some-loop
|
|
(fn
|
|
(f arr i)
|
|
(cond
|
|
((>= i (len arr)) false)
|
|
((js-to-boolean (f (nth arr i))) true)
|
|
(else (js-list-some-loop f arr (+ 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 i)
|
|
(cond
|
|
((>= i (len arr)) true)
|
|
((not (js-to-boolean (f (nth arr i)))) false)
|
|
(else (js-list-every-loop f arr (+ 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 (f acc (nth arr i)) 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
|
|
(if
|
|
(< (len args) 2)
|
|
-1
|
|
(js-num-to-int (nth args 1)))))
|
|
(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-array-method obj "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 (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)
|
|
((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)))
|
|
|
|
(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")
|
|
(do (dict-set! obj (js-to-string key) val) val))
|
|
((= (type-of obj) "list") (do (js-list-set! obj key 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 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 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) (pow (js-to-number a) (js-to-number 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 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 (fn (d) (js-number-to-fixed (js-this) (if (= d nil) 0 (js-to-number d)))) :toExponential (fn (&rest args) (js-to-string (js-this))) :toLocaleString (fn () (js-to-string (js-this))) :toString (fn (&rest args) (let ((this-val (js-this)) (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)))) :toPrecision (fn (&rest args) (js-to-string (js-this))) :valueOf (fn () (js-this))} :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-object-keys
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((dict? o)
|
|
(let
|
|
((result (list)))
|
|
(for-each (fn (k) (append! result k)) (keys o))
|
|
result))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-object-values
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((dict? o)
|
|
(let
|
|
((result (list)))
|
|
(for-each (fn (k) (append! result (get o k))) (keys o))
|
|
result))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-object-entries
|
|
(fn
|
|
(o)
|
|
(cond
|
|
((dict? o)
|
|
(let
|
|
((result (list)))
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(let
|
|
((pair (list)))
|
|
(append! pair k)
|
|
(append! pair (get o k))
|
|
(append! result pair)))
|
|
(keys o))
|
|
result))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-object-assign
|
|
(fn
|
|
(&rest args)
|
|
(cond
|
|
((= (len args) 0) (dict))
|
|
(else
|
|
(let
|
|
((target (nth args 0)))
|
|
(for-each
|
|
(fn
|
|
(src)
|
|
(when
|
|
(dict? src)
|
|
(for-each
|
|
(fn (k) (dict-set! target k (get src k)))
|
|
(keys src))))
|
|
(rest args))
|
|
target)))))
|
|
|
|
(define js-object-freeze (fn (o) o))
|
|
|
|
(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)
|
|
(if (contains? (keys o) "__proto__") (get o "__proto__") 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
|
|
((list? o)
|
|
(let ((r (list))) (begin (js-list-keys-loop o 0 r) r)))
|
|
((dict? o) (js-object-keys o))
|
|
(else (list)))))
|
|
|
|
(define
|
|
js-object-get-own-property-descriptor
|
|
(fn
|
|
(o key)
|
|
(if
|
|
(and (dict? o) (contains? (keys o) (js-to-string key)))
|
|
{:configurable true :enumerable true :value (get o (js-to-string key)) :writable true}
|
|
: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 () "[object Object]") :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)
|
|
(begin (dict-set! obj (js-to-string key) js-undefined) 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
|
|
(fn
|
|
(name)
|
|
(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))))))
|
|
|
|
(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))))
|
|
(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)
|
|
(append! result (map-fn x))
|
|
(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
|
|
(fn
|
|
(name)
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-val (js-this)))
|
|
(let
|
|
((s (cond ((= (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 "[object Object]"))))
|
|
(js-invoke-method s name args))))))
|
|
|
|
(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)))
|
|
(if
|
|
(and
|
|
(= (type-of this-val) "dict")
|
|
(contains? (keys this-val) "__js_boolean_value__"))
|
|
(get this-val "__js_boolean_value__")
|
|
this-val))))
|
|
|
|
(dict-set!
|
|
(get Boolean "prototype")
|
|
"toString"
|
|
(fn
|
|
(&rest args)
|
|
(let
|
|
((this-val (js-this)))
|
|
(let
|
|
((b (if (and (= (type-of this-val) "dict") (contains? (keys this-val) "__js_boolean_value__")) (get this-val "__js_boolean_value__") this-val)))
|
|
(if b "true" "false")))))
|
|
|
|
(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)
|
|
(let
|
|
((end (js-float-prefix-end s 0 false false false)))
|
|
(cond
|
|
((= end 0) (js-nan-value))
|
|
(else (js-parse-num-safe (js-string-slice s 0 end)))))))
|
|
|
|
(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) (js-to-string v)))
|
|
|
|
(define encodeURI (fn (v) (js-to-string v)))
|
|
|
|
(define decodeURI (fn (v) (js-to-string v)))
|
|
|
|
(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)
|
|
(if
|
|
(= (len args) 0)
|
|
js-undefined
|
|
(js-json-stringify-value (nth args 0)))))
|
|
|
|
(define
|
|
js-json-stringify-value
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((= v nil) "null")
|
|
((js-undefined? v) js-undefined)
|
|
((= (type-of v) "boolean") (if v "true" "false"))
|
|
((number? v) (js-number-to-string v))
|
|
((= (type-of v) "string") (js-json-escape-string v))
|
|
((list? v)
|
|
(let
|
|
((parts (list)))
|
|
(for-each
|
|
(fn
|
|
(x)
|
|
(let
|
|
((s (js-json-stringify-value x)))
|
|
(if
|
|
(js-undefined? s)
|
|
(append! parts "null")
|
|
(append! parts s))))
|
|
v)
|
|
(str "[" (join "," parts) "]")))
|
|
((dict? v)
|
|
(let
|
|
((parts (list)))
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(let
|
|
((val (get v k)))
|
|
(let
|
|
((vs (js-json-stringify-value val)))
|
|
(if
|
|
(not (js-undefined? vs))
|
|
(append! parts (str (js-json-escape-string k) ":" vs))))))
|
|
(keys v))
|
|
(str "{" (join "," parts) "}")))
|
|
(else "null"))))
|
|
|
|
(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)
|
|
js-undefined
|
|
(let
|
|
((st (dict)))
|
|
(dict-set! st "s" (js-to-string (nth args 0)))
|
|
(dict-set! st "i" 0)
|
|
(js-json-parse-value st)))))
|
|
|
|
(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)) (error "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)) nil)
|
|
((= (char-at s i) "\"") nil)
|
|
((= (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 (error "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")) ":"))
|
|
(error "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 (error "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)))))
|
|
(if
|
|
(js-undefined? impl)
|
|
(js-regex-stub-test rx arg)
|
|
(impl rx arg))))
|
|
((= name "exec")
|
|
(let
|
|
((impl (get __js_regex_platform__ "exec"))
|
|
(arg
|
|
(if
|
|
(= (len args) 0)
|
|
""
|
|
(js-to-string (nth args 0)))))
|
|
(if
|
|
(js-undefined? impl)
|
|
(js-regex-stub-exec rx arg)
|
|
(impl rx arg))))
|
|
((= name "toString")
|
|
(str "/" (get rx "source") "/" (get rx "flags")))
|
|
(else js-undefined))))
|
|
|
|
(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")))
|
|
|
|
(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})
|