Carp/core/Map.carp
2018-08-25 19:51:27 +02:00

281 lines
7.9 KiB
Plaintext
Raw 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 rehash [k l]
(let-do [a 31415
b 27183
vh 0]
(for [x 0 (length k)]
(do
(set! vh (+ (* a (* vh l)) (Char.to-int (char-at k x))))
(set! a (* a b))
(set! x (Int.inc x))))
(Int.abs vh)))
(defn hash [k]
(rehash k 1))
)
(defmodule Int
(defn hash [k] (the Int @k))
)
(defmodule Long
(defn hash [k] (to-int (the Long @k)))
)
(defmodule Bool
(defn hash [k] (if (the Bool @k) 1 0))
)
(defmodule Char
(defn hash [k] (to-int (the Char @k)))
)
(defmodule Float
(defn hash [k] (to-bytes @k))
)
(defmodule Double
(defn hash [k] (Long.to-int (to-bytes @k)))
)
(deftype (Bucket a b) [entries (Array (Pair a b))])
(defmodule Bucket
(defn empty []
(Bucket.init []))
(defn grow [b e]
(set-entries @b (Array.push-back @(entries b) e)))
(defn get [b k]
(let-do [e &(zero)
l (Array.length (Bucket.entries b))
es (entries b)]
(for [i 0 l]
(when (= (Pair.a (Array.nth es i)) k)
(do
(set! e (Pair.b (Array.nth es i)))
(break))))
@e))
(defn contains? [b k]
(let-do [e false
l (Array.length (Bucket.entries b))
es (entries b)]
(for [i 0 l]
(when (= (Pair.a (Array.nth es i)) k)
(do
(set! e true)
(break))))
e))
(defn remove [entries k]
(let-do [nentries (the (Array (Pair a b)) [])]
(for [i 0 (Array.length entries)]
(let [e (Array.nth entries i)]
(unless (= (Pair.a e) k)
(set! nentries (Array.push-back nentries @e)))))
nentries))
(defn shrink [b k]
(if (contains? b k)
(set-entries @b (remove (entries b) k))
@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.mod (hash k) @(n-buckets m))
b (buckets m)]
(set-buckets @m (Array.aset @b
idx
(Bucket.grow (Array.nth b idx) (Pair.init @k @v))))))
(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]
(let [idx (Int.mod (hash k) @(n-buckets m))]
(Bucket.get (Array.nth (buckets m) idx) k)))
(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.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.mod (hash k) @(n-buckets m))]
(Bucket.contains? (Array.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.mod (hash k) @(n-buckets &m))
b (buckets &m)]
(set-buckets m (Array.aset @b
idx
(Bucket.shrink (Array.nth b idx) k)))))
(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.nth (buckets m) i)
len (Array.length (Bucket.entries bucket))
entries (Bucket.entries bucket)]
(for [j 0 len]
(let [e (Array.nth entries j)]
(f (Pair.a e) (Pair.b e)))))))
(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.nth a i)
k (Pair.a e)
v (Pair.b e)]
(set! m (put &m k v))))
m))
(defn str [m]
(let-do [res @"{"]
(for [i 0 @(n-buckets m)]
(let [bucket (Array.nth (buckets m) i)
len (Array.length (Bucket.entries bucket))
entries (Bucket.entries bucket)]
(for [j 0 len]
(let [e (Array.nth entries j)]
(set! res (String.join @"" &[res @" " (prn @(Pair.a e)) @" " (prn @(Pair.b e))]))))))
(String.append &res " }")))
)
(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.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.nth entries i)]
(unless (= e k)
(set! nentries (Array.push-back nentries @e)))))
nentries))
(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.mod (hash k) @(n-buckets s))
b (buckets s)]
(set-buckets @s (Array.aset @b
idx
(SetBucket.grow (Array.nth b idx) @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.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.mod (hash k) @(n-buckets s))]
(SetBucket.contains? (Array.nth (buckets s) idx) k)))
(doc remove "Remove the key k from the set s.")
(defn remove [s k]
(let [idx (Int.mod (hash k) @(n-buckets &s))
b (buckets &s)]
(set-buckets s (Array.aset @b
idx
(SetBucket.shrink (Array.nth b idx) k)))))
(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.nth (buckets s) i)
len (Array.length (SetBucket.entries bucket))
entries (SetBucket.entries bucket)]
(for [j 0 len]
(let [e (Array.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.nth a i)]
(set! s (put &s e))))
s))
(defn str [s]
(let-do [res @"{"]
(for [i 0 @(n-buckets s)]
(let [bucket (Array.nth (buckets s) i)
len (Array.length (SetBucket.entries bucket))
entries (SetBucket.entries bucket)]
(for [j 0 len]
(let [e (Array.nth entries j)]
(set! res (String.join @"" &[res @" " (prn e)]))))))
(String.append &res " }")))
)