replace several 'fromJust's with 'expectJust's

diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs
index 2f15ee3..f76ac41 100644 (file)
--- a/ghc/compiler/iface/MkIface.lhs
+++ b/ghc/compiler/iface/MkIface.lhs
@@ -234,7 +234,7 @@ import DATA_IOREF   ( writeIORef )
 import Monad           ( when )
 import List            ( insert )
 import Maybes          ( orElse, mapCatMaybes, isNothing, isJust, 
-                         fromJust, expectJust, MaybeErr(..) )
+                         expectJust, MaybeErr(..) )
 \end{code}
 
 
@@ -321,7 +321,7 @@ mkIface hsc_env maybe_old_iface
 
                -- Debug printing
        ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags) 
-              (printDump (fromJust pp_orphs))
+              (printDump (expectJust "mkIface" pp_orphs))
        ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
        ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
                        (pprModIface new_iface)
@@ -896,7 +896,7 @@ checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
        -- CHECK EXPORT LIST
     if checkExportList maybe_old_export_vers new_export_vers then
        out_of_date_vers (ptext SLIT("  Export list changed"))
-                        (fromJust maybe_old_export_vers) 
+                        (expectJust "checkModUsage" maybe_old_export_vers) 
                         new_export_vers
     else
 

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index d1d1e78..29e2c66 100644 (file)
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -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 )
@@ -768,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))
@@ -1446,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
 
@@ -2065,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 */

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 48041c0..c542d34 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -94,7 +94,7 @@ import IfaceSyn               ( IfaceInst, IfaceRule, IfaceDecl(ifName) )
 
 import FiniteMap       ( FiniteMap )
 import CoreSyn         ( CoreRule )
-import Maybes          ( orElse, fromJust, expectJust )
+import Maybes          ( orElse, expectJust, expectJust )
 import Outputable
 import SrcLoc          ( SrcSpan, Located )
 import UniqSupply      ( UniqSupply )
@@ -277,7 +277,7 @@ hptRules hsc_env deps
 
        -- Look it up in the HPT
     , let mod_info = ASSERT( mod `elemModuleEnv` hpt )
-                    fromJust (lookupModuleEnv hpt mod)
+                    expectJust "hptRules" (lookupModuleEnv hpt mod)
 
        -- And get its dfuns
     , rule <- md_rules (hm_details mod_info) ]

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index a128c35..557e1e4 100644 (file)
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -42,7 +42,7 @@ import UniqSet                ( emptyUniqSet )
 import List            ( nub )
 import Util            ( isSingleton )
 import ListSetOps      ( removeDups )
-import Maybes          ( fromJust )
+import Maybes          ( expectJust )
 import Outputable
 import SrcLoc          ( Located(..), unLoc, getLoc, cmpLocated )
 import FastString
@@ -678,7 +678,7 @@ rnStmt ctxt (ParStmt segs) thing_inside
                     {  -- Find the Names that are bound by stmts
                       lcl_env <- getLocalRdrEnv
                     ; let { rdr_bndrs = collectLStmtsBinders stmts
-                          ; bndrs = map ( fromJust
+                          ; bndrs = map ( expectJust "rnStmt"
                                         . lookupLocalRdrEnv lcl_env
                                         . unLoc) rdr_bndrs
                           ; new_bndrs = nub bndrs ++ bndrs_so_far 

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index c765699..cffcb9c 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -62,7 +62,7 @@ import SrcLoc         ( Located(..), unLoc, getLoc )
 import Bag
 import ErrUtils                ( Message )
 import Digraph         ( SCC(..), stronglyConnComp )
-import Maybes          ( fromJust, isJust, isNothing, orElse )
+import Maybes          ( expectJust, isJust, isNothing, orElse )
 import Util            ( singleton )
 import BasicTypes      ( TopLevelFlag(..), isTopLevel, isNotTopLevel,
                          RecFlag(..), isNonRec, InlineSpec, defaultInlineSpec )
@@ -251,10 +251,8 @@ mkEdges :: TcSigFun -> LHsBinds Name
 type BKey  = Int -- Just number off the bindings
 
 mkEdges sig_fn binds
-  = [ (bind, key, [fromJust mb_key | n <- nameSetToList (bind_fvs (unLoc bind)),
-                                    let mb_key = lookupNameEnv key_map n,
-                                    isJust mb_key,
-                                    no_sig n ])
+  = [ (bind, key, [key | n <- nameSetToList (bind_fvs (unLoc bind)),
+                        Just key <- [lookupNameEnv key_map n], no_sig n ])
     | (bind, key) <- keyd_binds
     ]
   where
@@ -419,7 +417,8 @@ type TcPragFun = Name -> [LSig Name]
 mkPragFun :: [LSig Name] -> TcPragFun
 mkPragFun sigs = \n -> lookupNameEnv env n `orElse` []
        where
-         prs = [(fromJust (sigName sig), sig) | sig <- sigs, isPragLSig sig]
+         prs = [(expectJust "mkPragFun" (sigName sig), sig) 
+               | sig <- sigs, isPragLSig sig]
          env = foldl add emptyNameEnv prs
          add env (n,p) = extendNameEnv_Acc (:) singleton env n p
 
@@ -958,7 +957,7 @@ mkSigFun :: [LSig Name] -> TcSigFun
 -- Precondition: no duplicates
 mkSigFun sigs = lookupNameEnv env
   where
-    env = mkNameEnv [(fromJust (sigName sig), sig) | sig <- sigs]
+    env = mkNameEnv [(expectJust "mkSigFun" (sigName sig), sig) | sig <- sigs]
 
 ---------------
 data TcSigInfo

diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
index d2f53de..9e0b6cc 100644 (file)
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs
@@ -52,7 +52,8 @@ import Var            ( TyVar, idType, idName )
 import VarSet          ( elemVarSet, mkVarSet )
 import Name            ( Name, getSrcLoc )
 import Outputable
-import Maybe           ( isJust, fromJust )
+import Maybe           ( isJust )
+import Maybes          ( expectJust )
 import Unify           ( tcMatchTys, tcMatchTyX )
 import Util            ( zipLazy, isSingleton, notNull, sortLe )
 import List            ( partition )
@@ -663,7 +664,7 @@ checkFieldCompat fld con1 con2 tvs1 res1 res2 fty1 fty2
        ; checkTc (isJust mb_subst2) (fieldTypeMisMatch fld con1 con2) }
   where
     mb_subst1 = tcMatchTys tvs1 res1 res2
-    mb_subst2 = tcMatchTyX tvs1 (fromJust mb_subst1) fty1 fty2
+    mb_subst2 = tcMatchTyX tvs1 (expectJust "checkFieldCompat" mb_subst1) fty1 fty2
 
 -------------------------------
 checkValidDataCon :: TyCon -> DataCon -> TcM ()

diff --git a/ghc/compiler/typecheck/TcUnify.lhs b/ghc/compiler/typecheck/TcUnify.lhs
index 187f055..23cc9e2 100644 (file)
--- a/ghc/compiler/typecheck/TcUnify.lhs
+++ b/ghc/compiler/typecheck/TcUnify.lhs
@@ -67,7 +67,7 @@ import VarSet         ( emptyVarSet, mkVarSet, unitVarSet, unionVarSet, elemVarSet, var
 import VarEnv
 import Name            ( Name, isSystemName )
 import ErrUtils                ( Message )
-import Maybes          ( fromJust, isNothing )
+import Maybes          ( expectJust, isNothing )
 import BasicTypes      ( Arity )
 import UniqSupply      ( uniqsFromSupply )
 import Util            ( notNull, equalLength )
@@ -1197,7 +1197,8 @@ checkTauTvUpdate orig_tv orig_ty
             ; case mb_tys' of
                Just tys' -> return (TyConApp tc tys')
                                -- Retain the synonym (the common case)
-               Nothing   -> go (fromJust (tcView (TyConApp tc tys)))
+               Nothing   -> go (expectJust "checkTauTvUpdate" 
+                                       (tcView (TyConApp tc tys)))
                                -- Try again, expanding the synonym
             }
 \end{code}