> module Dictionary (startup, Dictionary, lookup, allocate, delete, sendToLocal, stop)
>  where

> import DHSCore
> import IO
> import Prelude hiding (lookup) -- argh
> import qualified Prelude

#ifdef CONCDEBUG

> import ConcurrentDebug as Concurrent

#else

> import ConcurrentDebugLess as Concurrent

#endif

> type Entry  = StringChan
> type Answer = MVar AnswerMsgs
> data Msgs = New Entry Answer | Delete PidInt | Lookup PidInt Answer | Stop 
> data AnswerMsgs = Number PidInt | Channel (Maybe Entry)

> data Dictionary = Dict {
>   chan :: Chan Msgs
>   }

> class DictionaryC a where
>   lookup      :: a -> PidInt -> IO (Maybe Entry)
>   allocate    :: a -> Entry  -> IO PidInt
>   delete      :: a -> PidInt -> IO ()
>   sendToLocal :: a -> PidInt -> String -> IO Bool
>   stop        :: a -> IO ()

> instance DictionaryC Dictionary where

External API w/o making the channels explicitely visible. Remember that MVars are
really cheap in Haskell.

>   lookup d p = do
>     mv <- newEmptyMVar
>     writeChan (chan d) (Lookup p mv)
>     Channel res <- takeMVar mv
>     return res

The name "allocate" is probably misleading. We just register an already
existing channel.

>   allocate d e = do
>     mv <- newEmptyMVar
>     writeChan (chan d) (New e mv)
>     Number p <- takeMVar mv
>     return p

>   delete d p = 
>     writeChan (chan d) (Delete p)

>   stop d = 
>     writeChan (chan d) Stop


We provide a shortcut which just needs a low-level pid and channels to the dictionary.

>   sendToLocal d p v = do
>     -- putStrLn $ "lookup " ++ (show p)
>     let ch = chan d
>     res <- lookup d p
>     case res of
>       Nothing -> do
>         -- putStrLn "aha"
>	  return False
>       Just ch -> do
>         writeChan ch v
>	  return True

> startup :: IO Dictionary
> startup = do
>   ch <- newChan
>   labelChan ch "Dictionary.In"
>   forkIOLabel "Dictionary" (dictionary ch 0 [])
>   return Dict {
>     chan = ch
>    }

> dictionary :: Chan Msgs -> PidInt -> [(PidInt,Entry)] -> IO ()
> dictionary ch n dic = do
>     v <- readChan ch
>     case v of
>       New nch mv -> do
>	  putMVar mv (Number n)
>	  dictionary ch (n+1) ((n,nch):dic)
>	Delete i -> do
>	  -- putStrLn $ "delete " ++ (show i)
>	  dictionary ch n (del i dic) -- the rest is up to the gc
>	Lookup i mv -> do
>	  putMVar mv (Channel (Prelude.lookup i dic))
>	  dictionary ch n dic
> 	Stop -> return ()
>  where
>   del :: PidInt -> [(PidInt,Entry)] -> [(PidInt,Entry)]
>   del _ [] = []
>   del i (x@(n,_):xs)
>     | i == n    = xs
>     | otherwise = x:(del i xs)