blob: a2925990316a2af49298dd94cfb5f5c70e03c4d1 (
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
37
|
{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
module Test19 where
import PrelST
import PrelBase
import PrelErr
newtype IIO a = IIO (State# RealWorld -> (# State# RealWorld, a #))
unIIO :: IIO a -> (State# RealWorld -> (# State# RealWorld, a #))
unIIO (IIO a) = a
instance Functor IIO where
fmap f x = x >>= (return . f)
instance Monad IIO where
{-# INLINE return #-}
{-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
m >> k = m >>= \ _ -> k
return x = returnIIO x
m >>= k = bindIIO m k
fail s = error s -- not ioError?
bindIIO :: IIO a -> (a -> IIO b) -> IIO b
bindIIO (IIO m) k = IIO ( \ s ->
case m s of
(# new_s, a #) -> unIIO (k a) new_s
)
returnIIO :: a -> IIO a
returnIIO x = IIO (\ s -> (# s, x #))
|