Re-export Located(..) and related functions

[ghc-hetmet.git] / compiler / main / HscTypes.lhs

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 83dda3f..cb41de5 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -13,7 +13,7 @@ module HscTypes (
         ioMsgMaybe, ioMsg,
         logWarnings, clearWarnings, hasWarnings,
         SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
-        handleSourceError,
+        throwOneError, handleSourceError,
         reflectGhc, reifyGhc,
 
        -- * Sessions and compilation state
@@ -143,15 +143,10 @@ import FastString
 import StringBuffer    ( StringBuffer )
 import Fingerprint
 import MonadUtils
-import Bag              ( emptyBag, unionBags, isEmptyBag )
 import Data.Dynamic     ( Typeable )
 import qualified Data.Dynamic as Dyn
-#if __GLASGOW_HASKELL__ < 609
-import Data.Dynamic     ( toDyn, fromDyn, fromDynamic )
-#else
-import Bag              ( bagToList )
-#endif
-import ErrUtils         ( ErrorMessages, WarningMessages, Messages )
+import Bag
+import ErrUtils
 
 import System.FilePath
 import System.Time     ( ClockTime )
@@ -181,7 +176,8 @@ mkSrcErr :: ErrorMessages -> SourceError
 srcErrorMessages :: SourceError -> ErrorMessages
 mkApiErr :: SDoc -> GhcApiError
 
-#if __GLASGOW_HASKELL__ >= 609
+throwOneError :: MonadIO m => ErrMsg -> m ab
+throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
 
 -- | A source error is an error that is caused by one or more errors in the
 -- source code.  A 'SourceError' is thrown by many functions in the
@@ -242,43 +238,6 @@ instance Exception GhcApiError
 
 mkApiErr = GhcApiError
 
-#else
-------------------------------------------------------------------------
--- implementation for bootstrapping without extensible exceptions
-
-data SourceException = SourceException ErrorMessages
-sourceExceptionTc :: Dyn.TyCon
-sourceExceptionTc = Dyn.mkTyCon "SourceException"
-{-# NOINLINE sourceExceptionTc #-}
-instance Typeable SourceException where
-  typeOf _ = Dyn.mkTyConApp sourceExceptionTc []
-
--- Source error has to look like a normal exception.  Throwing a DynException
--- directly would not allow us to use the Exception monad.  We also cannot
--- make it part of GhcException as that would lead to circular imports.
-
-type SourceError = Exception
-type GhcApiError = Exception
-
-mkSrcErr msgs = DynException . toDyn $ SourceException msgs
-
-mkApiErr = IOException . userError . showSDoc
-
-srcErrorMessages (DynException ms) =
-    let SourceException msgs = (fromDyn ms (panic "SourceException expected"))
-    in msgs
-srcErrorMessages _ = panic "SourceError expected"
-
-handleSourceError :: ExceptionMonad m => (Exception -> m a) -> m a -> m a
-handleSourceError handler act =
-  gcatch act
-         (\e -> case e of
-                  DynException dyn
-                    | Just (SourceException _) <- fromDynamic dyn
-                        -> handler e
-                  _ -> throw e)
-#endif
-
 -- | A monad that allows logging of warnings.
 class Monad m => WarnLogMonad m where
   setWarnings  :: WarningMessages -> m ()
@@ -345,10 +304,9 @@ instance MonadIO Ghc where
 instance ExceptionMonad Ghc where
   gcatch act handle =
       Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
-#if __GLASGOW_HASKELL__ < 609
-  gcatchDyn act handler =
-      Ghc $ \s -> unGhc act s `gcatchDyn` \e -> unGhc (handler e) s
-#endif
+  gblock (Ghc m)   = Ghc $ \s -> gblock (m s)
+  gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
+
 instance WarnLogMonad Ghc where
   setWarnings warns = Ghc $ \(Session _ wref) -> writeIORef wref warns
   -- | Return 'Warnings' accumulated so far.
@@ -378,9 +336,8 @@ instance MonadIO m => MonadIO (GhcT m) where
 instance ExceptionMonad m => ExceptionMonad (GhcT m) where
   gcatch act handle =
       GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
-#if __GLASGOW_HASKELL__ < 609
-  gcatchDyn _act _handler = error "cannot use GhcT in stage1"
-#endif
+  gblock (GhcT m) = GhcT $ \s -> gblock (m s)
+  gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
 
 instance MonadIO m => WarnLogMonad (GhcT m) where
   setWarnings warns = GhcT $ \(Session _ wref) -> liftIO $ writeIORef wref warns
@@ -413,7 +370,7 @@ ioMsgMaybe ioA = do
   ((warns,errs), mb_r) <- liftIO ioA
   logWarnings warns
   case mb_r of
-    Nothing -> throw (mkSrcErr errs)
+    Nothing -> liftIO $ throwIO (mkSrcErr errs)
     Just r  -> ASSERT( isEmptyBag errs ) return r
 
 -- | Lift a non-failing IO action into a 'GhcMonad'.
@@ -542,9 +499,11 @@ hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
 -- is for use in an IDE where the file hasn't been saved by
 -- the user yet).
 data Target = Target
-      TargetId                          -- module or filename
-      Bool                              -- object code allowed?
-      (Maybe (StringBuffer,ClockTime))  -- in-memory text buffer?
+      { targetId           :: TargetId  -- ^ module or filename
+      , targetAllowObjCode :: Bool      -- ^ object code allowed?
+      , targetContents     :: Maybe (StringBuffer,ClockTime)
+                                        -- ^ in-memory text buffer?
+      }
 
 data TargetId
   = TargetModule ModuleName