giles
275d2ecbae
Strings: includes, startsWith, endsWith, trim, trimStart, trimEnd, repeat, padStart, padEnd, toString, valueOf. Object: keys, values, entries, assign, freeze (no-op). Array: isArray, of. All wired into js-global. 17 new unit tests. 357/359 unit (+17), 148/148 slice unchanged.
1925 lines
51 KiB
Plaintext
1925 lines
51 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-undefined :js-undefined)
|
|
|
|
(define js-undefined? (fn (v) (= v :js-undefined)))
|
|
|
|
;; ── Type predicates ───────────────────────────────────────────────
|
|
|
|
(define __js_this_cell__ (dict))
|
|
|
|
;; ── Boolean coercion (ToBoolean) ──────────────────────────────────
|
|
|
|
(define
|
|
js-this
|
|
(fn
|
|
()
|
|
(if
|
|
(dict-has? __js_this_cell__ "this")
|
|
(get __js_this_cell__ "this")
|
|
:js-undefined)))
|
|
|
|
;; ── Numeric coercion (ToNumber) ───────────────────────────────────
|
|
|
|
(define js-this-set! (fn (v) (dict-set! __js_this_cell__ "this" v)))
|
|
|
|
;; 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-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))))))
|
|
|
|
;; 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-apply-fn
|
|
(fn
|
|
(fn-val args)
|
|
(cond
|
|
((= (len args) 0) (fn-val))
|
|
((= (len args) 1) (fn-val (nth args 0)))
|
|
((= (len args) 2) (fn-val (nth args 0) (nth args 1)))
|
|
((= (len args) 3) (fn-val (nth args 0) (nth args 1) (nth args 2)))
|
|
((= (len args) 4)
|
|
(fn-val (nth args 0) (nth args 1) (nth args 2) (nth args 3)))
|
|
((= (len args) 5)
|
|
(fn-val
|
|
(nth args 0)
|
|
(nth args 1)
|
|
(nth args 2)
|
|
(nth args 3)
|
|
(nth args 4)))
|
|
((= (len args) 6)
|
|
(fn-val
|
|
(nth args 0)
|
|
(nth args 1)
|
|
(nth args 2)
|
|
(nth args 3)
|
|
(nth args 4)
|
|
(nth args 5)))
|
|
(else (apply fn-val args)))))
|
|
|
|
;; Minimal string->number for the slice. Handles integers, negatives,
|
|
;; and simple decimals. Returns 0 on malformed input.
|
|
(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))
|
|
(else
|
|
(let
|
|
((m (js-get-prop recv key)))
|
|
(cond
|
|
((js-undefined? m)
|
|
(error
|
|
(str "TypeError: " (js-to-string key) " is not a function")))
|
|
(else (js-call-with-this recv m args))))))))
|
|
|
|
(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 ""))))
|
|
|
|
(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)
|
|
(error "TypeError: undefined is not a function"))
|
|
(else (js-call-with-this :js-undefined fn-val args)))))
|
|
|
|
;; 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-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)) (= (type-of ret) "dict"))
|
|
ret
|
|
obj))))))
|
|
|
|
(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))))))
|
|
|
|
(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))))))))
|
|
|
|
;; ── String coercion (ToString) ────────────────────────────────────
|
|
|
|
(define
|
|
js-in
|
|
(fn
|
|
(key obj)
|
|
(cond
|
|
((not (= (type-of obj) "dict")) false)
|
|
(else (js-in-walk obj (js-to-string key))))))
|
|
|
|
(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))))
|
|
|
|
;; ── Arithmetic (JS rules) ─────────────────────────────────────────
|
|
|
|
;; JS `+`: if either operand is a string → string concat, else numeric.
|
|
(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))))
|
|
|
|
(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
|
|
js-function?
|
|
(fn
|
|
(v)
|
|
(let
|
|
((t (type-of v)))
|
|
(or (= t "lambda") (= t "function") (= t "component")))))
|
|
|
|
(define __js_proto_table__ (dict))
|
|
|
|
(define __js_next_id__ (dict))
|
|
|
|
;; Bitwise + logical-not
|
|
(dict-set! __js_next_id__ "n" 0)
|
|
|
|
(define
|
|
js-get-ctor-proto
|
|
(fn
|
|
(ctor)
|
|
(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)))))))
|
|
|
|
;; ── Equality ──────────────────────────────────────────────────────
|
|
|
|
;; Strict equality (===): no coercion; js-undefined matches js-undefined.
|
|
(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))))
|
|
|
|
;; Abstract equality (==): type coercion rules.
|
|
;; Simplified: number↔string coerce both to number; null == undefined;
|
|
;; everything else falls back to strict equality.
|
|
(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) "native-fn") "function")
|
|
(else "object"))))
|
|
|
|
;; ── Relational comparisons ────────────────────────────────────────
|
|
|
|
;; Abstract relational comparison from ES5.
|
|
;; Numbers compare numerically; two strings compare lexicographically;
|
|
;; mixed types coerce both to numbers.
|
|
(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) 0)
|
|
((= v nil) 0)
|
|
((= v true) 1)
|
|
((= v false) 0)
|
|
((= (type-of v) "number") v)
|
|
((= (type-of v) "string") (js-string-to-number v))
|
|
(else 0))))
|
|
|
|
(define
|
|
js-string-to-number
|
|
(fn (s) (cond ((= s "") 0) (else (js-parse-num-safe s)))))
|
|
|
|
(define js-parse-num-safe (fn (s) (cond (else (js-num-from-string s)))))
|
|
|
|
(define
|
|
js-num-from-string
|
|
(fn
|
|
(s)
|
|
(let
|
|
((trimmed (js-trim s)))
|
|
(cond
|
|
((= trimmed "") 0)
|
|
(else (js-parse-decimal trimmed 0 0 1 false 0))))))
|
|
|
|
(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))))
|
|
|
|
;; ── 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-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)))))
|
|
|
|
;; Setter — mutates the dict. Returns the new value (JS assignment yields rhs).
|
|
(define
|
|
js-is-space?
|
|
(fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
|
|
|
|
;; ── 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-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")))))
|
|
|
|
;; ── console.log ───────────────────────────────────────────────────
|
|
|
|
;; Trivial bridge. `log-info` is available on OCaml; fall back to print.
|
|
(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 (str v)))))
|
|
|
|
;; ── Math object ───────────────────────────────────────────────────
|
|
|
|
(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-number-to-string (fn (n) (str 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) (js-to-number b))))
|
|
(define js-mod (fn (a b) (mod (js-to-number a) (js-to-number b))))
|
|
(define js-pow (fn (a b) (pow (js-to-number a) (js-to-number b)))) ; deterministic placeholder for tests
|
|
|
|
(define js-neg (fn (a) (- 0 (js-to-number a))))
|
|
|
|
;; 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-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 (= 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)))
|
|
(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) 0))))
|
|
((= 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)))))
|
|
(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-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 i)))
|
|
(if
|
|
(and (>= idx 0) (< idx (len s)))
|
|
(char-code (char-at s idx))
|
|
0))))
|
|
((= name "indexOf")
|
|
(fn (needle) (js-string-index-of s (js-to-string needle) 0)))
|
|
((= 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 (sep) (js-string-split s (js-to-string sep))))
|
|
((= 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))
|
|
(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-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-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))
|
|
((= 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"))
|
|
(else js-undefined)))
|
|
((= (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"))
|
|
(else 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) (= (js-to-string key) "prototype"))
|
|
(js-get-ctor-proto obj))
|
|
(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))
|
|
(else js-undefined)))))
|
|
|
|
(define
|
|
js-num-to-int
|
|
(fn (n) (if (>= n 0) (floor n) (- 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))))))
|
|
((= key "length") 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) (- 0 (/ 1 0)))
|
|
(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) (/ 1 0))
|
|
(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)))))))
|
|
|
|
(define Math {:random js-math-random :trunc js-math-trunc :LN10 2.30259 :SQRT1_2 0.707107 :floor js-math-floor :PI 3.14159 :sqrt js-math-sqrt :hypot js-math-hypot :LOG2E 1.4427 :round js-math-round :ceil js-math-ceil :abs js-math-abs :pow js-math-pow :max js-math-max :LOG10E 0.434294 :SQRT2 1.41421 :cbrt js-math-cbrt :min js-math-min :sign js-math-sign :E 2.71828 :LN2 0.693147})
|
|
|
|
(define
|
|
js-number-is-finite
|
|
(fn
|
|
(v)
|
|
(and
|
|
(number? v)
|
|
(not (js-number-is-nan v))
|
|
(not (= v (/ 1 0)))
|
|
(not (= v (/ -1 0))))))
|
|
|
|
(define js-number-is-nan (fn (v) (and (number? v) (not (= v v)))))
|
|
|
|
(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 {:isFinite js-number-is-finite :MAX_SAFE_INTEGER 9007199254740991 :EPSILON 2.22045e-16 :MAX_VALUE 0 :POSITIVE_INFINITY inf :isInteger js-number-is-integer :isNaN js-number-is-nan :isSafeInteger js-number-is-safe-integer :NEGATIVE_INFINITY -inf :NaN 0 :MIN_VALUE 4.94066e-324 :MIN_SAFE_INTEGER -9007199254740991})
|
|
|
|
(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-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 Object {:entries js-object-entries :values js-object-values :freeze js-object-freeze :assign js-object-assign :keys js-object-keys})
|
|
|
|
(define js-array-is-array (fn (v) (list? v)))
|
|
|
|
(define js-array-of (fn (&rest args) args))
|
|
|
|
(define Array {:isArray js-array-is-array :of js-array-of})
|
|
|
|
(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)
|
|
(dict-set! res "index" idx)
|
|
(dict-set! res "input" s)
|
|
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))))
|
|
|
|
(define js-global {:isFinite js-global-is-finite :console console :Number Number :Math Math :Array Array :NaN 0 :Infinity inf :isNaN js-global-is-nan :Object Object :undefined js-undefined})
|