Carp/core/Map.carp

(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 (Entry a b) [key a value b])
(deftype (Bucket a b) [entries (Array (Entry 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 (= (Entry.key (Array.nth es i)) k)
          (do
            (set! e (Entry.value (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 (= (Entry.key (Array.nth es i)) k)
          (do
            (set! e true)
            (break))))
       e))

  (defn remove [entries k]
    (let-do [nentries (the (Array (Entry a b)) [])]
      (for [i 0 (Array.length entries)]
        (let [e (Array.nth entries i)]
          (unless (= (Entry.key 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 hashmap.")
  (defn create []
    (init dflt-len (Array.repeat dflt-len Bucket.empty)))

  (doc create-with-len "Create an empty hashmap with a given minimum size.")
  (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) (Entry.init @k @v))))))

  (doc get "Get the value for the key k from map m. If it isn’t found, a zero element 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 length "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 value in 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 (Entry.key e) (Entry.value 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 @" " (str @(Entry.key e)) @" " (str (Entry.value e))]))))))
      (String.append &res " }")))
)

(deftype (Set a) [n-buckets Int buckets (Array (Bucket a Bool))])

(defmodule Set
  (def dflt-len 256)

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

  (doc create-with-len "Create an empty hashset with a given minimum size.")
  (defn create-with-len [len]
    (init len (Array.repeat len Bucket.empty)))

  (doc put "Put a a value v into set m, using the key k.")
  (defn put [m k]
    (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) (Entry.init @k true))))))

  (doc length "Get the length of set 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 set m is empty.")
  (defn empty? [m]
    (= (length m) 0))

  (doc contains? "Check whether the set m contains a value associated with 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 associated with key k from set 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 unary function f for each element in set 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 (Entry.key e)))))))

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