Ticket #440: typeerror.2.hs

File typeerror.2.hs, 1.5 KB (added by as49, 9 years ago)
Line 
1-- | Delete an element.
2--
3-- * Returns 'Nothing' if the element was not in the hashtable, otherwise
4--   it returns the value that was removed.
5--
6delete :: (MonadIO m, Eq id, Id id) => IdHashTable id a -> id -> m (Maybe a)
7delete (IdHashTable ht) id | id/=toId empty && id/=toId deleted liftIO $ do
8  (IdHashTableImpl keys dats usedRef) <- readIORef ht
9  --putStrLn ("trying to delete key "++show id)
10  let
11    size = snd (bounds keys)
12    key = fromIntegral (fromId id)
13    del (o:os) = do
14      let k=(key+o) `mod` size
15      elem <- readArray keys k
16      --putStrLn ("looking at index "++show k++", found "++show elem)
17      if elem==fromId id then do
18          writeArray keys k deleted
19          val <- readArray dats k
20          writeArray dats k undefined
21          modifyIORef usedRef ((-)1)
22          return (Just val)
23        else if elem==empty then return Nothing else del os
24  used <- readIORef usedRef
25  if used==0 then return Nothing else del j
26
27-- | Lookup an entry in the table.
28--
29lookup :: (MonadIO m, Eq id, Id id) => IdHashTable id a -> id -> m (Maybe a)
30lookup (IdHashTable ht) id | id/=toId empty && id/=toId deleted = liftIO $ do
31  (IdHashTableImpl keys dats usedRef) <- readIORef ht
32  --putStrLn ("trying to loookup key "++show id)
33  let
34    size = snd (bounds keys)
35    key = fromIntegral (fromId id)
36    lu (o:os) = do
37      let k=(key+o) `mod` size
38      elem <- readArray keys k
39      --putStrLn ("looking at index "++show k++", found "++show elem)
40      if elem==empty then return Nothing else
41        if elem/=fromId id then lu os else liftM Just $ readArray dats k
42  lu j
43