Replace all uses of ghcError with throwGhcException and purge ghcError.

compiler/ghci/ByteCodeGen.lhs

@@ -1465,7 +1465,7 @@ bcIdUnaryType x = case repType (idType x) of
 -- See bug #1257
 unboxedTupleException :: a
 unboxedTupleException
-   = ghcError
+   = throwGhcException
         (ProgramError
            ("Error: bytecode compiler can't handle unboxed tuples.\n"++
             "  Possibly due to foreign import/export decls in source.\n"++

compiler/ghci/ByteCodeLink.lhs

@@ -240,7 +240,7 @@ lookupIE dflags ie con_nm
 
 linkFail :: String -> String -> IO a
 linkFail who what
-   = ghcError (ProgramError $
+   = throwGhcException (ProgramError $
         unlines [ "",who
                 , "During interactive linking, GHCi couldn't find the following symbol:"
                 , ' ' : ' ' : what

compiler/ghci/LibFFI.hsc

@@ -52,7 +52,7 @@ prepForeignCall dflags cconv arg_types result_type
     let res_ty = primRepToFFIType dflags result_type
     r <- ffi_prep_cif cif abi (fromIntegral n_args) res_ty arg_arr
     if (r /= fFI_OK)
-       then ghcError (InstallationError 
+       then throwGhcException (InstallationError 
                         (printf "prepForeignCallFailed: %d" (show r)))
        else return cif
     

compiler/ghci/Linker.lhs

@@ -172,7 +172,7 @@ getHValue hsc_env name = do
   pls <- modifyPLS $ \pls -> do
            if (isExternalName name) then do
              (pls', ok) <- linkDependencies hsc_env pls noSrcSpan [nameModule name]
-             if (failed ok) then ghcError (ProgramError "")
+             if (failed ok) then throwGhcException (ProgramError "")
                             else return (pls', pls')
             else
              return (pls, pls)
@@ -321,7 +321,7 @@ reallyInitDynLinker dflags =
         ; ok <- resolveObjs
 
         ; if succeeded ok then maybePutStrLn dflags "done"
-          else ghcError (ProgramError "linking extra libraries/objects failed")
+          else throwGhcException (ProgramError "linking extra libraries/objects failed")
 
         ; return pls
         }}
@@ -403,7 +403,7 @@ preloadLib dflags lib_paths framework_paths lib_spec
     preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
     preloadFailed sys_errmsg paths spec
        = do maybePutStr dflags "failed.\n"
-            ghcError $
+            throwGhcException $
               CmdLineError (
                     "user specified .o/.so/.DLL could not be loaded ("
                     ++ sys_errmsg ++ ")\nWhilst trying to load:  "
@@ -455,7 +455,7 @@ linkExpr hsc_env span root_ul_bco
      -- Link the packages and modules required
    ; (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
    ; if failed ok then
-        ghcError (ProgramError "")
+        throwGhcException (ProgramError "")
      else do {
 
      -- Link the expression itself
@@ -480,7 +480,7 @@ linkExpr hsc_env span root_ul_bco
         -- by default, so we can safely ignore them here.
 
 dieWith :: DynFlags -> SrcSpan -> MsgDoc -> IO a
-dieWith dflags span msg = ghcError (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))
+dieWith dflags span msg = throwGhcException (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))
 
 
 checkNonStdWay :: DynFlags -> SrcSpan -> IO Bool
@@ -566,7 +566,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
           mb_iface <- initIfaceCheck hsc_env $
                         loadInterface msg mod (ImportByUser False)
           iface <- case mb_iface of
-                    Maybes.Failed err      -> ghcError (ProgramError (showSDoc dflags err))
+                    Maybes.Failed err      -> throwGhcException (ProgramError (showSDoc dflags err))
                     Maybes.Succeeded iface -> return iface
 
           when (mi_boot iface) $ link_boot_mod_error mod
@@ -594,7 +594,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
 
 
     link_boot_mod_error mod =
-        ghcError (ProgramError (showSDoc dflags (
+        throwGhcException (ProgramError (showSDoc dflags (
             text "module" <+> ppr mod <+>
             text "cannot be linked; it is only available as a boot module")))
 
@@ -677,7 +677,7 @@ linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
     -- Link the packages and modules required
     (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
     if failed ok
-      then ghcError (ProgramError "")
+      then throwGhcException (ProgramError "")
       else do
 
     -- Link the expression itself
@@ -717,7 +717,7 @@ linkModule hsc_env mod = do
   initDynLinker (hsc_dflags hsc_env)
   modifyPLS_ $ \pls -> do
     (pls', ok) <- linkDependencies hsc_env pls noSrcSpan [mod]
-    if (failed ok) then ghcError (ProgramError "could not link module")
+    if (failed ok) then throwGhcException (ProgramError "could not link module")
       else return pls'
 \end{code}
 
@@ -1084,7 +1084,7 @@ linkPackages' dflags new_pks pls = do
              ; return (new_pkg : pkgs') }
 
         | otherwise
-        = ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
+        = throwGhcException (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
 
 
 linkPackage :: DynFlags -> PackageConfig -> IO ()
@@ -1140,7 +1140,7 @@ linkPackage dflags pkg
         maybePutStr dflags "linking ... "
         ok <- resolveObjs
         if succeeded ok then maybePutStrLn dflags "done."
-              else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
+              else throwGhcException (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
 
 -- we have already searched the filesystem; the strings passed to load_dyn
 -- can be passed directly to loadDLL.  They are either fully-qualified
@@ -1151,7 +1151,7 @@ load_dyn :: FilePath -> IO ()
 load_dyn dll = do r <- loadDLL dll
                   case r of
                     Nothing  -> return ()
-                    Just err -> ghcError (CmdLineError ("can't load .so/.DLL for: "
+                    Just err -> throwGhcException (CmdLineError ("can't load .so/.DLL for: "
                                                               ++ dll ++ " (" ++ err ++ ")" ))
 
 loadFrameworks :: Platform -> InstalledPackageInfo_ ModuleName -> IO ()
@@ -1166,7 +1166,7 @@ loadFrameworks platform pkg
     load fw = do  r <- loadFramework fw_dirs fw
                   case r of
                     Nothing  -> return ()
-                    Just err -> ghcError (CmdLineError ("can't load framework: "
+                    Just err -> throwGhcException (CmdLineError ("can't load framework: "
                                                         ++ fw ++ " (" ++ err ++ ")" ))
 
 -- Try to find an object file for a given library in the given paths.

compiler/iface/BinIface.hs

@@ -98,7 +98,7 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
         errorOnMismatch what wanted got =
             -- This will be caught by readIface which will emit an error
             -- msg containing the iface module name.
-            when (wanted /= got) $ ghcError $ ProgramError
+            when (wanted /= got) $ throwGhcException $ ProgramError
                          (what ++ " (wanted " ++ show wanted
                                ++ ", got "    ++ show got ++ ")")
     bh <- Binary.readBinMem hi_path

compiler/iface/LoadIface.lhs

@@ -166,7 +166,7 @@ loadInterfaceWithException doc mod_name where_from
   = do  { mb_iface <- loadInterface doc mod_name where_from
         ; dflags <- getDynFlags
         ; case mb_iface of 
-            Failed err      -> ghcError (ProgramError (showSDoc dflags err))
+            Failed err      -> throwGhcException (ProgramError (showSDoc dflags err))
             Succeeded iface -> return iface }
 
 ------------------

compiler/iface/MkIface.lhs

@@ -829,7 +829,7 @@ oldMD5 dflags bh = do
   let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
   r <- system cmd
   case r of
-    ExitFailure _ -> ghcError (PhaseFailed cmd r)
+    ExitFailure _ -> throwGhcException (PhaseFailed cmd r)
     ExitSuccess -> do
         hash_str <- readFile tmp2
         return $! readHexFingerprint hash_str

compiler/main/DriverMkDepend.hs

@@ -65,7 +65,7 @@ doMkDependHS srcs = do
     _ <- GHC.setSessionDynFlags dflags
 
     when (null (depSuffixes dflags)) $
-        ghcError (ProgramError "You must specify at least one -dep-suffix")
+        throwGhcException (ProgramError "You must specify at least one -dep-suffix")
 
     files <- liftIO $ beginMkDependHS dflags
 
@@ -193,7 +193,7 @@ processDeps :: DynFlags
 
 processDeps dflags _ _ _ _ (CyclicSCC nodes)
   =     -- There shouldn't be any cycles; report them
-    ghcError (ProgramError (showSDoc dflags $ GHC.cyclicModuleErr nodes))
+    throwGhcException (ProgramError (showSDoc dflags $ GHC.cyclicModuleErr nodes))
 
 processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node)
   = do  { let extra_suffixes = depSuffixes dflags

compiler/main/DriverPipeline.hs

@@ -430,7 +430,7 @@ compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
 compileFile hsc_env stop_phase (src, mb_phase) = do
    exists <- doesFileExist src
    when (not exists) $
-        ghcError (CmdLineError ("does not exist: " ++ src))
+        throwGhcException (CmdLineError ("does not exist: " ++ src))
 
    let
         dflags = hsc_dflags hsc_env
@@ -526,7 +526,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
   -- before B in a normal compilation pipeline.
 
   when (not (start_phase `happensBefore` stop_phase)) $
-        ghcError (UsageError
+        throwGhcException (UsageError
                     ("cannot compile this file to desired target: "
                        ++ input_fn))
 
@@ -1813,7 +1813,7 @@ linkBinary dflags o_files dep_packages = do
     -- parallel only: move binary to another dir -- HWL
     success <- runPhase_MoveBinary dflags output_fn
     if success then return ()
-               else ghcError (InstallationError ("cannot move binary"))
+               else throwGhcException (InstallationError ("cannot move binary"))
 
 
 exeFileName :: DynFlags -> FilePath

compiler/main/DynFlags.hs

@@ -1573,7 +1573,7 @@ parseDynLibLoaderMode f d =
  case splitAt 8 f of
    ("deploy", "")       -> d{ dynLibLoader = Deployable }
    ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }
-   _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
+   _                    -> throwGhcException (CmdLineError ("Unknown dynlib loader: " ++ f))
 
 setDumpPrefixForce f d = d { dumpPrefixForce = f}
 
@@ -1728,7 +1728,7 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
 
   let ((leftover, errs, warns), dflags1)
           = runCmdLine (processArgs activeFlags args') dflags0
-  when (not (null errs)) $ ghcError $ errorsToGhcException errs
+  when (not (null errs)) $ throwGhcException $ errorsToGhcException errs
 
   -- check for disabled flags in safe haskell
   let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1
@@ -1742,7 +1742,7 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
                 }
 
   unless (allowed_combination theWays) $
-      ghcError (CmdLineError ("combination not supported: "  ++
+      throwGhcException (CmdLineError ("combination not supported: "  ++
                               intercalate "/" (map wayDesc theWays)))
 
   let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
@@ -3273,7 +3273,7 @@ makeDynFlagsConsistent dflags
       then let dflags' = dflags { hscTarget = HscAsm }
                warn = "Using native code generator rather than LLVM, as LLVM is incompatible with -fPIC and -dynamic on this platform"
            in loop dflags' warn
-      else ghcError $ CmdLineError "Can't use -fPIC or -dynamic on this platform"
+      else throwGhcException $ CmdLineError "Can't use -fPIC or -dynamic on this platform"
  | os == OSDarwin &&
    arch == ArchX86_64 &&
    not (gopt Opt_PIC dflags)

compiler/main/GHC.hs

@@ -1297,7 +1297,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
              err -> noModError dflags noSrcSpan mod_name err
 
 modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a
-modNotLoadedError dflags m loc = ghcError $ CmdLineError $ showSDoc dflags $
+modNotLoadedError dflags m loc = throwGhcException $ CmdLineError $ showSDoc dflags $
    text "module is not loaded:" <+> 
    quotes (ppr (moduleName m)) <+>
    parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))

compiler/main/GhcMake.hs

@@ -952,7 +952,7 @@ topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
             -- the full set of nodes, and determining the reachable set from
             -- the specified node.
             let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
-                     | otherwise = ghcError (ProgramError "module does not exist")
+                     | otherwise = throwGhcException (ProgramError "module does not exist")
             in graphFromEdgedVertices (seq root (reachableG graph root))
 
 type SummaryNode = (ModSummary, Int, [Int])
@@ -1425,7 +1425,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
                 | otherwise                     = False
 
         when needs_preprocessing $
-           ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
+           throwGhcException (ProgramError "buffer needs preprocesing; interactive check disabled")
 
         return (dflags', src_fn, buf)
 

compiler/main/InteractiveEval.hs

@@ -468,7 +468,7 @@ resume canLogSpan step
        resume = ic_resume ic
 
    case resume of
-     [] -> ghcError (ProgramError "not stopped at a breakpoint")
+     [] -> throwGhcException (ProgramError "not stopped at a breakpoint")
      (r:rs) -> do
         -- unbind the temporary locals by restoring the TypeEnv from
         -- before the breakpoint, and drop this Resume from the
@@ -525,16 +525,16 @@ moveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan)
 moveHist fn = do
   hsc_env <- getSession
   case ic_resume (hsc_IC hsc_env) of
-     [] -> ghcError (ProgramError "not stopped at a breakpoint")
+     [] -> throwGhcException (ProgramError "not stopped at a breakpoint")
      (r:rs) -> do
         let ix = resumeHistoryIx r
             history = resumeHistory r
             new_ix = fn ix
         --
         when (new_ix > length history) $
-           ghcError (ProgramError "no more logged breakpoints")
+           throwGhcException (ProgramError "no more logged breakpoints")
         when (new_ix < 0) $
-           ghcError (ProgramError "already at the beginning of the history")
+           throwGhcException (ProgramError "already at the beginning of the history")
 
         let
           update_ic apStack mb_info = do
@@ -816,7 +816,7 @@ setContext imports
        ; let dflags = hsc_dflags hsc_env
        ; all_env_err <- liftIO $ findGlobalRdrEnv hsc_env imports
        ; case all_env_err of
-           Left (mod, err) -> ghcError (formatError dflags mod err)
+           Left (mod, err) -> throwGhcException (formatError dflags mod err)
            Right all_env -> do {
        ; let old_ic        = hsc_IC hsc_env
              final_rdr_env = ic_tythings old_ic `icPlusGblRdrEnv` all_env

compiler/main/Packages.lhs

@@ -230,14 +230,14 @@ readPackageConfig dflags conf_file = do
        else do
             isfile <- doesFileExist conf_file
             when (not isfile) $
-              ghcError $ InstallationError $
+              throwGhcException $ InstallationError $
                 "can't find a package database at " ++ conf_file
             debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
             str <- readFile conf_file
             case reads str of
                 [(configs, rest)]
                     | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs)
-                _ -> ghcError $ InstallationError $
+                _ -> throwGhcException $ InstallationError $
                         "invalid package database file " ++ conf_file
 
   let
@@ -410,12 +410,12 @@ packageFlagErr :: DynFlags
 -- for missing DPH package we emit a more helpful error message, because
 -- this may be the result of using -fdph-par or -fdph-seq.
 packageFlagErr dflags (ExposePackage pkg) [] | is_dph_package pkg
-  = ghcError (CmdLineError (showSDoc dflags $ dph_err))
+  = throwGhcException (CmdLineError (showSDoc dflags $ dph_err))
   where dph_err = text "the " <> text pkg <> text " package is not installed."
                   $$ text "To install it: \"cabal install dph\"."
         is_dph_package pkg = "dph" `isPrefixOf` pkg
 
-packageFlagErr dflags flag reasons = ghcError (CmdLineError (showSDoc dflags $ err))
+packageFlagErr dflags flag reasons = throwGhcException (CmdLineError (showSDoc dflags $ err))
   where err = text "cannot satisfy " <> ppr_flag <>
                 (if null reasons then empty else text ": ") $$
               nest 4 (ppr_reasons $$
@@ -983,7 +983,7 @@ closeDeps dflags pkg_map ipid_map ps
 throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
 throwErr dflags m
               = case m of
-                Failed e    -> ghcError (CmdLineError (showSDoc dflags e))
+                Failed e    -> throwGhcException (CmdLineError (showSDoc dflags e))
                 Succeeded r -> return r
 
 closeDepsErr :: PackageConfigMap
@@ -1017,7 +1017,7 @@ add_package pkg_db ipid_map ps (p, mb_parent)
 
 missingPackageErr :: DynFlags -> String -> IO a
 missingPackageErr dflags p
-    = ghcError (CmdLineError (showSDoc dflags (missingPackageMsg p)))
+    = throwGhcException (CmdLineError (showSDoc dflags (missingPackageMsg p)))
 
 missingPackageMsg :: String -> SDoc
 missingPackageMsg p = ptext (sLit "unknown package:") <+> text p

compiler/main/StaticFlagParser.hs

@@ -57,10 +57,10 @@ parseStaticFlagsFull :: [Flag IO] -> [Located String]
                      -> IO ([Located String], [Located String])
 parseStaticFlagsFull flagsAvailable args = do
   ready <- readIORef v_opt_C_ready
-  when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
+  when ready $ throwGhcException (ProgramError "Too late for parseStaticFlags: call it before newSession")
 
   (leftover, errs, warns) <- processArgs flagsAvailable args
-  when (not (null errs)) $ ghcError $ errorsToGhcException errs
+  when (not (null errs)) $ throwGhcException $ errorsToGhcException errs
 
     -- see sanity code in staticOpts
   writeIORef v_opt_C_ready True
@@ -129,7 +129,7 @@ decodeSize str
   | c == "K" || c == "k" = truncate (n * 1000)
   | c == "M" || c == "m" = truncate (n * 1000 * 1000)
   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
-  | otherwise            = ghcError (CmdLineError ("can't decode size: " ++ str))
+  | otherwise            = throwGhcException (CmdLineError ("can't decode size: " ++ str))
   where (m, c) = span pred str
         n      = readRational m
         pred c = isDigit c || c == '.'

compiler/main/StaticFlags.hs

@@ -135,7 +135,7 @@ try_read :: Read a => String -> String -> a
 try_read sw str
   = case reads str of
 	((x,_):_) -> x	-- Be forgiving: ignore trailing goop, and alternative parses
-	[]	  -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
+	[]	  -> throwGhcException (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
 			-- ToDo: hack alert. We should really parse the arguments
 			-- 	 and announce errors in a more civilised way.
 -}

compiler/main/SysTools.lhs

@@ -353,7 +353,7 @@ findTopDir Nothing
          maybe_exec_dir <- getBaseDir
          case maybe_exec_dir of
              -- "Just" on Windows, "Nothing" on unix
-             Nothing  -> ghcError (InstallationError "missing -B<dir> option")
+             Nothing  -> throwGhcException (InstallationError "missing -B<dir> option")
              Just dir -> return dir
 \end{code}
 
@@ -830,14 +830,14 @@ handleProc pgm phase_name proc = do
         -- the case of a missing program there will otherwise be no output
         -- at all.
        | n == 127  -> does_not_exist
-       | otherwise -> ghcError (PhaseFailed phase_name rc)
+       | otherwise -> throwGhcException (PhaseFailed phase_name rc)
   where
     handler err =
        if IO.isDoesNotExistError err
           then does_not_exist
           else IO.ioError err
 
-    does_not_exist = ghcError (InstallationError ("could not execute: " ++ pgm))
+    does_not_exist = throwGhcException (InstallationError ("could not execute: " ++ pgm))
 
 
 builderMainLoop :: DynFlags -> (String -> String) -> FilePath
@@ -969,7 +969,7 @@ traceCmd dflags phase_name cmd_line action
   where
     handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
                               ; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
-                              ; ghcError (PhaseFailed phase_name (ExitFailure 1)) }
+                              ; throwGhcException (PhaseFailed phase_name (ExitFailure 1)) }
 \end{code}
 
 %************************************************************************

compiler/utils/Panic.lhs

@@ -10,7 +10,7 @@ some unnecessary loops in the module dependency graph.
 \begin{code}
 module Panic (
      GhcException(..), showGhcException, throwGhcException, handleGhcException,
-     ghcError, progName,
+     progName,
      pgmError,
 
      panic, sorry, panicFastInt, assertPanic, trace,
@@ -173,10 +173,6 @@ showGhcException exception
                 ExitFailure x -> x
 
 
--- | Alias for `throwGhcException`
-ghcError :: GhcException -> a
-ghcError e = Exception.throw e
-
 throwGhcException :: GhcException -> a
 throwGhcException = Exception.throw
 

ghc/GhciTags.hs

@@ -82,7 +82,7 @@ listModuleTags m = do
   -- should we just skip these?
   when (not is_interpreted) $
     let mName = GHC.moduleNameString (GHC.moduleName m) in
-    ghcError (CmdLineError ("module '" ++ mName ++ "' is not interpreted"))
+    throwGhcException (CmdLineError ("module '" ++ mName ++ "' is not interpreted"))
   mbModInfo <- GHC.getModuleInfo m
   case mbModInfo of
     Nothing -> return []
@@ -148,7 +148,7 @@ collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
   tryIO (writeFile file $ concat tagGroups)
 
   where
-    processGroup [] = ghcError (CmdLineError "empty tag file group??")
+    processGroup [] = throwGhcException (CmdLineError "empty tag file group??")
     processGroup group@(tagInfo:_) =
       let tags = unlines $ map showETag group in
       "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags
@@ -160,7 +160,7 @@ makeTagGroupsWithSrcInfo tagInfos = do
   mapM addTagSrcInfo groups
 
   where
-    addTagSrcInfo [] = ghcError (CmdLineError "empty tag file group??")
+    addTagSrcInfo [] = throwGhcException (CmdLineError "empty tag file group??")
     addTagSrcInfo group@(tagInfo:_) = do
       file <- readFile $tagFile tagInfo
       let sortedGroup = sortBy (comparing tagLine) group
@@ -200,5 +200,5 @@ showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo,
     ++ "\x7f" ++ tag
     ++ "\x01" ++ show lineNo
     ++ "," ++ show charPos
-showETag _ = ghcError (CmdLineError "missing source file info in showETag")
+showETag _ = throwGhcException (CmdLineError "missing source file info in showETag")
 

ghc/InteractiveUI.hs

@@ -341,7 +341,7 @@ interactiveUI config srcs maybe_exprs = do
    -- this up front and emit a helpful error message (#2197)
    i <- liftIO $ isProfiled
    when (i /= 0) $
-     ghcError (InstallationError "GHCi cannot be used when compiled with -prof")
+     throwGhcException (InstallationError "GHCi cannot be used when compiled with -prof")
 
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
@@ -1007,7 +1007,7 @@ help _ = do
 -- :info
 
 info :: String -> InputT GHCi ()
-info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
+info "" = throwGhcException (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 info s  = handleSourceError GHC.printException $ do
     unqual <- GHC.getPrintUnqual
     dflags <- getDynFlags
@@ -1105,7 +1105,7 @@ editFile str =
      st <- lift getGHCiState
      let cmd = editor st
      when (null cmd)
-       $ ghcError (CmdLineError "editor not set, use :set editor")
+       $ throwGhcException (CmdLineError "editor not set, use :set editor")
      code <- liftIO $ system (cmd ++ ' ':file)
      when (code == ExitSuccess)
        $ reloadModule ""
@@ -1137,7 +1137,7 @@ chooseEditFile =
          do targets <- GHC.getTargets
             case msum (map fromTarget targets) of
               Just file -> return file
-              Nothing   -> ghcError (CmdLineError "No files to edit.")
+              Nothing   -> throwGhcException (CmdLineError "No files to edit.")
 
   where fromTarget (GHC.Target (GHC.TargetFile f _) _ _) = Just f
         fromTarget _ = Nothing -- when would we get a module target?
@@ -1160,7 +1160,7 @@ defineMacro overwrite s = do
                                       unlines defined)
         else do
   if (not overwrite && macro_name `elem` defined)
-        then ghcError (CmdLineError
+        then throwGhcException (CmdLineError
                 ("macro '" ++ macro_name ++ "' is already defined"))
         else do
 
@@ -1195,7 +1195,7 @@ undefineMacro str = mapM_ undef (words str)
  where undef macro_name = do
         cmds <- liftIO (readIORef macros_ref)
         if (macro_name `notElem` map cmdName cmds)
-           then ghcError (CmdLineError
+           then throwGhcException (CmdLineError
                 ("macro '" ++ macro_name ++ "' is not defined"))
            else do
             liftIO (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
@@ -1438,14 +1438,14 @@ scriptCmd :: String -> InputT GHCi ()
 scriptCmd ws = do
   case words ws of
     [s]    -> runScript s
-    _      -> ghcError (CmdLineError "syntax:  :script <filename>")
+    _      -> throwGhcException (CmdLineError "syntax:  :script <filename>")
 
 runScript :: String    -- ^ filename
            -> InputT GHCi ()
 runScript filename = do
   either_script <- liftIO $ tryIO (openFile filename ReadMode)
   case either_script of
-    Left _err    -> ghcError (CmdLineError $ "IO error:  \""++filename++"\" "
+    Left _err    -> throwGhcException (CmdLineError $ "IO error:  \""++filename++"\" "
                       ++(ioeGetErrorString _err))
     Right script -> do
       st <- lift $ getGHCiState
@@ -1477,18 +1477,18 @@ isSafeCmd m =
             isSafeModule md
         [] -> do md <- guessCurrentModule "issafe"
                  isSafeModule md
-        _ -> ghcError (CmdLineError "syntax:  :issafe <module>")
+        _ -> throwGhcException (CmdLineError "syntax:  :issafe <module>")
 
 isSafeModule :: Module -> InputT GHCi ()
 isSafeModule m = do
     mb_mod_info <- GHC.getModuleInfo m
     when (isNothing mb_mod_info)
-         (ghcError $ CmdLineError $ "unknown module: " ++ mname)
+         (throwGhcException $ CmdLineError $ "unknown module: " ++ mname)
 
     dflags <- getDynFlags
     let iface = GHC.modInfoIface $ fromJust mb_mod_info
     when (isNothing iface)
-         (ghcError $ CmdLineError $ "can't load interface file for module: " ++
+         (throwGhcException $ CmdLineError $ "can't load interface file for module: " ++
                                     (GHC.moduleNameString $ GHC.moduleName m))
 
     (msafe, pkgs) <- GHC.moduleTrustReqs m
@@ -1538,7 +1538,7 @@ browseCmd bang m =
         browseModule bang md True
     [] -> do md <- guessCurrentModule ("browse" ++ if bang then "!" else "")
              browseModule bang md True
-    _ -> ghcError (CmdLineError "syntax:  :browse <module>")
+    _ -> throwGhcException (CmdLineError "syntax:  :browse <module>")
 
 guessCurrentModule :: String -> InputT GHCi Module
 -- Guess which module the user wants to browse.  Pick
@@ -1546,7 +1546,7 @@ guessCurrentModule :: String -> InputT GHCi Module
 -- recently-added module occurs last, it seems.
 guessCurrentModule cmd
   = do imports <- GHC.getContext
-       when (null imports) $ ghcError $
+       when (null imports) $ throwGhcException $
           CmdLineError (':' : cmd ++ ": no current module")
        case (head imports) of
           IIModule m -> GHC.findModule m Nothing
@@ -1563,7 +1563,7 @@ browseModule bang modl exports_only = do
 
   mb_mod_info <- GHC.getModuleInfo modl
   case mb_mod_info of
-    Nothing -> ghcError (CmdLineError ("unknown module: " ++
+    Nothing -> throwGhcException (CmdLineError ("unknown module: " ++
                                 GHC.moduleNameString (GHC.moduleName modl)))
     Just mod_info -> do
         dflags <- getDynFlags
@@ -1641,7 +1641,7 @@ browseModule bang modl exports_only = do
 moduleCmd :: String -> GHCi ()
 moduleCmd str
   | all sensible strs = cmd
-  | otherwise = ghcError (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
+  | otherwise = throwGhcException (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
   where
     (cmd, strs) =
         case str of
@@ -1742,7 +1742,7 @@ checkAdd ii = do
   let safe = safeLanguageOn dflags
   case ii of
     IIModule modname
-       | safe -> ghcError $ CmdLineError "can't use * imports with Safe Haskell"
+       | safe -> throwGhcException $ CmdLineError "can't use * imports with Safe Haskell"
        | otherwise -> wantInterpretedModuleName modname >> return ()
 
     IIDecl d -> do
@@ -1751,7 +1751,7 @@ checkAdd ii = do
        m <- GHC.lookupModule modname pkgqual
        when safe $ do
            t <- GHC.isModuleTrusted m
-           when (not t) $ ghcError $ ProgramError $ ""
+           when (not t) $ throwGhcException $ ProgramError $ ""