coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

js-on-sx: fix rational-zero-division in core constants + charCodeAt
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
Details

Browse Source 
(/ 0 0), (/ 1 0), (/ -1 0) throw "rational: division by zero" with
the OCaml binary's integer rational arithmetic. Replace with nan/inf
literals in js-nan-value, js-infinity-value, js-number-is-finite,
js-math-min, js-math-max. js-max-value-approx looped forever (rationals
never reach float infinity); replace with literal 1.7976931348623157e+308.
charCodeAt and string .length called missing unicode-len /
unicode-char-code-at primitives — switch to (len s) and
(char-code (char-at s idx)). conformance.sh: 0→148/148.
This commit is contained in:
giles
2026-05-06 21:02:58 +00:00
parent f93b13e861
commit 066ddcd6e1
2 changed files with 68 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

91
lib/js/runtime.sx
View File

@@ -13,13 +13,13 @@
;; 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 () (/ 0 0)))
(define js-nan-value (fn () nan))
(define js-infinity-value (fn () (/ 1 0)))
(define js-infinity-value (fn () inf))
;; ── Type predicates ───────────────────────────────────────────────
(define js-max-value-approx (fn () (js-max-value-loop 1 2000)))
(define js-max-value-approx (fn () 1.7976931348623157e+308))
;; ── Boolean coercion (ToBoolean) ──────────────────────────────────
@@ -2049,15 +2049,18 @@
(i)
(let
((idx (js-num-to-int i)))
(if (and (>= idx 0) (< idx (len s))) (char-at s idx) ""))))
(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 (unicode-len s)))
(unicode-char-code-at s idx)
(and (>= idx 0) (< idx (len s)))
(char-code (char-at s idx))
(js-nan-value)))))
((= name "indexOf")
(fn
@@ -2068,14 +2071,20 @@
(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))))))))
(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)))))
(if
(< (len args) 2)
(len s)
(js-num-to-int (nth args 1)))))
(js-string-slice s start stop))))
((= name "substring")
(fn
@@ -2098,7 +2107,10 @@
(let
((sep (if (= (len args) 0) :js-undefined (nth args 0)))
(limit
(if (< (len args) 2) -1 (js-num-to-int (nth args 1)))))
(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))))))
@@ -2115,7 +2127,11 @@
(&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)))))
(start
(if
(< (len args) 2)
0
(js-num-to-int (nth args 1)))))
(js-string-matches? s needle start 0))))
((= name "endsWith")
(fn
@@ -2138,14 +2154,22 @@
(&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)))))
(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)))))
(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))
@@ -2175,7 +2199,8 @@
(js-string-slice s (+ idx (len src)) (len s)))))))))
(else
(let
((needle (js-to-string (nth args 0))) (repl (nth args 1)))
((needle (js-to-string (nth args 0)))
(repl (nth args 1)))
(let
((idx (js-string-index-of s needle 0)))
(if
@@ -2195,18 +2220,24 @@
((= (len args) 0) -1)
((js-regex? (nth args 0))
(let
((rx (nth args 0)) (src (get (nth args 0) "source")))
((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)))))
(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))
((js-regex? (nth args 0))
(js-regex-stub-exec (nth args 0) s))
(else
(let
((needle (js-to-string (nth args 0))))
@@ -2256,11 +2287,17 @@
(let
((default-start (- (len s) (len needle)))
(from
(if (< (len args) 2) -1 (js-num-to-int (nth args 1)))))
(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))))))))
(if
(< from 0)
default-start
(min from default-start))))))))
((= name "localeCompare")
(fn
(&rest args)
@@ -2269,7 +2306,10 @@
0
(let
((other (js-to-string (nth args 0))))
(cond ((< s other) -1) ((> s other) 1) (else 0))))))
(cond
((< s other) -1)
((> s other) 1)
(else 0))))))
((= name "replaceAll")
(fn
(&rest args)
@@ -2277,7 +2317,8 @@
(< (len args) 2)
s
(let
((needle-arg (nth args 0)) (repl (nth args 1)))
((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
@@ -2466,7 +2507,7 @@
(else js-undefined)))
((= (type-of obj) "string")
(cond
((= key "length") (unicode-len obj))
((= key "length") (len obj))
((= (type-of key) "number")
(if
(and (>= key 0) (< key (len obj)))
@@ -2613,7 +2654,7 @@
(fn
(&rest args)
(cond
((empty? args) (- 0 (/ 1 0)))
((empty? args) -inf)
(else (js-math-max-loop (first args) (rest args))))))
(define
@@ -2632,7 +2673,7 @@
(fn
(&rest args)
(cond
((empty? args) (/ 1 0))
((empty? args) inf)
(else (js-math-min-loop (first args) (rest args))))))
(define
@@ -2738,8 +2779,8 @@
(and
(number? v)
(not (js-number-is-nan v))
(not (= v (/ 1 0)))
(not (= v (/ -1 0))))))
(not (= v inf))
(not (= v -inf)))))
(define
js-number-is-nan