mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-11 04:27:55 +03:00
281 lines
7.9 KiB
Plaintext
281 lines
7.9 KiB
Plaintext
(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 isn’t 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 " }")))
|
||
)
|