fix a deadlock in atomicModifyMutVar#

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

diff --git a/ghc/compiler/utils/IOEnv.hs b/ghc/compiler/utils/IOEnv.hs
index 6f383b2..e1dfdb4 100644 (file)
--- a/ghc/compiler/utils/IOEnv.hs
+++ b/ghc/compiler/utils/IOEnv.hs
@@ -9,7 +9,7 @@ module IOEnv (
        -- Standard combinators, specialised
        returnM, thenM, thenM_, failM, failWithM,
        mappM, mappM_, mapSndM, sequenceM, sequenceM_, 
-       foldlM, 
+       foldlM, foldrM,
        mapAndUnzipM, mapAndUnzip3M, 
        checkM, ifM, zipWithM, zipWithM_,
 
@@ -154,10 +154,11 @@ mapSndM       :: (b -> IOEnv env c) -> [(a,b)] -> IOEnv env [(a,c)]
 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) }
@@ -187,6 +188,9 @@ 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; 
@@ -198,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 ()