js-on-sx: Date constructor + prototype stubs

lib/js/runtime.sx

@@ -990,6 +990,157 @@
 (define AggregateError :js-undefined)
 
 (define SuppressedError :js-undefined)
+
+(define
+  js-date-from-one
+  (fn
+    (v)
+    (cond
+      ((number? v) v)
+      ((= (type-of v) "string") (js-date-parse-string v))
+      (else 0))))
+
+(define
+  js-date-parse-string
+  (fn
+    (s)
+    (cond
+      ((>= (len s) 4)
+        (let
+          ((year-part (js-string-slice s 0 4)))
+          (cond
+            ((js-is-numeric-string? year-part)
+              (let
+                ((y (js-num-to-int (js-string-to-number year-part))))
+                (* (- y 1970) 31557600000)))
+            (else 0))))
+      (else 0))))
+
+(define
+  js-date-from-parts
+  (fn
+    (args)
+    (let
+      ((year (js-num-to-int (js-to-number (nth args 0))))
+        (month
+         (if (>= (len args) 2) (js-num-to-int (js-to-number (nth args 1))) 0))
+        (day
+         (if (>= (len args) 3) (js-num-to-int (js-to-number (nth args 2))) 1)))
+      (+
+        (* (- year 1970) 31557600000)
+        (* month 2629800000)
+        (* (- day 1) 86400000)))))
+
+(define
+  js-date-format-now
+  (fn () "[Date stub]"))
+
+(define
+  js-date-pad2
+  (fn (n) (if (< n 10) (str "0" (js-to-string n)) (js-to-string n))))
+
+(define
+  js-date-pad3
+  (fn
+    (n)
+    (cond
+      ((< n 10) (str "00" (js-to-string n)))
+      ((< n 100) (str "0" (js-to-string n)))
+      (else (js-to-string n)))))
+
+(define
+  Date
+  {:length 7
+    :name "Date"
+    :__callable__
+      (fn
+        (&rest args)
+        (let
+          ((this (js-this)))
+          (cond
+            ((not (= (type-of this) "dict")) (js-date-format-now))
+            (else
+              (begin
+                (dict-set!
+                  this
+                  "__date_value__"
+                  (cond
+                    ((= (len args) 0) 0)
+                    ((= (len args) 1) (js-date-from-one (nth args 0)))
+                    (else (js-date-from-parts args))))
+                (dict-set! this "__js_is_date__" true)
+                this)))))
+    :now (fn () 0)
+    :parse (fn (s) (js-date-parse-string (js-to-string s)))
+    :UTC
+      (fn
+        (&rest args)
+        (cond
+          ((= (len args) 0) 0)
+          (else (js-date-from-parts args))))
+    :prototype
+      {:getTime (fn () (let ((t (js-this))) (get t "__date_value__")))
+        :valueOf (fn () (let ((t (js-this))) (get t "__date_value__")))
+        :getFullYear
+          (fn ()
+            (let ((t (js-this)))
+              (+ 1970 (js-math-trunc (/ (get t "__date_value__") 31557600000)))))
+        :getUTCFullYear
+          (fn ()
+            (let ((t (js-this)))
+              (+ 1970 (js-math-trunc (/ (get t "__date_value__") 31557600000)))))
+        :getMonth (fn () 0)
+        :getUTCMonth (fn () 0)
+        :getDate (fn () 1)
+        :getUTCDate (fn () 1)
+        :getDay (fn () 0)
+        :getUTCDay (fn () 0)
+        :getHours (fn () 0)
+        :getUTCHours (fn () 0)
+        :getMinutes (fn () 0)
+        :getUTCMinutes (fn () 0)
+        :getSeconds (fn () 0)
+        :getUTCSeconds (fn () 0)
+        :getMilliseconds (fn () 0)
+        :getUTCMilliseconds (fn () 0)
+        :getTimezoneOffset (fn () 0)
+        :setTime
+          (fn (v)
+            (let ((t (js-this)))
+              (begin (dict-set! t "__date_value__" v) v)))
+        :toISOString (fn () (js-date-iso (js-this)))
+        :toJSON (fn () (js-date-iso (js-this)))
+        :toString (fn () (js-date-iso (js-this)))
+        :toUTCString (fn () (js-date-iso (js-this)))
+        :toDateString (fn () (js-date-iso (js-this)))
+        :toTimeString (fn () "00:00:00 GMT+0000")
+        :toLocaleString (fn () (js-date-iso (js-this)))
+        :toLocaleDateString (fn () (js-date-iso (js-this)))
+        :toLocaleTimeString (fn () "00:00:00")}})
+
+(define
+  js-date-iso
+  (fn
+    (d)
+    (let
+      ((ms (get d "__date_value__")))
+      (let
+        ((year
+           (+ 1970 (js-math-trunc (/ ms 31557600000)))))
+        (str (js-date-year-pad year) "-01-01T00:00:00.000Z")))))
+
+(define
+  js-date-year-pad
+  (fn
+    (y)
+    (cond
+      ((>= y 0)
+        (cond
+          ((< y 10) (str "000" (js-to-string y)))
+          ((< y 100) (str "00" (js-to-string y)))
+          ((< y 1000) (str "0" (js-to-string y)))
+          (else (js-to-string y))))
+      (else (str "-" (js-date-year-pad (- 0 y)))))))
 (define
   js-function?
   (fn
@@ -5474,17 +5625,19 @@
   (dict-set! Boolean "__proto__" (get js-function-global "prototype"))
   (dict-set! Map "__proto__" (get js-function-global "prototype"))
   (dict-set! Set "__proto__" (get js-function-global "prototype"))
+  (dict-set! Date "__proto__" (get js-function-global "prototype"))
   (dict-set! (get Array "prototype") "__proto__" (get Object "prototype"))
   (dict-set! (get Number "prototype") "__proto__" (get Object "prototype"))
   (dict-set! (get String "prototype") "__proto__" (get Object "prototype"))
   (dict-set! (get Boolean "prototype") "__proto__" (get Object "prototype"))
   (dict-set! (get Map "prototype") "__proto__" (get Object "prototype"))
   (dict-set! (get Set "prototype") "__proto__" (get Object "prototype"))
+  (dict-set! (get Date "prototype") "__proto__" (get Object "prototype"))
   (dict-set! (get js-function-global "prototype") "__proto__" (get Object "prototype"))
   (dict-set! (get Number "prototype") "__js_number_value__" 0)
   (dict-set! (get String "prototype") "__js_string_value__" "")
   (dict-set! (get Boolean "prototype") "__js_boolean_value__" false))
 
-(define js-global {:undefined js-undefined :JSON JSON :parseInt parseInt :Object Object :isNaN js-global-is-nan :Infinity inf :NaN 0 :String String :Boolean Boolean :Array Array :Math Math :parseFloat parseFloat :Number Number :console console :isFinite js-global-is-finite :Map Map :Set Set})
+(define js-global {:undefined js-undefined :JSON JSON :parseInt parseInt :Object Object :isNaN js-global-is-nan :Infinity inf :NaN 0 :String String :Boolean Boolean :Array Array :Math Math :parseFloat parseFloat :Number Number :console console :isFinite js-global-is-finite :Map Map :Set Set :Date Date})
 
 (set! js-global-this js-global)