X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FIOEnv.hs;h=86d3ab2df93514e8d3c4ef98161178ce4109b96d;hb=92478f77bb46576b9a652acbc4dd3e92c3a1fb06;hp=a87413b347c09a61349e81a697c967ad3cf04859;hpb=acb70e7c53a81ffea471d3bd6fb75c12e6bb2a37;p=ghc-hetmet.git

diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs
index a87413b..86d3ab2 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/utils/IOEnv.hs
@@ -38,7 +38,7 @@ import Panic		( try, tryUser, tryMost, Exception(..) )
 import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
 import System.IO.Unsafe	( unsafeInterleaveIO )
 import System.IO	( fixIO )
-
+import MonadUtils
 
 ----------------------------------------------------------------------
 --		Defining the monad type
@@ -49,13 +49,17 @@ newtype IOEnv env a = IOEnv (env -> IO a)
 unIOEnv (IOEnv m) = m
 
 instance Monad (IOEnv m) where
-  (>>=)  = thenM
-  (>>)   = thenM_
-  return = returnM
-  fail s = failM	-- Ignore the string
+    (>>=)  = thenM
+    (>>)   = thenM_
+    return = returnM
+    fail s = failM	-- Ignore the string
+
+instance Applicative (IOEnv m) where
+    pure = returnM
+    IOEnv f <*> IOEnv x = IOEnv (\ env -> f env <*> x env )
 
 instance Functor (IOEnv m) where
-  fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env))
+    fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env))
 
 returnM :: a -> IOEnv env a
 returnM a = IOEnv (\ env -> return a)