> module Main where

> import IO
> import Distributed
> import Concurrent

> data Test = Down Pid deriving (Read,Show)
> instance Serialize Test

> monitorProcess :: Pid         -- zu überwachender Prozess
>                -> DIO Test b  -- auszuführender Block
>                -> DIO Test () -- "Exception"-Handler
>                -> DIO Test b
> 
> monitorProcess p f e = do
>   mv <- proc $ newEmptyMVar
>   mp <- spawn (do
>     me <- proc $ myThreadId
>     proc $ putMVar mv (Just me)
>     linkMeWith p
>     receive (\ v -> case v of
>       Down _ -> do
>         _ <- proc $ takeMVar mv
>         proc $ putMVar mv Nothing
>         e
>      )
>    )
>   res <- f
>   maybeHim <- proc $ takeMVar mv
>   case maybeHim of
>     Just him -> proc $ killThread him
>     Nothing  -> return ()
>   return res

> monitorAndKillProcess :: Pid        -- wie vor
>                       -> DIO Test b -- auszuführender Block
>                       -> DIO Test (Maybe b)
> monitorAndKillProcess p f = do
>   result <- proc $ newEmptyMVar
>   parent <- proc $ newEmptyMVar
>   sync <- proc $ newEmptyMVar
>   monitorProcess p
>     (do
>       spawn (do
>         me <- proc $ myThreadId
>         proc $ putMVar parent me
>         res <- f
>         _ <- proc $ takeMVar parent
>         proc $ putMVar result (Just res)
>	  proc $ putMVar sync ()
>        )
>       proc $ takeMVar sync
>      )
>     (do
>        him <- proc $ takeMVar parent
>        proc $ killThread him
>        proc $ putMVar result Nothing
>	 proc $ putMVar sync ()
>      )
>   res <- proc $ takeMVar result
>   return res

> main = Distributed.start (do
>   pid <- spawn ( return ())
>   res <- monitorAndKillProcess pid (do
>     proc ( do 
>	putStrLn "Waiting..."

Must make sure that delay is larger than Ping-interval:

>	threadDelay (1000*1000*25)
>	print "*** not reached *** "
>      )
>     return 3
>    )
>   proc $ print res
>   halt
>  ) ""