Remove a redundant options pragma
[ghc-hetmet.git] / compiler / utils / IOEnv.hs
index f373e59..0cad752 100644 (file)
@@ -1,10 +1,3 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 --
 -- (c) The University of Glasgow 2002-2006
 --
@@ -29,9 +22,9 @@ module IOEnv (
         -- I/O operations
         IORef, newMutVar, readMutVar, writeMutVar, updMutVar
   ) where
-#include "HsVersions.h"
 
-import Panic            ( try, tryUser, tryMost, Exception(..) )
+import Exception
+import Panic
 
 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef )
 import System.IO.Unsafe ( unsafeInterleaveIO )
@@ -44,13 +37,15 @@ import MonadUtils
 
 
 newtype IOEnv env a = IOEnv (env -> IO a)
+
+unIOEnv :: IOEnv env a -> (env -> IO a)
 unIOEnv (IOEnv m) = m
 
 instance Monad (IOEnv m) where
     (>>=)  = thenM
     (>>)   = thenM_
     return = returnM
-    fail s = failM -- Ignore the string
+    fail _ = failM -- Ignore the string
 
 instance Applicative (IOEnv m) where
     pure = returnM
@@ -60,7 +55,7 @@ instance Functor (IOEnv m) where
     fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env))
 
 returnM :: a -> IOEnv env a
-returnM a = IOEnv (\ env -> return a)
+returnM a = IOEnv (\ _ -> return a)
 
 thenM :: IOEnv env a -> (a -> IOEnv env b) -> IOEnv env b
 thenM (IOEnv m) f = IOEnv (\ env -> do { r <- m env ;
@@ -70,10 +65,10 @@ thenM_ :: IOEnv env a -> IOEnv env b -> IOEnv env b
 thenM_ (IOEnv m) f = IOEnv (\ env -> do { m env ; unIOEnv f env })
 
 failM :: IOEnv env a
-failM = IOEnv (\ env -> ioError (userError "IOEnv failure"))
+failM = IOEnv (\ _ -> ioError (userError "IOEnv failure"))
 
 failWithM :: String -> IOEnv env a
-failWithM s = IOEnv (\ env -> ioError (userError s))
+failWithM s = IOEnv (\ _ -> ioError (userError s))
 
 
 
@@ -100,7 +95,11 @@ fixM f = IOEnv (\ env -> fixIO (\ r -> unIOEnv (f r) env))
 
 
 ---------------------------
+#if __GLASGOW_HASKELL__ < 609
 tryM :: IOEnv env r -> IOEnv env (Either Exception r)
+#else
+tryM :: IOEnv env r -> IOEnv env (Either ErrorCall r)
+#endif
 -- Reflect UserError exceptions (only) into IOEnv monad
 -- Other exceptions are not caught; they are simply propagated as exns
 --
@@ -110,13 +109,14 @@ tryM :: IOEnv env r -> IOEnv env (Either Exception r)
 -- begin compiled!
 tryM (IOEnv thing) = IOEnv (\ env -> tryUser (thing env))
 
-tryAllM :: IOEnv env r -> IOEnv env (Either Exception r)
+-- XXX We shouldn't be catching everything, e.g. timeouts
+tryAllM :: IOEnv env r -> IOEnv env (Either SomeException r)
 -- Catch *all* exceptions
 -- This is used when running a Template-Haskell splice, when
 -- even a pattern-match failure is a programmer error
 tryAllM (IOEnv thing) = IOEnv (\ env -> try (thing env))
 
-tryMostM :: IOEnv env r -> IOEnv env (Either Exception r)
+tryMostM :: IOEnv env r -> IOEnv env (Either SomeException r)
 tryMostM (IOEnv thing) = IOEnv (\ env -> tryMost (thing env))
 
 ---------------------------
@@ -129,7 +129,7 @@ unsafeInterleaveM (IOEnv m) = IOEnv (\ env -> unsafeInterleaveIO (m env))
 ----------------------------------------------------------------------
 
 instance MonadIO (IOEnv env) where
-    liftIO io = IOEnv (\ env -> io)
+    liftIO io = IOEnv (\ _ -> io)
 
 newMutVar :: a -> IOEnv env (IORef a)
 newMutVar val = liftIO (newIORef val)
@@ -155,7 +155,7 @@ getEnv = IOEnv (\ env -> return env)
 -- | Perform a computation with a different environment
 setEnv :: env' -> IOEnv env' a -> IOEnv env a
 {-# INLINE setEnv #-}
-setEnv new_env (IOEnv m) = IOEnv (\ env -> m new_env)
+setEnv new_env (IOEnv m) = IOEnv (\ _ -> m new_env)
 
 -- | Perform a computation with an altered environment
 updEnv :: (env -> env') -> IOEnv env' a -> IOEnv env a
@@ -168,17 +168,17 @@ updEnv upd (IOEnv m) = IOEnv (\ env -> m (upd env))
 -- (for efficiency)
 ----------------------------------------------------------------------
 
-{-# -- SPECIALIZE mapM          :: (a -> IOEnv env b) -> [a] -> IOEnv env [b] #-}
-{-# -- SPECIALIZE mapM_         :: (a -> IOEnv env b) -> [a] -> IOEnv env () #-}
-{-# -- SPECIALIZE mapSndM       :: (b -> IOEnv env c) -> [(a,b)] -> IOEnv env [(a,c)] #-}
-{-# -- SPECIALIZE sequence      :: [IOEnv env a] -> IOEnv env [a] #-}
-{-# -- SPECIALIZE sequence_     :: [IOEnv env a] -> IOEnv env () #-}
-{-# -- SPECIALIZE foldlM        :: (a -> b -> IOEnv env a)  -> a -> [b] -> IOEnv env a #-}
-{-# -- SPECIALIZE foldrM        :: (b -> a -> IOEnv env a)  -> a -> [b] -> IOEnv env a #-}
-{-# -- SPECIALIZE mapAndUnzipM  :: (a -> IOEnv env (b,c))   -> [a] -> IOEnv env ([b],[c]) #-}
-{-# -- SPECIALIZE mapAndUnzip3M :: (a -> IOEnv env (b,c,d)) -> [a] -> IOEnv env ([b],[c],[d]) #-}
-{-# -- SPECIALIZE zipWithM      :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env [c] #-}
-{-# -- SPECIALIZE zipWithM_     :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env () #-}
-{-# -- SPECIALIZE anyM          :: (a -> IOEnv env Bool) -> [a] -> IOEnv env Bool #-}
-{-# -- SPECIALIZE when          :: Bool -> IOEnv env a -> IOEnv env () #-}
-{-# -- SPECIALIZE unless        :: Bool -> IOEnv env a -> IOEnv env () #-}
+-- {-# SPECIALIZE mapM          :: (a -> IOEnv env b) -> [a] -> IOEnv env [b] #-}
+-- {-# SPECIALIZE mapM_         :: (a -> IOEnv env b) -> [a] -> IOEnv env () #-}
+-- {-# SPECIALIZE mapSndM       :: (b -> IOEnv env c) -> [(a,b)] -> IOEnv env [(a,c)] #-}
+-- {-# SPECIALIZE sequence      :: [IOEnv env a] -> IOEnv env [a] #-}
+-- {-# SPECIALIZE sequence_     :: [IOEnv env a] -> IOEnv env () #-}
+-- {-# SPECIALIZE foldlM        :: (a -> b -> IOEnv env a)  -> a -> [b] -> IOEnv env a #-}
+-- {-# SPECIALIZE foldrM        :: (b -> a -> IOEnv env a)  -> a -> [b] -> IOEnv env a #-}
+-- {-# SPECIALIZE mapAndUnzipM  :: (a -> IOEnv env (b,c))   -> [a] -> IOEnv env ([b],[c]) #-}
+-- {-# SPECIALIZE mapAndUnzip3M :: (a -> IOEnv env (b,c,d)) -> [a] -> IOEnv env ([b],[c],[d]) #-}
+-- {-# SPECIALIZE zipWithM      :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env [c] #-}
+-- {-# SPECIALIZE zipWithM_     :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env () #-}
+-- {-# SPECIALIZE anyM          :: (a -> IOEnv env Bool) -> [a] -> IOEnv env Bool #-}
+-- {-# SPECIALIZE when          :: Bool -> IOEnv env a -> IOEnv env () #-}
+-- {-# SPECIALIZE unless        :: Bool -> IOEnv env a -> IOEnv env () #-}