Refactoring and tidyup of HscMain and related things (also fix #1666)

While trying to fix #1666 (-Werror aborts too early) I decided to some
tidyup in GHC/DriverPipeline/HscMain.

 - The GhcMonad overloading is gone from DriverPipeline and HscMain
   now.  GhcMonad is now defined in a module of its own, and only
   used in the top-level GHC layer.  DriverPipeline and HscMain
   use the plain IO monad and take HscEnv as an argument.

 - WarnLogMonad is gone.  printExceptionAndWarnings is now called
   printException (the old name is deprecated).  Session no longer
   contains warnings.

 - HscMain has its own little monad that collects warnings, and also
   plumbs HscEnv around.  The idea here is that warnings are collected
   while we're in HscMain, but on exit from HscMain (any function) we
   check for warnings and either print them (via log_action, so IDEs
   can still override the printing), or turn them into an error if
   -Werror is on.

 - GhcApiCallbacks is gone, along with GHC.loadWithLogger.  Thomas
   Schilling told me he wasn't using these, and I don't see a good
   reason to have them.

 - there's a new pure API to the parser (suggestion from Neil Mitchell):
      parser :: String
             -> DynFlags
             -> FilePath
             -> Either ErrorMessages (WarningMessages, 
                                      Located (HsModule RdrName))

1 files changed, 177 insertions, 0 deletions

diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs
new file mode 100644
index 0000000000..c62ea4c093
--- /dev/null
+++ b/compiler/main/GhcMonad.hs
@@ -0,0 +1,177 @@
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow, 2010
+--
+-- The Session type and related functionality
+--
+-- -----------------------------------------------------------------------------
+
+module GhcMonad (
+        -- * 'Ghc' monad stuff
+        GhcMonad(..),
+        Ghc(..), 
+        GhcT(..), liftGhcT,
+        reflectGhc, reifyGhc,
+        getSessionDynFlags, 
+        liftIO,
+	Session(..), withSession, modifySession, withTempSession,
+
+        -- ** Warnings
+        logWarnings
+  ) where
+
+import MonadUtils
+import HscTypes
+import DynFlags
+import Exception
+import ErrUtils
+
+import Data.IORef
+
+-- -----------------------------------------------------------------------------
+-- | A monad that has all the features needed by GHC API calls.
+--
+-- In short, a GHC monad
+--
+--   - allows embedding of IO actions,
+--
+--   - can log warnings,
+--
+--   - allows handling of (extensible) exceptions, and
+--
+--   - maintains a current session.
+--
+-- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'
+-- before any call to the GHC API functions can occur.
+--
+class (Functor m, MonadIO m, ExceptionMonad m) => GhcMonad m where
+  getSession :: m HscEnv
+  setSession :: HscEnv -> m ()
+
+
+-- | Call the argument with the current session.
+withSession :: GhcMonad m => (HscEnv -> m a) -> m a
+withSession f = getSession >>= f
+
+-- | Grabs the DynFlags from the Session
+getSessionDynFlags :: GhcMonad m => m DynFlags
+getSessionDynFlags = withSession (return . hsc_dflags)
+
+-- | Set the current session to the result of applying the current session to
+-- the argument.
+modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
+modifySession f = do h <- getSession
+                     setSession $! f h
+
+withSavedSession :: GhcMonad m => m a -> m a
+withSavedSession m = do
+  saved_session <- getSession
+  m `gfinally` setSession saved_session
+
+-- | Call an action with a temporarily modified Session.
+withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
+withTempSession f m =
+  withSavedSession $ modifySession f >> m
+
+-- -----------------------------------------------------------------------------
+-- | A monad that allows logging of warnings.
+
+logWarnings :: GhcMonad m => WarningMessages -> m ()
+logWarnings warns = do
+  dflags <- getSessionDynFlags
+  liftIO $ printOrThrowWarnings dflags warns
+
+-- -----------------------------------------------------------------------------
+-- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,
+-- e.g., to maintain additional state consider wrapping this monad or using
+-- 'GhcT'.
+newtype Ghc a = Ghc { unGhc :: Session -> IO a }
+
+-- | The Session is a handle to the complete state of a compilation
+-- session.  A compilation session consists of a set of modules
+-- constituting the current program or library, the context for
+-- interactive evaluation, and various caches.
+data Session = Session !(IORef HscEnv) 
+
+instance Functor Ghc where
+  fmap f m = Ghc $ \s -> f `fmap` unGhc m s
+
+instance Monad Ghc where
+  return a = Ghc $ \_ -> return a
+  m >>= g  = Ghc $ \s -> do a <- unGhc m s; unGhc (g a) s
+
+instance MonadIO Ghc where
+  liftIO ioA = Ghc $ \_ -> ioA
+
+instance ExceptionMonad Ghc where
+  gcatch act handle =
+      Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
+  gblock (Ghc m)   = Ghc $ \s -> gblock (m s)
+  gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
+  gmask f =
+      Ghc $ \s -> gmask $ \io_restore ->
+                             let
+                                g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
+                             in
+                                unGhc (f g_restore) s
+
+instance GhcMonad Ghc where
+  getSession = Ghc $ \(Session r) -> readIORef r
+  setSession s' = Ghc $ \(Session r) -> writeIORef r s'
+
+-- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.
+--
+-- You can use this to call functions returning an action in the 'Ghc' monad
+-- inside an 'IO' action.  This is needed for some (too restrictive) callback
+-- arguments of some library functions:
+--
+-- > libFunc :: String -> (Int -> IO a) -> IO a
+-- > ghcFunc :: Int -> Ghc a
+-- >
+-- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a
+-- > ghcFuncUsingLibFunc str =
+-- >   reifyGhc $ \s ->
+-- >     libFunc $ \i -> do
+-- >       reflectGhc (ghcFunc i) s
+--
+reflectGhc :: Ghc a -> Session -> IO a
+reflectGhc m = unGhc m
+
+-- > Dual to 'reflectGhc'.  See its documentation.
+reifyGhc :: (Session -> IO a) -> Ghc a
+reifyGhc act = Ghc $ act
+
+-- -----------------------------------------------------------------------------
+-- | A monad transformer to add GHC specific features to another monad.
+--
+-- Note that the wrapped monad must support IO and handling of exceptions.
+newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
+liftGhcT :: Monad m => m a -> GhcT m a
+liftGhcT m = GhcT $ \_ -> m
+
+instance Functor m => Functor (GhcT m) where
+  fmap f m = GhcT $ \s -> f `fmap` unGhcT m s
+
+instance Monad m => Monad (GhcT m) where
+  return x = GhcT $ \_ -> return x
+  m >>= k  = GhcT $ \s -> do a <- unGhcT m s; unGhcT (k a) s
+
+instance MonadIO m => MonadIO (GhcT m) where
+  liftIO ioA = GhcT $ \_ -> liftIO ioA
+
+instance ExceptionMonad m => ExceptionMonad (GhcT m) where
+  gcatch act handle =
+      GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
+  gblock (GhcT m) = GhcT $ \s -> gblock (m s)
+  gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
+  gmask f =
+      GhcT $ \s -> gmask $ \io_restore ->
+                           let
+                              g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)
+                           in
+                              unGhcT (f g_restore) s
+
+instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
+  getSession = GhcT $ \(Session r) -> liftIO $ readIORef r
+  setSession s' = GhcT $ \(Session r) -> liftIO $ writeIORef r s'