blob: 88fa24d65b7768bbb93c8446e86dd46c3e0f6f4d (
plain)
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
|
