compiler/ilxGen/tests/test19.hs

   1
   2 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
   3
   4
   5 module Test19 where
   6
   7 import PrelST
   8 import PrelBase
   9 import PrelErr
  10
  11 newtype IIO a = IIO (State# RealWorld -> (# State# RealWorld, a #))
  12
  13 unIIO :: IIO a -> (State# RealWorld -> (# State# RealWorld, a #))
  14 unIIO (IIO a) = a
  15
  16 instance  Functor IIO where
  17    fmap f x = x >>= (return . f)
  18
  19 instance  Monad IIO  where
  20     {-# INLINE return #-}
  21     {-# INLINE (>>)   #-}
  22     {-# INLINE (>>=)  #-}
  23     m >> k      =  m >>= \ _ -> k
  24     return x    = returnIIO x
  25
  26     m >>= k     = bindIIO m k
  27     fail s      = error s -- not ioError?
  28
  29
  30 bindIIO :: IIO a -> (a -> IIO b) -> IIO b
  31 bindIIO (IIO m) k = IIO ( \ s ->
  32   case m s of
  33     (# new_s, a #) -> unIIO (k a) new_s
  34   )
  35
  36 returnIIO :: a -> IIO a
  37 returnIIO x = IIO (\ s -> (# s, x #))