replace several 'fromJust's with 'expectJust's

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

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index 6f6b7c8..29e2c66 100644 (file)
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -11,7 +11,7 @@ module GHC (
        Session,
        defaultErrorHandler,
        defaultCleanupHandler,
-       init,
+       init, initFromArgs,
        newSession,
 
        -- * Flags and settings
@@ -234,7 +234,7 @@ import Maybes               ( expectJust, mapCatMaybes )
 
 import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist )
-import Data.Maybe      ( isJust, isNothing, fromJust )
+import Data.Maybe      ( isJust, isNothing )
 import Data.List       ( partition, nub )
 import qualified Data.List as List
 import Control.Monad   ( unless, when )
@@ -308,24 +308,32 @@ defaultCleanupHandler dflags inner =
 
 
 -- | Initialises GHC.  This must be done /once/ only.  Takes the
--- command-line arguments.  All command-line arguments which aren't
--- understood by GHC will be returned.
+-- TopDir path without the '-B' prefix.
 
-init :: [String] -> IO [String]
-init args = do
+init :: Maybe String -> IO ()
+init mbMinusB = do
    -- catch ^C
    main_thread <- myThreadId
    putMVar interruptTargetThread [main_thread]
    installSignalHandlers
 
-   -- Grab the -B option if there is one
-   let (minusB_args, argv1) = partition (prefixMatch "-B") args
-   dflags0 <- initSysTools minusB_args defaultDynFlags
+   dflags0 <- initSysTools mbMinusB defaultDynFlags
    writeIORef v_initDynFlags dflags0
 
-   -- Parse the static flags
-   argv2 <- parseStaticFlags argv1
-   return argv2
+-- | Initialises GHC. This must be done /once/ only. Takes the
+-- command-line arguments.  All command-line arguments which aren't
+-- understood by GHC will be returned.
+
+initFromArgs :: [String] -> IO [String]
+initFromArgs args
+    = do init mbMinusB
+         return argv1
+    where -- Grab the -B option if there is one
+          (minusB_args, argv1) = partition (prefixMatch "-B") args
+          mbMinusB | null minusB_args
+                       = Nothing
+                   | otherwise
+                       = Just (drop 2 (last minusB_args))
 
 GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags)
        -- stores the DynFlags between the call to init and subsequent
@@ -722,13 +730,10 @@ data CheckedModule =
        --  fields within CheckedModule.
 
 type ParsedSource      = Located (HsModule RdrName)
-type RenamedSource     = HsGroup Name
+type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name])
 type TypecheckedSource = LHsBinds Id
 
 -- NOTE:
---   - things that aren't in the output of the renamer:
---     - the export list
---     - the imports
 --   - things that aren't in the output of the typechecker right now:
 --     - the export list
 --     - the imports
@@ -763,7 +768,7 @@ checkModule session@(Session ref) mod = do
           -- ml_hspp_file field, say
           let dflags0 = hsc_dflags hsc_env
               hspp_buf = expectJust "GHC.checkModule" (ms_hspp_buf ms)
-              filename = fromJust (ml_hs_file (ms_location ms))
+              filename = expectJust "checkModule" (ml_hs_file (ms_location ms))
               opts = getOptionsFromStringBuffer hspp_buf filename
           (dflags1,leftovers) <- parseDynamicFlags dflags0 (map snd opts)
           if (not (null leftovers))
@@ -1441,7 +1446,7 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
 findSummaryBySourceFile summaries file
   = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
-                                fromJust (ml_hs_file (ms_location ms)) == file ] of
+                                expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
        [] -> Nothing
        (x:xs) -> Just x
 
@@ -2060,6 +2065,6 @@ showModule s mod_summary = withSession s $ \hsc_env -> do
        Nothing       -> panic "missing linkable"
        Just mod_info -> return (showModMsg obj_linkable mod_summary)
                      where
-                        obj_linkable = isObjectLinkable (fromJust (hm_linkable mod_info))
+                        obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
 
 #endif /* GHCI */