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

js-on-sx: real Date prototype setters (setFullYear/Month/Date/Hours/Minutes/Seconds/Milliseconds)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
Details

Browse Source
This commit is contained in:
giles
2026-05-10 16:29:22 +00:00
parent a8596bd090
commit 01d0e97706
2 changed files with 131 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

130
lib/js/runtime.sx
View File

@@ -1067,6 +1067,115 @@
(js-new-call URIError (js-args (js-string-slice e 10 (len e)))))
(else e))))
(define
js-date-setter-arg
(fn
(args fallback i)
(cond
((>= (len args) (+ i 1)) (js-to-number (nth args i)))
(else fallback))))
(define
js-date-setter
(fn
(d field args)
(cond
((or (not (dict? d)) (not (contains? (keys d) "__js_is_date__")))
(raise (js-new-call TypeError (js-args "this is not a Date object"))))
(else
(let
((ms-raw (get d "__date_value__")))
(let
((ms-orig
(cond
((or (= ms-raw nil) (js-undefined? ms-raw)) (js-nan-value))
((= (type-of ms-raw) "rational") (exact->inexact ms-raw))
(else ms-raw))))
(let
((parts (js-date-decompose ms-orig)))
(let
((y
(cond
((= field "fullYear") (js-date-setter-arg args (js-nan-value) 0))
(else (nth parts 0))))
(mo
(cond
((= field "fullYear") (js-date-setter-arg args (nth parts 1) 1))
((= field "month") (js-date-setter-arg args (js-nan-value) 0))
(else (nth parts 1))))
(da
(cond
((= field "fullYear") (js-date-setter-arg args (nth parts 2) 2))
((= field "month") (js-date-setter-arg args (nth parts 2) 1))
((= field "date") (js-date-setter-arg args (js-nan-value) 0))
(else (nth parts 2))))
(hh
(cond
((= field "hours") (js-date-setter-arg args (js-nan-value) 0))
(else (nth parts 3))))
(mm
(cond
((= field "hours") (js-date-setter-arg args (nth parts 4) 1))
((= field "minutes") (js-date-setter-arg args (js-nan-value) 0))
(else (nth parts 4))))
(ss
(cond
((= field "hours") (js-date-setter-arg args (nth parts 5) 2))
((= field "minutes") (js-date-setter-arg args (nth parts 5) 1))
((= field "seconds") (js-date-setter-arg args (js-nan-value) 0))
(else (nth parts 5))))
(msv
(cond
((= field "hours") (js-date-setter-arg args (nth parts 6) 3))
((= field "minutes") (js-date-setter-arg args (nth parts 6) 2))
((= field "seconds") (js-date-setter-arg args (nth parts 6) 1))
((= field "ms") (js-date-setter-arg args (js-nan-value) 0))
(else (nth parts 6)))))
(cond
((or (js-number-is-nan y) (js-number-is-nan mo) (js-number-is-nan da)
(js-number-is-nan hh) (js-number-is-nan mm) (js-number-is-nan ss) (js-number-is-nan msv))
(begin (dict-set! d "__date_value__" (js-nan-value)) (js-nan-value)))
(else
(let
((days (js-date-civil-to-days (js-num-to-int y) (+ (js-num-to-int mo) 1) (js-num-to-int da)))
(tod
(+
(* (js-num-to-int hh) 3600000)
(* (js-num-to-int mm) 60000)
(* (js-num-to-int ss) 1000)
(js-num-to-int msv))))
(let
((new-ms (+ (* days 86400000) tod)))
(cond
((or (> new-ms 8640000000000000) (< new-ms -8640000000000000))
(begin (dict-set! d "__date_value__" (js-nan-value)) (js-nan-value)))
(else
(begin (dict-set! d "__date_value__" new-ms) new-ms)))))))))))))))
(define
js-date-decompose
(fn
(ms)
(cond
((or (= ms nil) (js-undefined? ms) (not (number? ms)) (js-number-is-nan ms))
(list 1970 0 1 0 0 0 0))
(else
(let
((days (floor (/ ms 86400000)))
(tod
(let ((m (modulo (js-num-to-int ms) 86400000)))
(if (< m 0) (+ m 86400000) m))))
(let
((ymd (js-date-days-to-ymd days)))
(list
(nth ymd 0)
(- (nth ymd 1) 1)
(nth ymd 2)
(js-math-trunc (/ tod 3600000))
(js-math-trunc (/ (modulo tod 3600000) 60000))
(js-math-trunc (/ (modulo tod 60000) 1000))
(modulo tod 1000))))))))
(define
js-date-time-value
(fn
@@ -1288,7 +1397,26 @@
:setTime
(fn (v)
(let ((t (js-this)))
(begin (dict-set! t "__date_value__" v) v)))
(let
((n (js-to-number v)))
(cond
((or (js-number-is-nan n) (> n 8640000000000000) (< n -8640000000000000))
(begin (dict-set! t "__date_value__" (js-nan-value)) (js-nan-value)))
(else (begin (dict-set! t "__date_value__" n) n))))))
:setFullYear (fn (&rest args) (js-date-setter (js-this) "fullYear" args))
:setUTCFullYear (fn (&rest args) (js-date-setter (js-this) "fullYear" args))
:setMonth (fn (&rest args) (js-date-setter (js-this) "month" args))
:setUTCMonth (fn (&rest args) (js-date-setter (js-this) "month" args))
:setDate (fn (&rest args) (js-date-setter (js-this) "date" args))
:setUTCDate (fn (&rest args) (js-date-setter (js-this) "date" args))
:setHours (fn (&rest args) (js-date-setter (js-this) "hours" args))
:setUTCHours (fn (&rest args) (js-date-setter (js-this) "hours" args))
:setMinutes (fn (&rest args) (js-date-setter (js-this) "minutes" args))
:setUTCMinutes (fn (&rest args) (js-date-setter (js-this) "minutes" args))
:setSeconds (fn (&rest args) (js-date-setter (js-this) "seconds" args))
:setUTCSeconds (fn (&rest args) (js-date-setter (js-this) "seconds" args))
:setMilliseconds (fn (&rest args) (js-date-setter (js-this) "ms" args))
:setUTCMilliseconds (fn (&rest args) (js-date-setter (js-this) "ms" args))
:toISOString (fn () (js-date-iso (js-this)))
:toJSON (fn () (js-date-iso (js-this)))
:toString (fn () (js-date-iso (js-this)))