[Haskell-cafe] STM problems
Michael Speer
knomenet at gmail.com
Sun Aug 23 08:36:36 EDT 2009
Thank you for pointing me back on track.
I got caught in a sleepy mindset of thinking of (STM a) as a datatype
only reachable while in an STM context rather than an action returning
an a.
I wanted a fixed-sized array with mutable variables ( no need to
mutate the array ) so here is the working next iteration.
import Control.Concurrent.STM
import Control.Concurrent
import Array
data HashTable a b = HashTable (a -> Int) (Array Int (TVar (Maybe b)))
mkHashTable :: ( a -> Int ) -> Int -> STM (HashTable a b)
mkHashTable hashfn numBuckets | numBuckets > 0 = do
vs <- mapM (\v -> newTVar Nothing >>= \nt -> return (v,nt)) [1..numBuckets]
return $ HashTable hashfn $ array (1,numBuckets) vs
readHashTable :: HashTable a b -> a -> STM (Maybe b)
readHashTable hashtable key =
let (HashTable hashfn table) = hashtable
in readTVar (table ! hashfn key)
writeHashTable :: HashTable a b -> a -> (Maybe b) -> STM ()
writeHashTable hashtable key value =
let (HashTable hashfn table) = hashtable
in writeTVar (table ! hashfn key) value >> return ()
main = do
v <- atomically $ do
ht <- mkHashTable id 10 :: STM (HashTable Int String)
mapM_ (\n -> writeHashTable ht n (Just $ "hello " ++ show n)) [1..10]
mapM (\n -> readHashTable ht n) [1..10]
print v
On Sun, Aug 23, 2009 at 5:12 AM, Luke Palmer<lrpalmer at gmail.com> wrote:
> On Sun, Aug 23, 2009 at 1:33 AM, Michael Speer<knomenet at gmail.com> wrote:
>> data HashTable a b = HashTable (a -> Int) (STM (Array Int (TVar (Maybe b))))
>
> So wait... a HashTable is a hash function together with an *action
> returning an array of TVars?* I don't think that's right. It looks
> like that action is recreating an empty table each time it is
> accessed. You probably want:
>
> data HashTable a b = HashTable (a -> Int) (TVar (Array Int (TVar (Maybe b))))
>
> instead. The rest of the implementation will follow the type.
>
>>
>> mkHashTable :: ( a -> Int ) -> Int -> HashTable a b
>> mkHashTable hashfn numBuckets | numBuckets > 0 = do
>> HashTable hashfn $ do
>> vs <- mapM (\v -> newTVar Nothing >>= \tv -> return (v,tv) ) [1..numBuckets]
>> return $ array (1,numBuckets) vs
>>
>> readHashTable :: HashTable a b -> a -> STM (Maybe b)
>> readHashTable hashtable key =
>> let (HashTable hashfn table) = hashtable
>> in table >>= \tb -> readTVar (tb ! hashfn key)
>>
>> writeHashTable :: HashTable a b -> a -> (Maybe b) -> STM ()
>> writeHashTable hashtable key value =
>> let (HashTable hashfn table) = hashtable
>> in table >>= \tb -> writeTVar (tb ! hashfn key) value >> return ()
>>
>> main = let ht = mkHashTable id 10 :: HashTable Int String
>> in do
>> v <- atomically $ do
>> mapM_ (\n -> writeHashTable ht n (Just $ "hello " ++ show
>> n)) [1..10]
>> mapM (\n -> readHashTable ht n) [1..10]
>> print v
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
More information about the Haskell-Cafe
mailing list