{-# LANGUAGE MultiParamTypeClasses,RankNTypes #-}
import Control.Monad
import Data.IORef
import System.IO.Unsafe
newtype MyST s a=MyST {toIO :: IO a}
newtype MySTRef s a=MySTRef {toIORef :: IORef a} deriving Eq
instance Monad (MyST s) where
return x=MyST $ return x
a >>= f=MyST $ do
val<-toIO a
toIO $ f val
instance Functor (MyST s) where
fmap=liftM
instance Applicative (MyST s) where
pure=return
(<*>)=ap
newMySTRef :: a->MyST s (MySTRef s a)
newMySTRef x=MyST $ do
ref<-newIORef x
return $ MySTRef ref
readMySTRef :: MySTRef s a->MyST s a
readMySTRef ref=MyST $ readIORef $ toIORef ref
writeMySTRef :: MySTRef s a->a->MyST s ()
writeMySTRef ref x=MyST $ do
writeIORef (toIORef ref) x
return ()
modifyMySTRef :: MySTRef s a->(a->a)->MyST s ()
modifyMySTRef ref f=do
val<-readMySTRef ref
writeMySTRef ref (f val)
-- The signature prevents MySTRef leak.
runMyST :: forall a.(forall s. MyST s a)->a
-- a cat dies.
runMyST = unsafePerformIO . toIO
leakingRunMyST :: (MyST s a)->a
leakingRunMyST = unsafePerformIO . toIO
leakInt :: Int->MySTRef s Int
leakInt = leakingRunMyST . newMySTRef
badEquation = (leakInt 3) == (leakInt 3)
prog=do
ref<-newMySTRef "hello"
x<-readMySTRef ref
writeMySTRef ref (x++"world")
readMySTRef ref
--leak_ref=do
-- ref<-newMySTRef "leak!"
-- return ref
--use_leak_ref =runMyST $ do
-- readMySTRef (runMyST leak_ref)
main=(print $ runMyST prog) >> print badEquation
