Map.carp

(definterface hash (Fn [(Ref a)] Int))

(defmodule String
  (defn hash [k]
    (let-do [h 5381]
      (for [x 0 (length k)]
        (set! h (+ (* h 33) (Char.to-int (char-at k x)))))
      (Int.abs h)))
   (implements hash String.hash)
)

(defmodule Int
  (defn hash [k] (the Int @k))
   (implements hash Int.hash)
)

(defmodule Long
  (defn hash [k] (to-int (the Long @k)))
   (implements hash Long.hash)
)

(defmodule Bool
  (defn hash [k] (if (the Bool @k) 1 0))
  (implements hash Bool.hash)
)

(defmodule Char
  (defn hash [k] (to-int (the Char @k)))
  (implements hash Char.hash)
)

(defmodule Byte
  (defn hash [k] (to-int (the Byte @k)))
  (implements hash Byte.hash)
)

(defmodule Float
  (defn hash [k] (Float.to-bytes @k))
  (implements hash Float.hash)
)

(defmodule Double
  (defn hash [k] (Long.to-int (Double.to-bytes @k)))
  (implements hash Double.hash)
)

(defmodule Int8
  (defn hash [k] (Long.to-int (Int8.to-long @k)))
  (implements hash Int8.hash)
)

(defmodule Int16
  (defn hash [k] (Long.to-int (Int16.to-long @k)))
  (implements hash Int16.hash)
)

(defmodule Int32
  (defn hash [k] (Long.to-int (Int32.to-long @k)))
  (implements hash Int32.hash)
)

(defmodule Int64
  (defn hash [k] (Long.to-int (Int64.to-long @k)))
  (implements hash Int64.hash)
)

(defmodule Uint8
  (defn hash [k] (Long.to-int (Uint8.to-long @k)))
  (implements hash Uint8.hash)
)

(defmodule Uint16
  (defn hash [k] (Long.to-int (Uint16.to-long @k)))
  (implements hash Uint16.hash)
)

(defmodule Uint32
  (defn hash [k] (Long.to-int (Uint32.to-long @k)))
  (implements hash Uint32.hash)
)

(defmodule Uint64
  (defn hash [k] (Long.to-int (Uint64.to-long @k)))
  (implements hash Uint64.hash)
)

(defmodule Pair
  (defn hash [pair]
    (let-do [code 17]
      (set! code (+ (* 31 code) (hash (Pair.a pair))))
      (set! code (+ (* 31 code) (hash (Pair.b pair))))
      code))
  (implements hash Pair.hash)
)

(deftype (Bucket a b) [entries (Array (Pair a b))])

(defmodule Bucket
  (defn empty []
    (Bucket.init []))

  (defn find [b k]
    (let-do [ret -1
             l (Array.length (Bucket.entries b))
             es (entries b)]
      (for [i 0 l]
        (when (= (Pair.a (Array.unsafe-nth es i)) k)
          (do
            (set! ret i)
            (break))))
      ret))

  (defn get-idx [b i]
    @(Pair.b (Array.unsafe-nth (entries b) i)))

  (defn set-idx [b i val]
    (do (Array.aupdate! (entries &b) i &(fn [p] (Pair.set-b p @val)))
        b))

  (defn set-idx! [b i val]
    (Array.aupdate! (entries b) i &(fn [p] (Pair.set-b p @val))))

  (defn push-back [b k v]
    (do (Array.push-back! (entries &b) (Pair.init-from-refs k v))
        b))

  (defn push-back! [b k v]
    (Array.push-back! (entries b) (Pair.init-from-refs k v)))

  (defn get [b k default-value]
    (let [i (find b k)]
      (if (<= 0 i)
        (get-idx b i)
        @default-value)))

  (defn get-maybe [b k]
    (let [i (find b k)]
      (if (<= 0 i)
        ;; The call to copy ('@') here is annoying - had to add it since sumtypes can't contain refs for now:
        (Maybe.Just @(Pair.b (Array.unsafe-nth (entries b) i)))
        (Maybe.Nothing))))

  (defn put [b k v]
    (let [i (find &b k)]
      (if (<= 0 i)
        (set-idx b i v)
        (push-back b k v))))

  (defn put! [b k v]
    (let [i (find b k)]
      (if (<= 0 i)
        (set-idx! b i v)
        (push-back! b k v))))

  (defn contains? [b k]
    (<= 0 (find b k)))

  (defn remove [entries k]
    (let-do [nentries (the (Array (Pair a b)) [])]
      (for [i 0 (Array.length entries)]
        (let [e (Array.unsafe-nth entries i)]
          (unless (= (Pair.a e) k)
             (set! nentries (Array.push-back nentries @e)))))
      nentries))

  (defn shrink [b k]
    (if (contains? &b k)
      (let [nentries (remove (entries &b) k)]
        (set-entries b nentries))
      b))
)

(deftype (Map a b) [len Int n-buckets Int buckets (Array (Bucket a b))])

(doc Map
  "is a hashmap datatype, i.e. a key-value structure. It allows you to put in "
  "pairs of keys and values and look them up by key."
  ""
  "Implementation notes: it is a dense double-array-backed structure that"
  "grows and shrinks based on load.")
(defmodule Map
  (hidden dflt-len)
  (def dflt-len 16)

  (doc min-load "The load a map needs to reach in order to shrink.")
  (def min-load 20)
  (doc max-load "The load a map needs to reach in order to grow.")
  (def max-load 80)

  (doc create "Create an empty map.")
  (defn create []
    (init 0 dflt-len (Array.repeat dflt-len &Bucket.empty)))

  (private put-!)
  (hidden put-!)
  (defn put-! [m k v]
    (let-do [idx (Int.positive-mod (hash k) @(n-buckets m))
             b (buckets m)
             n (Array.unsafe-nth b idx)]
      (set-len! m (Int.inc @(len m)))
      (Bucket.put! n k v)))

  (doc resize "Resize a map `m` to size `s`.")
  (defn resize [m s]
    (let-do [n (init 0 s (Array.repeat s &Bucket.empty))]
      (for [i 0 @(n-buckets &m)]
        (let [bucket (Array.unsafe-nth (buckets &m) i)
              len (Array.length (Bucket.entries bucket))
              entries (Bucket.entries bucket)]
          (for [j 0 len]
            (let [e (Array.unsafe-nth entries j)]
              (put-! &n (Pair.a e) (Pair.b e))))))
        n))

  (doc grow "Grow a map `m`. Should usually be handled automatically.")
  (defn grow [m] (resize m (* @(n-buckets &m) 2)))
  (doc shrink "Shrink a map `m`. Should usually be handled automatically.")
  (defn shrink [m]
    (let [new-size (/ @(n-buckets &m) 2)]
      (if (< new-size dflt-len)
        m
        (resize m new-size))))

  (doc contains? "Check whether the map m contains the key k.")
  (defn contains? [m k]
    (let [idx (Int.positive-mod (hash k) @(n-buckets m))]
      (Bucket.contains? (Array.unsafe-nth (buckets m) idx) k)))

  (doc put "Put a value v into map m, using the key k.")
  (defn put [m k v]
    (if (> (/ (* @(len &m) 100) @(n-buckets &m)) max-load)
      (put (grow m) k v)
      (let [idx (Int.positive-mod (hash k) @(n-buckets &m))
            found (Bucket.find (Array.unsafe-nth (buckets &m) idx) k)]
        (update-len
          (update-buckets m &(fn [b]
                               (let [n (Array.unsafe-nth &b idx)]
                                 (if (<= 0 found)
                                   (Array.aset b idx (Bucket.set-idx @n found v))
                                   (Array.aset b idx (Bucket.push-back @n k v))))))
          &(if (<= 0 found) id Int.inc)))))

  (doc put! "Put a value v into map m, using the key k, in place.")
  (defn put! [m k v]
    (put-! m k v))

  (doc get-with-default "Get the value for the key k from map m. If it isn’t found, the default is returned.")
  (defn get-with-default [m k default-value]
    (let [idx (Int.positive-mod (hash k) @(n-buckets m))]
      (Bucket.get (Array.unsafe-nth (buckets m) idx) k default-value)))

  (doc get "Get the value for the key k from map m. If it isn’t found, a zero element for the value type is returned.")
  (defn get [m k]
    (get-with-default m k &(zero)))

  (doc get-maybe "Get the value for the key k from map m. It returns a Maybe type, meaning that if nothing is found, Nothing is returned.")
  (defn get-maybe [m k]
    (let [idx (Int.positive-mod (hash k) @(n-buckets m))]
      (Bucket.get-maybe (Array.unsafe-nth (buckets m) idx) k)))

  (doc update "Update value at key k in map with function f, if it exists.")
  (defn update [m k f]
    (let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
      (update-buckets m &(fn [b]
        (let [n (Array.unsafe-nth &b idx)
              i (Bucket.find n k)]
          (if (<= 0 i)
            ;; currently can't write a Bucket.update that takes f due to bug #347
            (Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
            b))))))

  (doc update-with-default "Update value at key k in map with function f. If k doesn't exist in map, set k to (f v).")
  (defn update-with-default [m k f v]
    (let [idx (Int.positive-mod (hash k) @(n-buckets &m))
          in? (Map.contains? &m k)]
      (update-len
        (update-buckets m &(fn [b]
          (let [n (Array.unsafe-nth &b idx)
                i (Bucket.find n k)]
            (if (<= 0 i)
              (Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
              (Array.aset b idx (Bucket.push-back @n k &(~f @&v)))))))
           &(if in? id Int.inc))))

  (doc update-with-default! "Update value at key k in map with function f, in-place. If k doesn't exist in map, set k to (f v).")
  (defn update-with-default! [m k f v]
    (let-do [idx (Int.positive-mod (hash k) @(n-buckets m))
          b (buckets m)
          n (Array.unsafe-nth b idx)
          i (Bucket.find n k)]
      (if (<= 0 i)
          (Array.aset! b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
          (do
            (set-len! m (Int.inc @(len m)))
            (Array.aset! b idx (Bucket.push-back @n k &(~f @&v)))))))

  (doc length "Get the length of the map m.")
  (defn length [m]
    @(len m))

  (doc empty? "Check whether the map m is empty.")
  (defn empty? [m]
    (= (Map.length m) 0))
  (implements empty? Map.empty?)

  (doc remove "Remove the value under the key k from the map m.")
  (defn remove [m k]
    (if (and (< (/ (* @(len &m) 100) @(n-buckets &m)) min-load)
             (>= @(n-buckets &m) (* 2 dflt-len)))
      (remove (shrink m) k)
      (let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
        (update-len
          (update-buckets m &(fn [b]
                               (let [n (Array.unsafe-nth &b idx)]
                                 (Array.aset b idx (Bucket.shrink @n k)))))
          &Int.dec))))

  (doc all? "Do all key-value pairs pass the given predicate (of two arguments)?")
  (defn all? [pred m]
    (let-do [ret true]
      (for [i 0 @(n-buckets m)]
        (let [bucket (Array.unsafe-nth (buckets m) i)
              len (Array.length (Bucket.entries bucket))
              entries (Bucket.entries bucket)]
          (for [j 0 len]
            (let [e (Array.unsafe-nth entries j)]
              (unless (~pred (Pair.a e) (Pair.b e))
                (set! ret false))))))
      ret))

  (defn = [m1 m2]
    (and (= (length m1) (length m2))
         ;; we could use contains? and get-with-default here to avoid requiring a (zero) for the value type
         (all? &(fn [k v] (= v &(get m2 k))) m1)))
  (implements = Map.=)

  (doc for-each "Execute the binary function f for all keys and values in the map m.")
  (defn for-each [m f]
    (for [i 0 @(n-buckets m)]
      (let [bucket (Array.unsafe-nth (buckets m) i)
            len (Array.length (Bucket.entries bucket))
            entries (Bucket.entries bucket)]
        (for [j 0 len]
          (let [e (Array.unsafe-nth entries j)]
            (~f (Pair.a e) (Pair.b e)))))))

  (doc endo-map "Transform values of the given map in place. f gets two arguments, key and value, and should return new value")
  (defn endo-map [f m]
    (do
      (for [i 0 @(n-buckets &m)]
        (let [bucket (Array.unsafe-nth (buckets &m) i)
              len (Array.length (Bucket.entries bucket))
              entries (Bucket.entries bucket)]
          (for [j 0 len]
            (let [e (Array.unsafe-nth entries j)]
              (Array.aset! entries j (Pair.init @(Pair.a e)
                                                (~f (Pair.a e) (Pair.b e))))))))
      m))

  (doc kv-reduce "Reduce a map with a function of three arguments: state, key and value. Reduction order is not guaranteed.")
  (defn kv-reduce [f init m]
    (do
      (for [i 0 @(n-buckets m)]
        (let [bucket (Array.unsafe-nth (buckets m) i)
              len (Array.length (Bucket.entries bucket))
              entries (Bucket.entries bucket)]
          (for [j 0 len]
            (let [e (Array.unsafe-nth entries j)]
              (set! init (~f init (Pair.a e) (Pair.b e)))))))
      init))

  (doc merge "Merge two maps `m1` and `m2`. On collision the value from `m2` is preferred.")
  (defn merge [m1 m2]
    (kv-reduce &(fn [m k v] (put m k v)) m1 m2))

  (doc vals "Return an array of the values of the map. Order corresponds to order of (keys m)")
  (defn vals [m]
    (kv-reduce &(fn [arr _ v] (Array.push-back arr @v))
               []
               m))

  (doc keys "Return an array of the keys of the map. Order corresponds to order of (vals m)")
  (defn keys [m]
    (kv-reduce &(fn [arr k _] (Array.push-back arr @k))
               []
               m))

  (doc from-array "Create a map from the array a containing key-value pairs.")
  (defn from-array [a]
    (let-do [m (create)]
      (for [i 0 (Array.length &a)]
        (let [e (Array.unsafe-nth &a i)
              k (Pair.a e)
              v (Pair.b e)]
          (put! &m k v)))
      m))

  (doc to-array "Convert Map to Array of Pairs")
  (defn to-array [m]
    (kv-reduce &(fn [arr k v] (Array.push-back arr (Pair.init-from-refs k v)))
               []
               m))

  (defn str [m]
    (let [res (kv-reduce &(fn [s k v]
                           (String.join "" &[s @" " (prn @k) @" " (prn @v)]))
                         @"{"
                         m)]
      (String.append &res " }")))

  (doc reverse "reverses they keys and values in a given map `m`.")
  (defn reverse [m]
    (from-array (Array.copy-map &Pair.reverse &(to-array m))))
)

(deftype (SetBucket a) [entries (Array a)])

(defmodule SetBucket
  (defn empty []
    (SetBucket.init []))

  (defn grow [b e]
    (set-entries @b (Array.push-back @(entries b) e)))

  (defn contains? [b k]
    (let-do [e false
             es (entries b)
             l (Array.length es)]
      (for [i 0 l]
        (when (= (Array.unsafe-nth es i) k)
          (do
            (set! e true)
            (break))))
       e))

  (defn remove [entries k]
    (let-do [nentries []]
      (for [i 0 (Array.length entries)]
        (let [e (Array.unsafe-nth entries i)]
          (unless (= e k)
             (set! nentries (Array.push-back nentries @e)))))
      nentries))

  (defn push-back! [b k]
    (Array.push-back! (entries b) k))

  (defn shrink [b k]
    (if (contains? b k)
      (set-entries @b (remove (entries b) k))
      @b))
)

(deftype (Set a) [len Int n-buckets Int buckets (Array (SetBucket a))])

(doc Set
  "is a hashset datatype, i.e. a unique list structure. It allows you to put "
  "in values and guarantees uniqueness."
  ""
  "Implementation notes: it is a dense double-array-backed structure that"
  "grows and shrinks based on load, similar to `Map`.")
(defmodule Set
  (hidden dflt-len)
  (def dflt-len 16)

  (doc min-load "The load a set needs to reach in order to shrink.")
  (def min-load 20)
  (doc max-load "The load a set needs to reach in order to grow.")
  (def max-load 80)

  (doc create "Create an empty set.")
  (defn create []
    (init 0 dflt-len (Array.repeat dflt-len &SetBucket.empty)))

  (private put-!)
  (hidden put-!)
  (defn put-! [s v]
    (let-do [idx (Int.positive-mod (hash v) @(n-buckets s))
             b (buckets s)
             n (Array.unsafe-nth b idx)]
      (set-len! s (Int.inc @(len s)))
      (SetBucket.push-back! n @v)))

  (doc resize "Resize a set `s` to size `size`.")
  (defn resize [s size]
    (let-do [n (init 0 size (Array.repeat size &SetBucket.empty))]
      (for [i 0 @(n-buckets &s)]
        (let [bucket (Array.unsafe-nth (buckets &s) i)
              len (Array.length (SetBucket.entries bucket))
              entries (SetBucket.entries bucket)]
          (for [j 0 len]
            (let [e (Array.unsafe-nth entries j)]
              (put-! &n e)))))
        n))

  (doc grow "Grow a set `s`. Should usually be handled automatically.")
  (defn grow [s] (resize s (* @(n-buckets &s) 2)))
  (doc shrink "Shrink a set `s`. Should usually be handled automatically.")
  (defn shrink [s]
    (let [new-size (/ @(n-buckets &s) 2)]
      (if (< new-size dflt-len)
        s
        (resize s new-size))))

  (doc contains? "Check whether the set `s` contains the value `v`.")
  (defn contains? [s v]
    (let [idx (Int.positive-mod (hash v) @(n-buckets s))]
      (SetBucket.contains? (Array.unsafe-nth (buckets s) idx) v)))

  (doc put "Put a value `v` into the set `s`.")
  (defn put [s v]
    (cond
      (contains? &s v)
        s
      (> (/ (* @(len &s) 100) @(n-buckets &s)) max-load)
        (put (grow s) v)
      (let [idx (Int.positive-mod (hash v) @(n-buckets &s))
            ;; The lifetime system really doesn't like this function, had to put in a bunch of copying to make it compile:
            ]
        (update-len
          (update-buckets s &(fn [b]
            (let [n (Array.unsafe-nth &b idx)]
              (let [new-k @v] ;; HACK!
                (Array.aset b idx (SetBucket.grow n new-k))))))
          &Int.inc))))

  (doc put! "Put a value `v` into the set `s`, in place.")
  (defn put! [s v]
    (unless (contains? s v)
      (put-! s v)))

  (doc length "Get the length of set s.")
  (defn length [s]
    @(len s))

  (doc empty? "Check whether the set s is empty.")
  (defn empty? [s]
    (= (Set.length s) 0))
  (implements empty? Set.empty?)

  (doc remove "Remove the value `v` from the set `s`.")
  (defn remove [s v]
    (cond
      (not (contains? &s v))
        s
      (and (< (/ (* @(len &s) 100) @(n-buckets &s)) min-load)
           (>= @(n-buckets &s) (* 2 dflt-len)))
        (remove (shrink s) v)
      (let [idx (Int.positive-mod (hash v) @(n-buckets &s))]
        (update-len
          (update-buckets s &(fn [b]
                               (let [n (Array.unsafe-nth &b idx)]
                                 (Array.aset b idx (SetBucket.shrink n v)))))
          &Int.dec))))

  (doc all? "Does the predicate hold for all values in this set?")
  (defn all? [pred set]
    (let-do [ret true]
      (foreach [bucket (buckets set)]
        (foreach [e (SetBucket.entries bucket)]
          (unless (~pred e)
            (do
              (set! ret false)
              (break)))))
      ret))

  (doc subset? "Is set-a a subset of set-b?")
  (defn subset? [set-a set-b]
    (all? &(fn [e] (Set.contains? set-b e)) set-a))

  (defn = [set-a set-b]
    (and (= (Set.length set-a) (Set.length set-b))
         (subset? set-a set-b)))
  (implements = Set.=)

  (doc for-each "Execute the unary function f for each element in the set s.")
  (defn for-each [s f]
    (for [i 0 @(n-buckets s)]
      (let [bucket (Array.unsafe-nth (buckets s) i)
            len (Array.length (SetBucket.entries bucket))
            entries (SetBucket.entries bucket)]
        (for [j 0 len]
          (let [e (Array.unsafe-nth entries j)]
            (~f e))))))

  (doc from-array "Create a set from the values in array a.")
  (defn from-array [a]
    (let-do [s (create)]
      (for [i 0 (Array.length a)]
        (let [e (Array.unsafe-nth a i)]
          (put! &s e)))
      s))

  (doc reduce "Reduce values of the set with function f. Order of reduction is not guaranteed")
  (defn reduce [f init s]
    (do
      (for [i 0 @(n-buckets s)]
        (let [bucket (Array.unsafe-nth (buckets s) i)
              len (Array.length (SetBucket.entries bucket))
              entries (SetBucket.entries bucket)]
          (for [j 0 len]
            (let [e (Array.unsafe-nth entries j)]
              (set! init (~f init e))))))
      init))

  (doc intersection "Set of elements that are in both set-a and set-b")
  (defn intersection [set-a set-b]
    (reduce &(fn [s a] (if (Set.contains? set-b a) (Set.put s a) s))
            (Set.create)
            set-a))

  (doc union "Set of elements that are in either set-a or set-b (or both)")
  (defn union [set-a set-b]
    (reduce &Set.put
            @set-a
            set-b))

  (doc difference "Set of elements that are in set-a but not set-b")
  (defn difference [set-a set-b]
    (reduce &Set.remove
            @set-a
            set-b))

  (doc to-array "Convert Set to Array of elements")
  (defn to-array [s]
    (reduce &(fn [arr elt] (Array.push-back arr @elt)) [] s))

  (defn str [set]
    (let [res (reduce &(fn [s e] (String.join "" &[s @" " (prn e)]))
                      @"{"
                      set)]
      (String.append &res " }")))
  (implements str Set.str)
)


; Dynamic maps:

(defmodule Dynamic
  (doc n-times "make a list by executing `f` `n` times.")
  (defndynamic n-times [n f]
    (if (= n 0)
      '()
      (cons (f) (n-times (dec n) f))))

  (defmodule Pair
    (doc init "creates a dynamic pair, i.e. a list with two elements.")
    (defndynamic init [k v] (list k v)))

  (defmodule Map
    (hidden dflt-len)
    (defdynamic dflt-len 16)

    (hidden min-load)
    (defdynamic min-load 20)
    (hidden max-load)
    (defdynamic max-load 80)

    (doc create "makes a dynamic map.")
    (defndynamic create []
      (n-times Map.dflt-len list))

    (hidden resize-bucket)
    (defndynamic resize-bucket [n m]
      (if (empty? m)
        n
        (Map.resize-bucket (Map.put n (caar m) (cadar m)) (cdr m))))

    (hidden resize-)
    (defndynamic resize- [n m]
      (if (empty? m)
        n
        (do
          (Map.resize- (Map.resize-bucket n (car m)) (cdr m)))))

    (doc resize "resizes a dynamic map to size `s`.")
    (defndynamic resize [m s]
      (let-do [n (n-times s list)]
        (Map.resize- n m )))

    (doc grow "grows a dynamic map.")
    (defndynamic grow [m] (Map.resize m (* (length m) 2)))
    (doc shrink "shrinks dynamic map.")
    (defndynamic shrink [m]
      (let [new-size (/ (length m) 2)]
        (if (< new-size dflt-len)
          m
          (Map.resize m new-size))))

    (doc contains? "checks whether the dynamic map `m` contains the key `k`.")
    (defndynamic contains? [m k]
      (let [idx (Dynamic.imod (hash k) (length m))]
        (List.in? k (map car (List.nth m idx)))))

    (doc put "adds a value `v` under the key `k` into the map. If `k` already
exists in the map, it is updated.")
    (defndynamic put [m k v]
      (if (> (/ (* (Map.len m) 100) (length m)) Map.min-load)
        (Map.put (Map.grow m) k v)
        (if (Map.contains? m k)
          (Map.update m k (fn [_] v))
          (let [idx (Dynamic.imod (hash k) (length m))]
            (List.update-nth m idx (fn [l] (cons (list k v) l)))))))

    (doc get-with-default "gets the value under the key `k`. If `k` doesn’t
exist in the map, the default value is returned.")
    (defndynamic get-with-default [m k default-value]
      (if (Map.contains? m k)
        (let [idx (Dynamic.imod (hash k) (length m))
              l (List.nth m idx)]
          (cadr (List.find l (fn [pair] (= (car pair) k)))))
          default-value))

    (doc get "gets the value under the key `k`. If `k` doesn’t exist in the
map, `nil` is returned.")
    (defndynamic get [m k]
      (Map.get-with-default m k nil))

    (doc update "updates the value under the key `k` using the function `f`. If
`k` doesn’t exist in the map, it is returned unchanged.")
    (defndynamic update [m k f]
      (if (Map.contains? m k)
        (let [idx (Dynamic.imod (hash k) (length m))]
          (List.update-nth m idx
            (curry
                map
                (fn [pair] (if (= (car pair) k) (list k (f (cadr pair))) pair)))))
        m))

    (doc update-with-default "updates the value under the key `k` using the
function `f`. If `k` doesn’t exist in the map, it is set to `(f v)`.")
    (defndynamic update-with-default [m k f v]
      (if (Map.contains? m k)
        (let [idx (Dynamic.imod (hash k) (length m))]
          (List.update-nth m idx
            (curry
                map
                (fn [pair] (if (= (car pair) k) (list k (f (cadr pair))) pair)))))
        (Map.put m k (f v))))

    (doc len "returns the length of the map `m`.")
    (defndynamic len [m]
      (reduce (fn [acc l] (+ acc (length l))) 0 m))

    (doc empty? "checks whether the map `m` is empty.")
    (defndynamic empty? [m]
      (= (Map.len m) 0))

    (doc keys "returns the key in the map `m`.")
    (defndynamic keys [m]
      (reduce (fn [acc l] (append acc (map car l))) '() m))

    (doc vals "returns the values in the map `m`.")
    (defndynamic vals [m]
      (reduce (fn [acc l] (append acc (map cadr l))) '() m))

    (doc reverse "reverses the key-value pairs in the map `m`.")
    (defndynamic reverse [m]
      (reduce
        (fn [acc l] (reduce (fn [n p] (Map.put n (cadr p) (car p))) acc l))
        (Map.create) m))

    (defndynamic str [m]
      (String.concat [
        "{ "
        (reduce
          (fn [acc l]
            (String.concat [
              acc
              (reduce
                (fn [a pair] (String.concat [a (str (car pair)) " " (str (cadr pair)) " "]))
                ""
                l)
              ]))
          ""
          m)
        "}"]))

    (doc remove "removes the pair under the key `k` from the map `m`. If it
doesn’t exist, the map is returned unchanged.")
    (defndynamic remove [m k]
      (if (> (/ (* (Map.len m) 100) (length m)) Map.min-load)
        (Map.remove (Map.shrink m) k)
        (let [idx (imod (hash k) (length m))]
          (reduce (fn [acc l] (cons (filter (fn [pair] (/= (car pair) k)) l) acc)) '() m))))

    (doc all? "checks whether all key value pairs in `m` satisfy the predicate
`pred`. `pred` takes the pair `(k v)` as its sole argument.")
    (defndynamic all? [pred m]
      ; TODO: using (curry all? pred) doesn’t work here, i suppose it’s an env
      ; problem
      (all? (fn [l] (all? pred l)) m))

    (doc = "checks whether two maps `m1` and `m2` are equal.")
    (defndynamic = [m1 m2]
      (and (= (Map.len m1) (Map.len m2))
           (Map.all? (fn [pair] (= (cadr pair) (Map.get m2 (car pair)))) m1)))

    (doc map "maps the function `f` over all pairs in the map `m`. `f` takes
the pair `(k v)` as its sole argument and is expected to return a new value
under `v`.")
    (defndynamic map [f m]
      (map (fn [l] (map (fn [pair] (list (car pair) (f pair))) l)) m))

    (doc kv-reduce "reduces the map `m` using the function `f` and the initial
value `init`. `f` takes the accumulator and the pair `(k v)` as its arguments
and is expected to return a new accumulator.")
    (defndynamic kv-reduce [f init m]
      (reduce (fn [acc l] (reduce f acc l)) init m))

    (doc merge "merges to maps `m1` and `m2`. Values in `m1` are preferred on
collision.")
    (defndynamic merge [m1 m2]
      (Map.kv-reduce (fn [m pair] (Map.put m (car pair) (cadr pair))) m1 m2))

    (doc from-array "creates a map from an array of key-value pairs `a`.")
    (defndynamic from-array [a]
      (reduce (fn [m pair] (Map.put m (car pair) (cadr pair))) (Map.create) a))

    (doc to-array "creates an array of key-value pairs from the map `m`.")
    (defndynamic to-array [m] (collect-into (reduce append '() m) array))
  )
)

(deftype (Bag a) [
  internal (Map a Int)
])

(doc Bag
  "is an unordered datatype that only stores all its equal elements once while preserving size by storing the count of each element."
  ""
  "Implementation notes: it is a map from elements to number of occurrences"
  "under the hood.")
(defmodule Bag
  (private internal)
  (hidden internal)
  (private set-internal)
  (hidden set-internal)
  (private update-internal)
  (hidden internal)

  (doc create "Create an empty bag.")
  (defn create []
    (init (Map.create)))

  (doc contains? "Check whether the bag `b` contains the value `v`.")
  (defn contains? [b v]
    (Map.contains? (internal b) v))

  (doc put "Put a value `v` into the bag `b`.")
  (defn put [b v]
    (update-internal b &(fn [m] (Map.update-with-default m v &Int.inc 0))))

  (doc put! "Put a value `v` into the bag `b` in-place.")
  (defn put! [b v]
    (Map.update-with-default! (internal b) v &Int.inc 0))

  (doc length "Get the length of bag `b`.")
  (defn length [b]
    (Map.kv-reduce &(fn [acc _ v] (+ acc @v)) 0 (internal b)))

  (doc empty? "Check whether the bag `b` is empty.")
  (defn empty? [b]
    (Map.empty? (internal b)))
  (implements empty? Bag.empty?)

  (doc remove "Remove the value `v` from the bag `b`.")
  (defn remove [b v]
    (if (not (contains? &b v))
      b
      (update-internal b &(fn [m]
        (let [cnt (Map.get &m v)]
          (if (= cnt 1)
            (Map.remove m v)
            (Map.update m v &Int.dec)))))))

  (doc all? "Does the predicate hold for all values in this bag?")
  (defn all? [pred bag]
    (Array.all? pred &(Map.keys (internal bag))))

  (defn = [a b]
    (= (internal a) (internal b)))
  (implements = Bag.=)

  (doc for-each "Execute the unary function f for each element in the bag b.")
  (defn for-each [b f]
    (doall f (Map.keys (internal b))))

  (doc from-array "Create a bag from the values in array a.")
  (defn from-array [a]
    (let-do [b (create)]
      (for [i 0 (Array.length a)]
        (let [e (Array.unsafe-nth a i)]
          (put! &b e)))
      b))

  (doc reduce "Reduce values of the bag b with function f. Order of reduction is not guaranteed")
  (defn reduce [f init b]
    (Map.kv-reduce
      &(fn [r k cnt] (Array.reduce f r &(Array.replicate @cnt k)))
      init
      (internal b)))

  (doc to-array "Convert bag to Array of elements")
  (defn to-array [b]
    (reduce &(fn [arr elt] (Array.push-back arr @elt)) [] b))

  (defn str [set]
    (let [res (reduce &(fn [s e] (String.join "" &[s @" " (prn e)]))
                      @"(Bag"
                      set)]
      (String.append &res ")")))
  (implements str Bag.str)
)