js-on-sx: Map and Set constructors with prototype methods

lib/js/runtime.sx

@@ -5089,21 +5089,364 @@
         (str "/" (get rx "source") "/" (get rx "flags")))
       (else js-undefined))))
 
+(define
+  js-list-find-index
+  (fn
+    (lst v i n)
+    (cond
+      ((>= i n) -1)
+      ((= (nth lst i) v) i)
+      (else (js-list-find-index lst v (+ i 1) n)))))
+
+(define
+  js-list-remove-at!
+  (fn
+    (lst i)
+    (let
+      ((n (len lst)) (kept (list)))
+      (begin
+        (js-list-remove-at-loop lst i n 0 kept)
+        kept))))
+
+(define
+  js-list-remove-at-loop
+  (fn
+    (src skip n j out)
+    (cond
+      ((>= j n) nil)
+      ((= j skip) (js-list-remove-at-loop src skip n (+ j 1) out))
+      (else
+        (begin
+          (append! out (nth src j))
+          (js-list-remove-at-loop src skip n (+ j 1) out))))))
+
+(define
+  js-map-ctor-fn
+  (fn
+    (&rest args)
+    (let
+      ((this (js-this)))
+      (cond
+        ((not (= (type-of this) "dict"))
+          (raise (js-new-call TypeError (js-args "Map must be constructed with new"))))
+        (else
+          (begin
+            (dict-set! this "__map_keys__" (list))
+            (dict-set! this "__map_vals__" (list))
+            (dict-set! this "size" 0)
+            (if
+              (and
+                (>= (len args) 1)
+                (not (js-undefined? (nth args 0)))
+                (not (= (nth args 0) nil)))
+              (js-map-init this (nth args 0))
+              nil)
+            this))))))
+
+(define
+  js-map-init
+  (fn
+    (m iter)
+    (let
+      ((entries (js-iterable-to-list iter)))
+      (for-each
+        (fn
+          (entry)
+          (cond
+            ((list? entry)
+              (js-map-do-set m (nth entry 0) (nth entry 1)))
+            (else nil)))
+        entries))))
+
+(define
+  js-map-do-set
+  (fn
+    (m k v)
+    (let
+      ((ks (get m "__map_keys__")) (vs (get m "__map_vals__")))
+      (let
+        ((idx (js-list-find-index ks k 0 (len ks))))
+        (cond
+          ((>= idx 0) (begin (set-nth! vs idx v) m))
+          (else
+            (begin
+              (append! ks k)
+              (append! vs v)
+              (dict-set! m "size" (len ks))
+              m)))))))
+
+(define
+  js-map-do-get
+  (fn
+    (m k)
+    (let
+      ((ks (get m "__map_keys__")) (vs (get m "__map_vals__")))
+      (let
+        ((idx (js-list-find-index ks k 0 (len ks))))
+        (cond ((>= idx 0) (nth vs idx)) (else js-undefined))))))
+
+(define
+  js-map-do-has
+  (fn
+    (m k)
+    (let
+      ((ks (get m "__map_keys__")))
+      (>= (js-list-find-index ks k 0 (len ks)) 0))))
+
+(define
+  js-map-do-delete
+  (fn
+    (m k)
+    (let
+      ((ks (get m "__map_keys__")) (vs (get m "__map_vals__")))
+      (let
+        ((idx (js-list-find-index ks k 0 (len ks))))
+        (cond
+          ((< idx 0) false)
+          (else
+            (let
+              ((new-ks (js-list-remove-at! ks idx))
+                (new-vs (js-list-remove-at! vs idx)))
+              (begin
+                (dict-set! m "__map_keys__" new-ks)
+                (dict-set! m "__map_vals__" new-vs)
+                (dict-set! m "size" (len new-ks))
+                true))))))))
+
+(define
+  js-map-do-clear
+  (fn
+    (m)
+    (begin
+      (dict-set! m "__map_keys__" (list))
+      (dict-set! m "__map_vals__" (list))
+      (dict-set! m "size" 0)
+      js-undefined)))
+
+(define
+  js-map-do-foreach
+  (fn
+    (m cb)
+    (let
+      ((ks (get m "__map_keys__")) (vs (get m "__map_vals__")))
+      (begin
+        (js-map-foreach-loop ks vs cb 0 (len ks))
+        js-undefined))))
+
+(define
+  js-map-foreach-loop
+  (fn
+    (ks vs cb i n)
+    (cond
+      ((>= i n) nil)
+      (else
+        (begin
+          (js-call-with-this js-undefined cb (list (nth vs i) (nth ks i)))
+          (js-map-foreach-loop ks vs cb (+ i 1) n))))))
+
+(define
+  Map
+  {:length 0
+    :name "Map"
+    :__callable__ js-map-ctor-fn
+    :prototype
+      {:get (fn (k) (js-map-do-get (js-this) k))
+        :set (fn (k v) (js-map-do-set (js-this) k v))
+        :has (fn (k) (js-map-do-has (js-this) k))
+        :delete (fn (k) (js-map-do-delete (js-this) k))
+        :clear (fn () (js-map-do-clear (js-this)))
+        :forEach (fn (cb) (js-map-do-foreach (js-this) cb))
+        :keys (fn () (let ((ks (get (js-this) "__map_keys__"))) (js-list-copy ks)))
+        :values (fn () (let ((vs (get (js-this) "__map_vals__"))) (js-list-copy vs)))
+        :entries
+          (fn ()
+            (let
+              ((ks (get (js-this) "__map_keys__"))
+                (vs (get (js-this) "__map_vals__"))
+                (out (list)))
+              (begin
+                (js-map-entries-loop ks vs 0 (len ks) out)
+                out)))}})
+
+(dict-set! (get Map "prototype") "constructor" Map)
+
+(define
+  js-list-copy
+  (fn
+    (src)
+    (let
+      ((out (list)))
+      (begin (for-each (fn (x) (append! out x)) src) out))))
+
+(define
+  js-map-entries-loop
+  (fn
+    (ks vs i n out)
+    (cond
+      ((>= i n) nil)
+      (else
+        (begin
+          (append! out (list (nth ks i) (nth vs i)))
+          (js-map-entries-loop ks vs (+ i 1) n out))))))
+
+(define
+  js-set-ctor-fn
+  (fn
+    (&rest args)
+    (let
+      ((this (js-this)))
+      (cond
+        ((not (= (type-of this) "dict"))
+          (raise (js-new-call TypeError (js-args "Set must be constructed with new"))))
+        (else
+          (begin
+            (dict-set! this "__set_items__" (list))
+            (dict-set! this "size" 0)
+            (if
+              (and
+                (>= (len args) 1)
+                (not (js-undefined? (nth args 0)))
+                (not (= (nth args 0) nil)))
+              (js-set-init this (nth args 0))
+              nil)
+            this))))))
+
+(define
+  js-set-init
+  (fn
+    (s iter)
+    (let
+      ((items (js-iterable-to-list iter)))
+      (for-each (fn (x) (js-set-do-add s x)) items))))
+
+(define
+  js-set-do-add
+  (fn
+    (s v)
+    (let
+      ((items (get s "__set_items__")))
+      (let
+        ((idx (js-list-find-index items v 0 (len items))))
+        (cond
+          ((>= idx 0) s)
+          (else
+            (begin
+              (append! items v)
+              (dict-set! s "size" (len items))
+              s)))))))
+
+(define
+  js-set-do-has
+  (fn
+    (s v)
+    (let
+      ((items (get s "__set_items__")))
+      (>= (js-list-find-index items v 0 (len items)) 0))))
+
+(define
+  js-set-do-delete
+  (fn
+    (s v)
+    (let
+      ((items (get s "__set_items__")))
+      (let
+        ((idx (js-list-find-index items v 0 (len items))))
+        (cond
+          ((< idx 0) false)
+          (else
+            (let
+              ((new-items (js-list-remove-at! items idx)))
+              (begin
+                (dict-set! s "__set_items__" new-items)
+                (dict-set! s "size" (len new-items))
+                true))))))))
+
+(define
+  js-set-do-clear
+  (fn
+    (s)
+    (begin
+      (dict-set! s "__set_items__" (list))
+      (dict-set! s "size" 0)
+      js-undefined)))
+
+(define
+  js-set-do-foreach
+  (fn
+    (s cb)
+    (let
+      ((items (get s "__set_items__")))
+      (begin
+        (js-set-foreach-loop items cb 0 (len items))
+        js-undefined))))
+
+(define
+  js-set-foreach-loop
+  (fn
+    (items cb i n)
+    (cond
+      ((>= i n) nil)
+      (else
+        (begin
+          (js-call-with-this
+            js-undefined
+            cb
+            (list (nth items i) (nth items i)))
+          (js-set-foreach-loop items cb (+ i 1) n))))))
+
+(define
+  Set
+  {:length 0
+    :name "Set"
+    :__callable__ js-set-ctor-fn
+    :prototype
+      {:add (fn (v) (js-set-do-add (js-this) v))
+        :has (fn (v) (js-set-do-has (js-this) v))
+        :delete (fn (v) (js-set-do-delete (js-this) v))
+        :clear (fn () (js-set-do-clear (js-this)))
+        :forEach (fn (cb) (js-set-do-foreach (js-this) cb))
+        :keys (fn () (js-list-copy (get (js-this) "__set_items__")))
+        :values (fn () (js-list-copy (get (js-this) "__set_items__")))
+        :entries
+          (fn ()
+            (let
+              ((items (get (js-this) "__set_items__")) (out (list)))
+              (begin
+                (js-set-entries-loop items 0 (len items) out)
+                out)))}})
+
+(dict-set! (get Set "prototype") "constructor" Set)
+
+(define
+  js-set-entries-loop
+  (fn
+    (items i n out)
+    (cond
+      ((>= i n) nil)
+      (else
+        (begin
+          (append! out (list (nth items i) (nth items i)))
+          (js-set-entries-loop items (+ i 1) n out))))))
+
 (begin
   (dict-set! Object "__proto__" (get js-function-global "prototype"))
   (dict-set! Array "__proto__" (get js-function-global "prototype"))
   (dict-set! Number "__proto__" (get js-function-global "prototype"))
   (dict-set! String "__proto__" (get js-function-global "prototype"))
   (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! (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 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})
+(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})
 
 (set! js-global-this js-global)