T5943.hs 1.05 KB
Newer Older
Simon Marlow's avatar
Simon Marlow committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Monad
import Control.Monad.Fix
import Data.IORef
import Prelude hiding (until)

data Phase a = Ready a | Updated a a

delay :: IO Int               -- ^ the signal to delay
      -> IO (IO (), IO (), IO Int)   -- ^ the delayed signal
delay s = do
  ref <- newIORef (Ready 0)
  let
      upd = do v <- readIORef ref
               case v of
                 Ready x -> do putStrLn "upd: Ready"; x' <- s; putStrLn (show x'); writeIORef ref (Updated x' x)
                 _       -> return ()

      fin = do v <- readIORef ref
               case v of
                 Updated x _ -> do putStrLn "fin: Updated"; writeIORef ref $! Ready x
                 _           -> error "Signal not updated!"

      sig = do v <- readIORef ref
               case v of
                 Ready x     -> do putStrLn "sig: Ready"; return x
                 Updated _ x -> do putStrLn "sig: Updated"; return x

  return (upd,fin,sig)

main = do
    (upd,fin,_) <- mfix $ \ ~(_,_,sig) -> delay (fmap (1+) sig)
    upd
    fin
    upd