Fix some more tests on Win64
[packages/base.git] / tests / 5943.hs
1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2
3 import Control.Monad
4 import Control.Monad.Fix
5 import Data.IORef
6 import Prelude hiding (until)
7
8 data Phase a = Ready a | Updated a a
9
10 delay :: IO Int -- ^ the signal to delay
11 -> IO (IO (), IO (), IO Int) -- ^ the delayed signal
12 delay s = do
13 ref <- newIORef (Ready 0)
14 let
15 upd = do v <- readIORef ref
16 case v of
17 Ready x -> do putStrLn "upd: Ready"; x' <- s; putStrLn (show x'); writeIORef ref (Updated x' x)
18 _ -> return ()
19
20 fin = do v <- readIORef ref
21 case v of
22 Updated x _ -> do putStrLn "fin: Updated"; writeIORef ref $! Ready x
23 _ -> error "Signal not updated!"
24
25 sig = do v <- readIORef ref
26 case v of
27 Ready x -> do putStrLn "sig: Ready"; return x
28 Updated _ x -> do putStrLn "sig: Updated"; return x
29
30 return (upd,fin,sig)
31
32 main = do
33 (upd,fin,_) <- mfix $ \ ~(_,_,sig) -> delay (fmap (1+) sig)
34 upd
35 fin
36 upd