X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Futils%2FIOEnv.hs;h=a87413b347c09a61349e81a697c967ad3cf04859;hb=cf05b97f5c181059418c53e43fab946734cfb41d;hp=30cc28b42ff5adff0cd0fa142d5401855387f396;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 30cc28b..a87413b 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -1,9 +1,3 @@ --- --- (c) The University of Glasgow 2002-2006 --- --- The IO Monad with an environment --- - {-# OPTIONS -w #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix @@ -11,13 +5,19 @@ -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details +-- +-- (c) The University of Glasgow 2002-2006 +-- +-- The IO Monad with an environment +-- + module IOEnv ( IOEnv, -- Instance of Monad -- Standard combinators, specialised returnM, thenM, thenM_, failM, failWithM, mappM, mappM_, mapSndM, sequenceM, sequenceM_, - foldlM, foldrM, + foldlM, foldrM, anyM, mapAndUnzipM, mapAndUnzip3M, checkM, ifM, zipWithM, zipWithM_, @@ -99,7 +99,9 @@ fixM f = IOEnv (\ env -> fixIO (\ r -> unIOEnv (f r) env)) --------------------------- tryM :: IOEnv env r -> IOEnv env (Either Exception r) --- Reflect UserError exceptions into IOEnv monad +-- Reflect UserError exceptions (only) into IOEnv monad +-- Other exceptions are not caught; they are simply propagated as exns +-- -- 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 @@ -174,6 +176,7 @@ 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 a -> IOEnv env () -- Perform arg if bool is False ifM :: Bool -> IOEnv env a -> IOEnv env () -- Perform arg if bool is True +anyM :: (a -> IOEnv env Bool) -> [a] -> IOEnv env Bool mappM f [] = return [] mappM f (x:xs) = do { r <- f x; rs <- mappM f xs; return (r:rs) } @@ -184,6 +187,10 @@ mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) } mappM_ f [] = return () mappM_ f (x:xs) = f x >> mappM_ f xs +anyM f [] = return False +anyM f (x:xs) = do { b <- f x; if b then return True + else anyM f xs } + zipWithM :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env [c] zipWithM f [] bs = return [] zipWithM f as [] = return []