projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
876b4ef
)
replace several 'fromJust's with 'expectJust's
author
Simon Marlow
<simonmar@microsoft.com>
Thu, 2 Mar 2006 14:16:28 +0000
(14:16 +0000)
committer
Simon Marlow
<simonmar@microsoft.com>
Thu, 2 Mar 2006 14:16:28 +0000
(14:16 +0000)
ghc/compiler/iface/MkIface.lhs
patch
|
blob
|
history
ghc/compiler/main/GHC.hs
patch
|
blob
|
history
ghc/compiler/main/HscTypes.lhs
patch
|
blob
|
history
ghc/compiler/rename/RnExpr.lhs
patch
|
blob
|
history
ghc/compiler/typecheck/TcBinds.lhs
patch
|
blob
|
history
ghc/compiler/typecheck/TcTyClsDecls.lhs
patch
|
blob
|
history
ghc/compiler/typecheck/TcUnify.lhs
patch
|
blob
|
history
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,
import Monad ( when )
import List ( insert )
import Maybes ( orElse, mapCatMaybes, isNothing, isJust,
- fromJust, expectJust, MaybeErr(..) )
+ expectJust, MaybeErr(..) )
\end{code}
\end{code}
@@
-321,7
+321,7
@@
mkIface hsc_env maybe_old_iface
-- Debug printing
; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
-- 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)
; 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"))
-- 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
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 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 )
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)
-- 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))
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],
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
[] -> 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
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 */
#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 FiniteMap ( FiniteMap )
import CoreSyn ( CoreRule )
-import Maybes ( orElse, fromJust, expectJust )
+import Maybes ( orElse, expectJust, expectJust )
import Outputable
import SrcLoc ( SrcSpan, Located )
import UniqSupply ( UniqSupply )
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 )
-- 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) ]
-- 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 List ( nub )
import Util ( isSingleton )
import ListSetOps ( removeDups )
-import Maybes ( fromJust )
+import Maybes ( expectJust )
import Outputable
import SrcLoc ( Located(..), unLoc, getLoc, cmpLocated )
import FastString
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
{ -- 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
. 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 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 )
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
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
| (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
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
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
-- 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
---------------
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 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 )
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
; 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 ()
-------------------------------
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 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 )
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)
; 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}
-- Try again, expanding the synonym
}
\end{code}