Here's an example of mine, that uses a hash table to construct a word frequency table.  By no means is this great code - for example the hash table filling up will lead to an infinite loop ....

This function produces a word frequency list using an intermediate hash table to accumulate the counts.

> makemap :: [String] -> [(String,Int)]
> makemap l  = filter ((> 0) . snd) $
>       runST (emptyHT >>= flip (foldM insertHT) l >>= getElems)

The hash table structure, an array.ST

> maxHash = 10000 ::Int
>
> type HT s = STArray s Int (String,Int)
>
> emptyHT :: ST s (HT s)
> emptyHT = newArray (0,maxHash) ("",0)

Update the hash table with a single entry

> insertHT :: HT s -> String -> ST s (HT s)
> insertHT h s = findSlot s h (hash s) >>= updateSlot h s >> return h

Finds the correct slot in the hash table, returning the slot index
and the old count.

> findSlot :: String -> HT s -> Int -> ST s (Int,Int)
> findSlot s h i = do (s',c) <- readArray h i
>                     if c == 0 || s == s'
>                        then return (i,c)
>                        else findSlot s h ((i+1) `mod` maxHash)
>
> updateSlot :: HT s -> String -> (Int,Int) -> ST s ()
> updateSlot h s (i,n) = writeArray h i (s,n+1)

Simple (simplistic ?) hash function

> hash :: String -> Int
> hash = (`mod` maxHash) . foldl' hash' 0
>   where hash' acc c = acc * 2 + ord c