My confusion surrounding exceptions in the IO monad comes from the fact 
that IO failures and "bottom" are not cleanly separated. I had always 
assumed the IO monad looked something like this:

     newtype IO a = IO (RealWorldState -> Either IOFailure 
(RealWorldState,a))

     return a = IO (\r -> Right (r,a))
     fail s = IO (\r -> Left (userFailure s))

This would make sense, I think, because it's so easy this way for 
Prelude.catch to catch all IOFailures but leave pure "bottom" exceptions 
alone, just as the report says. But in fact IO looks more like this:

     newtype IO a = IO (RealWorldState -> (RealWorldState,a))

     return a = IO (\r -> (r,a))
     fail s = IO (\r -> throw (userError s))

...which means Prelude.catch has to separate out exceptions caused by 
"fail" from those caused by error, etc. and there's confusion between 
"bottom" and exceptions that happen entirely in IO.

-- 
Ashley Yakeley, Seattle WA
-- ghc -package lang TestException.hs -o TestException && ./TestException
module Main where
        {
        import IORef;
        import qualified Exception;

        getPureException :: a -> IO (Maybe Exception.Exception);
        getPureException a = (Exception.catch (seq a (return Nothing)) (return . 
Just));

        showIOS :: String -> IO String -> IO ();
        showIOS s ios = do
                {
                putStr (s ++ ": ");
                mpe <- getPureException ios;
                case mpe of
                        {
                        Just pe -> putStrLn ("pure exception ("++ (show pe) ++")");
                        Nothing -> Exception.catch (Prelude.catch (do
                                {
                                result <- ios;
                                mrpe <- getPureException result;
                                case mrpe of
                                        {
                                        Just pe -> putStrLn ("returned pure exception 
("++ (show pe) ++")");
                                        Nothing -> putStrLn ("value ("++ (show result) 
++")");
                                        };
                                }) (\e -> putStrLn ("IO failure (" ++ (show e) ++")")) 
)
                                (\e -> putStrLn ("IO other exception (" ++ (show e) 
++")"));
                        };
                };

        evaluate' :: a -> IO a;
        evaluate' a = a `seq` return a;

        evaluate'' :: a -> IO a;
        evaluate'' a = (Exception.catch (seq a (return a)) (\e -> fail (show e)));

        main :: IO ();
        main = do
                {
                putStrLn "* value";
                showIOS "return text"                                           
(return "text");
                showIOS "return undefined >> return text"       (return undefined >> 
return "text");
                putStrLn "";

                putStrLn "* returned pure exception";
                showIOS "return undefined"                                      
(return undefined);
                showIOS "return (seq undefined text)"           (return (seq undefined 
"text"));
                showIOS "return () >> return undefined"         (return () >> return 
undefined);
                showIOS "return undefined >>= return"           (return undefined >>= 
return);
                putStrLn "";

                putStrLn "* IO failure";
                showIOS "fail text"                                                    
 (fail "text");
                showIOS "ioError (userError text)"                      (ioError 
(userError "text"));
                putStrLn "";

                putStrLn "* IO other exception";
                showIOS "undefined >> return text"                      (undefined >> 
return "text");
                showIOS "return () >> undefined"                        (return () >> 
undefined);
                showIOS "ioError (ErrorCall text)"                      (ioError 
(Exception.ErrorCall "text"));
                showIOS "ioError (AssertionFailed text)"        (ioError 
(Exception.AssertionFailed "text"));
                putStrLn "";

                putStrLn "* pure exception";
                showIOS "undefined"                                                    
 undefined;
                showIOS "seq undefined (return text)"           (seq undefined (return 
"text"));
                showIOS "seq undefined (return undefined)"      (seq undefined (return 
undefined));
                showIOS "error text"                                            (error 
"text");
                showIOS "throw (userError text)"                        
(Exception.throw (userError "text"));
                showIOS "throw (ErrorCall text)"                        
(Exception.throw (Exception.ErrorCall "text"));
                showIOS "throw (AssertionFailed text)"          (Exception.throw 
(Exception.AssertionFailed "text"));
                putStrLn "";

                putStrLn "* evaluate functions";
                showIOS "evaluate undefined"                            
(Exception.evaluate undefined);
                showIOS "evaluate' undefined"                           (evaluate' 
undefined);
                showIOS "evaluate'' undefined"                          (evaluate'' 
undefined);
                };
        }

Reply via email to