Carp/core/Map.carp
Erik Svedäng 470f0f827d
fix: Unify aupdate and aupdate! with other update functions (#1220)
* chore: Re-format Haskell code

* fix: Unify aupdate and aupdate! with other update functions

* fix: Re-add comment

* fix: Also make StaticArray.aupdate! adhere to the normal update signature

* fix: Failing test
2021-05-25 12:11:31 +02:00

809 lines
25 KiB
Plaintext
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(definterface hash (Fn [(Ref a)] Int))
(defmodule String
(defn hash [k]
(let-do [a 31415
b 27183
vh 0]
(for [x 0 (length k)]
(do
(set! vh (+ (* a vh) (Char.to-int (char-at k x))))
(set! a (* a b))
(set! x (Int.inc x))))
(Int.abs vh)))
(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 256)
(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)) min-load)
(put (grow m) k v)
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))
in? (contains? &m k)]
(update-len
(update-buckets m &(fn [b]
(let [n (Array.unsafe-nth &b idx)]
(Array.aset b idx (Bucket.put @n k v)))))
&(if in? 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 isnt 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 isnt 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))]
(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)))))))))
(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 (> (/ (* @(len &m) 100) @(n-buckets &m)) min-load)
(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 256)
(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)) min-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
(> (/ (* @(len &s) 100) @(n-buckets &s)) min-load)
(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` doesnt
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` doesnt 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` doesnt 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` doesnt 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
doesnt 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) doesnt work here, i suppose its 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))
)
)