remove empty dir

[ghc-hetmet.git] / ghc / compiler / utils / IOEnv.hs

diff --git a/ghc/compiler/utils/IOEnv.hs b/ghc/compiler/utils/IOEnv.hs
index c217c19..e1dfdb4 100644 (file)
--- a/ghc/compiler/utils/IOEnv.hs
+++ b/ghc/compiler/utils/IOEnv.hs
@@ -7,8 +7,9 @@ module IOEnv (
        IOEnv,  -- Instance of Monad
 
        -- Standard combinators, specialised
-       returnM, thenM, thenM_, failM,
-       mappM, mappM_, mapSndM, sequenceM, foldlM, 
+       returnM, thenM, thenM_, failM, failWithM,
+       mappM, mappM_, mapSndM, sequenceM, sequenceM_, 
+       foldlM, foldrM,
        mapAndUnzipM, mapAndUnzip3M, 
        checkM, ifM, zipWithM, zipWithM_,
 
@@ -16,7 +17,7 @@ module IOEnv (
        getEnv, setEnv, updEnv,
 
        runIOEnv, unsafeInterleaveM,                    
-       tryM, fixM, 
+       tryM, tryAllM, fixM, 
 
        -- I/O operations
        ioToIOEnv,
@@ -24,12 +25,10 @@ module IOEnv (
   ) where
 #include "HsVersions.h"
 
-import Panic           ( tryJust )
+import Panic           ( try, tryUser, Exception(..) )
 import DATA_IOREF      ( IORef, newIORef, readIORef, writeIORef )
 import UNSAFE_IO       ( unsafeInterleaveIO )
 import FIX_IO          ( fixIO )
-import EXCEPTION       ( Exception(..) )
-import IO              ( isUserError )
 
 
 ----------------------------------------------------------------------
@@ -59,6 +58,9 @@ thenM_ (IOEnv m) f = IOEnv (\ env -> do { m env ; unIOEnv f env })
 failM :: IOEnv env a
 failM = IOEnv (\ env -> ioError (userError "IOEnv failure"))
 
+failWithM :: String -> IOEnv env a
+failWithM s = IOEnv (\ env -> ioError (userError s))
+
 
 
 ----------------------------------------------------------------------
@@ -85,19 +87,18 @@ fixM f = IOEnv (\ env -> fixIO (\ r -> unIOEnv (f r) env))
 
 ---------------------------
 tryM :: IOEnv env r -> IOEnv env (Either Exception r)
--- Reflect exception into IOEnv envonad
-tryM (IOEnv thing) = IOEnv (\ env -> tryJust tc_errors (thing env))
-  where 
-#if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
-       tc_errors e@(IOException ioe) | isUserError ioe = Just e
-#elif __GLASGOW_HASKELL__ == 502
-       tc_errors e@(UserError _) = Just e
-#else 
-       tc_errors e@(IOException ioe) | isUserError e = Just e
-#endif
-       tc_errors _other = Nothing
-       -- type checker failures show up as UserErrors only
-
+-- Reflect UserError exceptions into IOEnv monad
+-- The idea is that errors in the program being compiled will give rise
+-- to UserErrors.  But, say, pattern-match failures in GHC itself should
+-- not be caught here, else they'll be reported as errors in the program 
+-- begin compiled!
+tryM (IOEnv thing) = IOEnv (\ env -> tryUser (thing env))
+
+tryAllM :: IOEnv env r -> IOEnv env (Either Exception 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))
 
 ---------------------------
 unsafeInterleaveM :: IOEnv env a -> IOEnv env a
@@ -151,11 +152,13 @@ mappM_          :: (a -> IOEnv env b) -> [a] -> IOEnv env ()
 mapSndM       :: (b -> IOEnv env c) -> [(a,b)] -> IOEnv env [(a,c)]
        -- Funny names to avoid clash with Prelude
 sequenceM     :: [IOEnv env a] -> IOEnv env [a]
+sequenceM_    :: [IOEnv env a] -> IOEnv env ()
 foldlM        :: (a -> b -> IOEnv env a)  -> a -> [b] -> IOEnv env a
+foldrM        :: (b -> a -> IOEnv env a)  -> a -> [b] -> IOEnv env a
 mapAndUnzipM  :: (a -> IOEnv env (b,c))   -> [a] -> IOEnv env ([b],[c])
 mapAndUnzip3M :: (a -> IOEnv env (b,c,d)) -> [a] -> IOEnv env ([b],[c],[d])
-checkM       :: Bool -> IOEnv env () -> IOEnv env ()   -- Perform arg if bool is False
-ifM          :: Bool -> IOEnv env () -> IOEnv env ()   -- Perform arg if bool is True
+checkM       :: Bool -> IOEnv env a -> IOEnv env ()    -- Perform arg if bool is False
+ifM          :: Bool -> IOEnv env a -> IOEnv env ()    -- Perform arg if bool is True
 
 mappM f []     = return []
 mappM f (x:xs) = do { r <- f x; rs <- mappM f xs; return (r:rs) }
@@ -179,9 +182,15 @@ zipWithM_ f (a:as) (b:bs) = do { f a b; zipWithM_ f as bs }
 sequenceM [] = return []
 sequenceM (x:xs) = do { r <- x; rs <- sequenceM xs; return (r:rs) }
 
+sequenceM_ []     = return ()
+sequenceM_ (x:xs) = do { x; sequenceM_ xs }
+
 foldlM k z [] = return z
 foldlM k z (x:xs) = do { r <- k z x; foldlM k r xs }
 
+foldrM k z [] = return z
+foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }
+
 mapAndUnzipM f []     = return ([],[])
 mapAndUnzipM f (x:xs) = do { (r,s) <- f x; 
                             (rs,ss) <- mapAndUnzipM f xs; 
@@ -193,7 +202,7 @@ mapAndUnzip3M f (x:xs) = do { (r,s,t) <- f x;
                              return (r:rs, s:ss, t:ts) }
 
 checkM True  err = return ()
-checkM False err = err
+checkM False err = do { err; return () }
 
-ifM True  do_it = do_it
+ifM True  do_it = do { do_it; return () }
 ifM False do_it = return ()