js-on-sx: JSON.stringify replacer (fn+array), space, toJSON

lib/js/runtime.sx

@@ -5240,54 +5240,207 @@
   js-json-stringify
   (fn
     (&rest args)
-    (if
-      (= (len args) 0)
-      js-undefined
-      (js-json-stringify-value (nth args 0)))))
+    (let
+      ((value (if (= (len args) 0) :js-undefined (nth args 0)))
+        (replacer (if (< (len args) 2) :js-undefined (nth args 1)))
+        (space-raw (if (< (len args) 3) :js-undefined (nth args 2))))
+      (let
+        ((rep-fn (if (js-function? replacer) replacer nil))
+          (rep-keys (if (list? replacer) (js-json-prop-list replacer) nil))
+          (gap (js-json-space-gap space-raw)))
+        (let
+          ((wrapper (dict)))
+          (begin
+            (dict-set! wrapper "" value)
+            (js-json-serialize-property "" wrapper rep-fn rep-keys gap "")))))))
 
 (define
-  js-json-stringify-value
+  js-json-prop-list
+  (fn
+    (arr)
+    (let
+      ((out (list)))
+      (begin
+        (for-each
+          (fn
+            (k)
+            (cond
+              ((= (type-of k) "string")
+                (if (js-list-contains? out k) nil (append! out k)))
+              ((number? k)
+                (let ((s (js-number-to-string k)))
+                  (if (js-list-contains? out s) nil (append! out s))))
+              ((dict? k)
+                (cond
+                  ((contains? (keys k) "__js_string_value__")
+                    (let ((s (get k "__js_string_value__")))
+                      (if (js-list-contains? out s) nil (append! out s))))
+                  ((contains? (keys k) "__js_number_value__")
+                    (let ((s (js-number-to-string (get k "__js_number_value__"))))
+                      (if (js-list-contains? out s) nil (append! out s))))
+                  (else nil)))
+              (else nil)))
+          arr)
+        out))))
+
+(define
+  js-list-contains?
+  (fn
+    (lst v)
+    (cond
+      ((empty? lst) false)
+      ((= (first lst) v) true)
+      (else (js-list-contains? (rest lst) v)))))
+
+(define
+  js-json-space-gap
+  (fn
+    (sp)
+    (cond
+      ((js-undefined? sp) "")
+      ((= sp nil) "")
+      ((number? sp)
+        (let
+          ((n (cond ((js-number-is-nan sp) 0) ((< sp 0) 0) ((> sp 10) 10) (else (floor sp)))))
+          (js-string-repeat " " n)))
+      ((and (dict? sp) (contains? (keys sp) "__js_number_value__"))
+        (js-json-space-gap (get sp "__js_number_value__")))
+      ((and (dict? sp) (contains? (keys sp) "__js_string_value__"))
+        (js-json-space-gap (get sp "__js_string_value__")))
+      ((= (type-of sp) "string")
+        (if (> (len sp) 10) (js-string-slice sp 0 10) sp))
+      (else ""))))
+
+(define
+  js-string-repeat
+  (fn
+    (s n)
+    (if (<= n 0) "" (str s (js-string-repeat s (- n 1))))))
+
+(define
+  js-json-unwrap-primitive
   (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)
+      ((not (dict? v)) v)
+      ((contains? (keys v) "__js_number_value__")
+        (get v "__js_number_value__"))
+      ((contains? (keys v) "__js_string_value__")
+        (get v "__js_string_value__"))
+      ((contains? (keys v) "__js_boolean_value__")
+        (get v "__js_boolean_value__"))
+      (else v))))
+
+(define
+  js-json-serialize-property
+  (fn
+    (key holder rep-fn rep-keys gap indent)
+    (let
+      ((value0 (if (dict? holder) (get holder key) (if (list? holder) (nth holder (js-num-to-int (js-to-number key))) :js-undefined))))
+      (let
+        ((value1
+           (cond
+             ((and
+                (or (dict? value0) (list? value0))
+                (let ((tj (js-get-prop value0 "toJSON")))
+                  (and (not (js-undefined? tj)) (js-function? tj))))
+               (js-call-with-this value0 (js-get-prop value0 "toJSON") (list key)))
+             (else value0))))
         (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)
+          ((value
+             (if rep-fn
+               (js-call-with-this holder rep-fn (list key value1))
+               value1)))
+          (let
+            ((vu (js-json-unwrap-primitive value)))
+            (cond
+              ((= vu nil) "null")
+              ((js-undefined? vu) :js-undefined)
+              ((= (type-of vu) "boolean") (if vu "true" "false"))
+              ((or (number? vu) (= (type-of vu) "rational"))
+                (let ((n (if (= (type-of vu) "rational") (exact->inexact vu) vu)))
+                  (cond
+                    ((js-number-is-nan n) "null")
+                    ((= n (js-infinity-value)) "null")
+                    ((= n (- 0 (js-infinity-value))) "null")
+                    (else (js-number-to-string n)))))
+              ((= (type-of vu) "string") (js-json-escape-string vu))
+              ((js-function? vu) :js-undefined)
+              ((list? vu)
+                (js-json-serialize-array vu rep-fn rep-keys gap indent))
+              ((dict? vu)
+                (js-json-serialize-object vu rep-fn rep-keys gap indent))
+              (else :js-undefined))))))))
+
+(define
+  js-json-serialize-array
+  (fn
+    (arr rep-fn rep-keys gap indent)
+    (let
+      ((step-back indent) (new-indent (str indent gap)) (parts (list)))
+      (begin
+        (js-json-array-loop arr rep-fn rep-keys gap new-indent 0 parts)
+        (cond
+          ((empty? parts) "[]")
+          ((= gap "")
+            (str "[" (join "," parts) "]"))
+          (else
+            (str
+              "[\n"
+              new-indent
+              (join (str ",\n" new-indent) parts)
+              "\n"
+              step-back
+              "]")))))))
+
+(define
+  js-json-array-loop
+  (fn
+    (arr rep-fn rep-keys gap new-indent i parts)
+    (cond
+      ((>= i (len arr)) nil)
+      (else
         (let
-          ((parts (list)))
-          (for-each
-            (fn
-              (k)
-              (if
-                (js-key-internal? k)
-                nil
+          ((s (js-json-serialize-property (js-number-to-string i) arr rep-fn rep-keys gap new-indent)))
+          (begin
+            (if (js-undefined? s) (append! parts "null") (append! parts s))
+            (js-json-array-loop arr rep-fn rep-keys gap new-indent (+ i 1) parts)))))))
+
+(define
+  js-json-serialize-object
+  (fn
+    (obj rep-fn rep-keys gap indent)
+    (let
+      ((step-back indent) (new-indent (str indent gap)) (parts (list))
+        (sep (if (= gap "") ":" ": "))
+        (key-list (if rep-keys rep-keys (js-object-keys obj))))
+      (begin
+        (for-each
+          (fn
+            (k)
+            (cond
+              ((js-key-internal? k) nil)
+              (else
                 (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)))))))
-            (js-object-keys v))
-          (str "{" (join "," parts) "}")))
-      (else "null"))))
+                  ((s (js-json-serialize-property k obj rep-fn rep-keys gap new-indent)))
+                  (if
+                    (js-undefined? s)
+                    nil
+                    (append! parts (str (js-json-escape-string k) sep s)))))))
+          key-list)
+        (cond
+          ((empty? parts) "{}")
+          ((= gap "")
+            (str "{" (join "," parts) "}"))
+          (else
+            (str
+              "{\n"
+              new-indent
+              (join (str ",\n" new-indent) parts)
+              "\n"
+              step-back
+              "}")))))))
+
 
 (define
   js-json-escape-string