> 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 p = MVar (AnswerMsgs p)
> data Msgs p = New Entry (Answer p) | Delete p | Lookup p (Answer p) | Stop 
> data AnswerMsgs p = Number p | Channel (Maybe Entry)

> data Num p => Dictionary p = Dict {
>   chan :: Chan (Msgs p)
>   }

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

> instance Num p => DictionaryC (Dictionary p) p 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 :: Num p => IO (Dictionary p)
> startup = do
>   ch <- newChan
>   labelChan ch "Dictionary.In"
>   forkIOLabel "Dictionary" (dictionary ch 0 [])
>   return Dict {
>     chan = ch
>    }

> dictionary :: Num p => Chan (Msgs p) -> p -> [(p,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 :: Num p => p -> [(p,Entry)] -> [(p,Entry)]
>   del _ [] = []
>   del i (x@(n,_):xs)
>     | i == n    = xs
>     | otherwise = x:(del i xs)