Re-export Located(..) and related functions

[ghc-hetmet.git] / compiler / main / GHC.hs

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 3d8ade9..3a1cfe5 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -196,6 +196,20 @@ module GHC (
         srcSpanStartLine, srcSpanEndLine, 
         srcSpanStartCol, srcSpanEndCol,
 
+        -- ** Located
+       Located(..),
+
+       -- *** Constructing Located
+       noLoc, mkGeneralLocated,
+
+       -- *** Deconstructing Located
+       getLoc, unLoc,
+
+       -- *** Combining and comparing Located values
+       eqLocated, cmpLocated, combineLocs, addCLoc,
+        leftmost_smallest, leftmost_largest, rightmost,
+        spans, isSubspanOf,
+
        -- * Exceptions
        GhcException(..), showGhcException,
 
@@ -328,13 +342,6 @@ defaultErrorHandler dflags inner =
            exitWith (ExitFailure 1)
          ) $
 
-  -- program errors: messages with locations attached.  Sometimes it is
-  -- convenient to just throw these as exceptions.
-  handleErrMsg
-            (\em -> liftIO $ do
-                      printBagOfErrors dflags (unitBag em)
-                      exitWith (ExitFailure 1)) $
-
   -- error messages propagated as exceptions
   handleGhcException
             (\ge -> liftIO $ do
@@ -998,17 +1005,18 @@ type TypecheckedSource = LHsBinds Id
 -- | Return the 'ModSummary' of a module with the given name.
 --
 -- The module must be part of the module graph (see 'hsc_mod_graph' and
--- 'ModuleGraph').  If this is not the case, this function will throw an
+-- 'ModuleGraph').  If this is not the case, this function will throw a
 -- 'GhcApiError'.
 --
--- Note that the module graph may contain several 'ModSummary's matching the
--- same name (for example both a @.hs@ and a @.hs-boot@).
+-- This function ignores boot modules and requires that there is only one
+-- non-boot module with the given name.
 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
 getModSummary mod = do
    mg <- liftM hsc_mod_graph getSession
-   case [ ms | ms <- mg, ms_mod_name ms == mod ] of
+   case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
      [] -> throw $ mkApiErr (text "Module not part of module graph")
-     (ms:_) -> return ms
+     [ms] -> return ms
+     multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
 
 -- | Parse a module.
 --
@@ -1863,7 +1871,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
                if exists 
                    then summariseFile hsc_env old_summaries file mb_phase 
                                        obj_allowed maybe_buf
-                   else throwErrMsg $ mkPlainErrMsg noSrcSpan $
+                   else throwOneError $ mkPlainErrMsg noSrcSpan $
                           text "can't find file:" <+> text file
        getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
           = do maybe_summary <- summariseModule hsc_env old_summary_map False 
@@ -2127,7 +2135,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
         (srcimps, the_imps, L mod_loc mod_name) <- liftIO $ getImports dflags' buf hspp_fn src_fn
 
        when (mod_name /= wanted_mod) $
-               throwErrMsg $ mkPlainErrMsg mod_loc $ 
+               throwOneError $ mkPlainErrMsg mod_loc $ 
                              text "File name does not match module name:" 
                              $$ text "Saw:" <+> quotes (ppr mod_name)
                               $$ text "Expected:" <+> quotes (ppr wanted_mod)
@@ -2203,21 +2211,21 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
 -- ToDo: we don't have a proper line number for this error
 noModError dflags loc wanted_mod err
-  = throwErrMsg $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
+  = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
                                
-noHsFileErr :: SrcSpan -> String -> a
+noHsFileErr :: GhcMonad m => SrcSpan -> String -> m a
 noHsFileErr loc path
-  = throwErrMsg $ mkPlainErrMsg loc $ text "Can't find" <+> text path
+  = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
  
-packageModErr :: ModuleName -> a
+packageModErr :: GhcMonad m => ModuleName -> m a
 packageModErr mod
-  = throwErrMsg $ mkPlainErrMsg noSrcSpan $
+  = throwOneError $ mkPlainErrMsg noSrcSpan $
        text "module" <+> quotes (ppr mod) <+> text "is a package module"
 
 multiRootsErr :: [ModSummary] -> IO ()
 multiRootsErr [] = panic "multiRootsErr"
 multiRootsErr summs@(summ1:_)
-  = throwErrMsg $ mkPlainErrMsg noSrcSpan $
+  = throwOneError $ mkPlainErrMsg noSrcSpan $
        text "module" <+> quotes (ppr mod) <+> 
        text "is defined in multiple files:" <+>
        sep (map text files)