summaryrefslogtreecommitdiff
path: root/ghc/compiler/ilxGen/tests/test19.hs
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 #))