mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-17 16:38:14 +03:00
531 lines
16 KiB
Plaintext
531 lines
16 KiB
Plaintext
(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) [n-buckets Int buckets (Array (Bucket a b))])
|
||
|
||
(defmodule Map
|
||
(hidden dflt-len)
|
||
(def dflt-len 256)
|
||
|
||
(doc create "Create an empty map.")
|
||
(defn create []
|
||
(init dflt-len (Array.repeat dflt-len &Bucket.empty)))
|
||
|
||
(doc create-with-len "Create an empty map with a given number of buckets. High numbers reduce the possibility of hash collisions while increasing the memory footprint.")
|
||
(defn create-with-len [len]
|
||
(init len (Array.repeat len &Bucket.empty)))
|
||
|
||
(doc put "Put a a value v into map m, using the key k.")
|
||
(defn put [m k v]
|
||
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
|
||
(update-buckets m &(fn [b]
|
||
(let [n (Array.unsafe-nth &b idx)]
|
||
(Array.aset b idx (Bucket.put @n k v)))))))
|
||
|
||
(doc put! "Put a a value v into map m, using the key k, in place.")
|
||
(defn put! [m k v]
|
||
(let [idx (Int.positive-mod (hash k) @(n-buckets m))
|
||
b (buckets m)
|
||
n (Array.unsafe-nth b idx)]
|
||
(Bucket.put! n 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))]
|
||
(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]
|
||
(let-do [c 0]
|
||
(for [i 0 @(n-buckets m)]
|
||
(set! c (+ c (Array.length (Bucket.entries (Array.unsafe-nth (buckets m) i))))))
|
||
c))
|
||
|
||
(doc empty? "Check whether the map m is empty.")
|
||
(defn empty? [m]
|
||
(= (length m) 0))
|
||
|
||
(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 remove "Remove the value under the key k from the map m.")
|
||
(defn remove [m k]
|
||
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
|
||
(update-buckets m &(fn [b]
|
||
(let [n (Array.unsafe-nth &b idx)]
|
||
(Array.aset b idx (Bucket.shrink @n k)))))))
|
||
|
||
(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 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)]
|
||
(set! m (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) [n-buckets Int buckets (Array (SetBucket a))])
|
||
|
||
(defmodule Set
|
||
(hidden dflt-len)
|
||
(def dflt-len 256)
|
||
|
||
(doc create "Create an empty set.")
|
||
(defn create []
|
||
(init dflt-len (Array.repeat dflt-len &SetBucket.empty)))
|
||
|
||
(doc create-with-len "Create an empty set with a given number of buckets. Higher numbers decrease the probability of hash collisions while increasing the memory footprint.")
|
||
(defn create-with-len [len]
|
||
(init len (Array.repeat len &SetBucket.empty)))
|
||
|
||
(doc put "Put a a key k into the set s.")
|
||
(defn put [s k]
|
||
(let [idx (Int.positive-mod (hash k) @(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-buckets s &(fn [b]
|
||
(let [n (Array.unsafe-nth &b idx)]
|
||
(if (SetBucket.contains? n k)
|
||
b
|
||
(let [new-k @k] ;; HACK!
|
||
(Array.aset b idx (SetBucket.grow n new-k)))))))))
|
||
|
||
(doc put! "Put a a key k into the set s, in place.")
|
||
(defn put! [s k]
|
||
(let [idx (Int.positive-mod (hash k) @(n-buckets s))
|
||
b (buckets s)
|
||
n (Array.unsafe-nth b idx)]
|
||
(when (not (SetBucket.contains? n k))
|
||
(SetBucket.push-back! n @k))))
|
||
|
||
(doc length "Get the length of set s.")
|
||
(defn length [s]
|
||
(let-do [c 0]
|
||
(for [i 0 @(n-buckets s)]
|
||
(set! c (+ c (Array.length (SetBucket.entries (Array.unsafe-nth (buckets s) i))))))
|
||
c))
|
||
|
||
(doc empty? "Check whether the set s is empty.")
|
||
(defn empty? [s]
|
||
(= (length s) 0))
|
||
|
||
(doc contains? "Check whether the set s contains the key k.")
|
||
(defn contains? [s k]
|
||
(let [idx (Int.positive-mod (hash k) @(n-buckets s))]
|
||
(SetBucket.contains? (Array.unsafe-nth (buckets s) idx) k)))
|
||
|
||
(doc remove "Remove the key k from the set s.")
|
||
(defn remove [s k]
|
||
(let [idx (Int.positive-mod (hash k) @(n-buckets &s))]
|
||
(update-buckets s &(fn [b]
|
||
(let [n (Array.unsafe-nth &b idx)]
|
||
(Array.aset b idx (SetBucket.shrink n k)))))))
|
||
|
||
(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)]
|
||
(set! s (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)
|
||
)
|