summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/basicTypes/NameEnv.lhs2
-rw-r--r--compiler/basicTypes/RdrName.lhs6
-rw-r--r--compiler/codeGen/StgCmmBind.hs4
-rw-r--r--compiler/deSugar/DsCCall.lhs7
-rw-r--r--compiler/iface/MkIface.lhs2
-rw-r--r--compiler/main/GhcMake.hs4
-rw-r--r--compiler/main/TidyPgm.lhs2
-rw-r--r--compiler/rename/RnEnv.lhs2
-rw-r--r--compiler/stgSyn/CoreToStg.lhs4
-rw-r--r--compiler/typecheck/TcBinds.lhs2
-rw-r--r--compiler/typecheck/TcClassDcl.lhs3
-rw-r--r--compiler/typecheck/TcDeriv.lhs6
-rw-r--r--compiler/typecheck/TcErrors.lhs7
-rw-r--r--compiler/typecheck/TcSMonad.lhs8
-rw-r--r--compiler/typecheck/TcTyDecls.lhs2
-rw-r--r--compiler/typecheck/TcType.lhs4
-rw-r--r--compiler/typecheck/TcValidity.lhs4
-rw-r--r--compiler/types/OptCoercion.lhs3
-rw-r--r--compiler/utils/Maybes.lhs38
19 files changed, 42 insertions, 68 deletions
diff --git a/compiler/basicTypes/NameEnv.lhs b/compiler/basicTypes/NameEnv.lhs
index 79433ca144..292ee3d1ec 100644
--- a/compiler/basicTypes/NameEnv.lhs
+++ b/compiler/basicTypes/NameEnv.lhs
@@ -58,7 +58,7 @@ depAnal get_defs get_uses nodes
= stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
where
keyed_nodes = nodes `zip` [(1::Int)..]
- mk_node (node, key) = (node, key, mapCatMaybes (lookupNameEnv key_map) (get_uses node))
+ mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
key_map :: NameEnv Int -- Maps a Name to the key of the decl that defines it
key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 4ffeae0d77..3ff771f0fe 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -586,7 +586,7 @@ pickGREs rdr_name gres
= ASSERT2( isSrcRdrName rdr_name, ppr rdr_name )
candidates
where
- candidates = mapCatMaybes pick gres
+ candidates = mapMaybe pick gres
internal_candidates = filter (isInternalName . gre_name) candidates
rdr_is_unqual = isUnqual rdr_name
@@ -700,7 +700,7 @@ shadow_name env name
= alterOccEnv (fmap alter_fn) env (nameOccName name)
where
alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]
- alter_fn gres = mapCatMaybes (shadow_with name) gres
+ alter_fn gres = mapMaybe (shadow_with name) gres
shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef })
@@ -719,7 +719,7 @@ shadow_name env name
| null imp_specs' = Nothing
| otherwise = Just (old_gre { gre_prov = Imported imp_specs' })
where
- imp_specs' = mapCatMaybes (shadow_is new_name) imp_specs
+ imp_specs' = mapMaybe (shadow_is new_name) imp_specs
shadow_is :: Name -> ImportSpec -> Maybe ImportSpec
shadow_is new_name is@(ImpSpec { is_decl = id_spec })
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 344e80a497..4531903228 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -46,9 +46,9 @@ import Util
import BasicTypes
import Outputable
import FastString
-import Maybes
import DynFlags
+import Data.Maybe
import Control.Monad
------------------------------------------------------------------------
@@ -268,7 +268,7 @@ mkRhsClosure dflags bndr _cc _bi
[(DataAlt _, params, _use_mask,
(StgApp selectee [{-no args-}]))])
| the_fv == scrutinee -- Scrutinee is the only free variable
- && maybeToBool maybe_offset -- Selectee is a component of the tuple
+ && isJust maybe_offset -- Selectee is a component of the tuple
&& offset_into_int <= mAX_SPEC_SELECTEE_SIZE dflags -- Offset is small enough
= -- NOT TRUE: ASSERT(is_single_constructor)
-- The simplifier may have statically determined that the single alternative
diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs
index f3f0adc668..80f2ec525f 100644
--- a/compiler/deSugar/DsCCall.lhs
+++ b/compiler/deSugar/DsCCall.lhs
@@ -32,7 +32,6 @@ import CoreUtils
import MkCore
import Var
import MkId
-import Maybes
import ForeignCall
import DataCon
@@ -50,6 +49,8 @@ import VarSet
import DynFlags
import Outputable
import Util
+
+import Data.Maybe
\end{code}
Desugaring of @ccall@s consists of adding some state manipulation,
@@ -177,7 +178,7 @@ unboxArg arg
-- data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
| is_product_type &&
data_con_arity == 3 &&
- maybeToBool maybe_arg3_tycon &&
+ isJust maybe_arg3_tycon &&
(arg3_tycon == byteArrayPrimTyCon ||
arg3_tycon == mutableByteArrayPrimTyCon)
= do case_bndr <- newSysLocalDs arg_ty
@@ -192,7 +193,7 @@ unboxArg arg
where
arg_ty = exprType arg
maybe_product_type = splitDataProductType_maybe arg_ty
- is_product_type = maybeToBool maybe_product_type
+ is_product_type = isJust maybe_product_type
Just (_, _, data_con, data_con_arg_tys) = maybe_product_type
data_con_arity = dataConSourceArity data_con
(data_con_arg_ty1 : _) = data_con_arg_tys
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 379b39de58..0af9af6878 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -936,7 +936,7 @@ mk_mod_usage_info :: PackageIfaceTable
-> NameSet
-> [Usage]
mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
- = mapCatMaybes mkUsage usage_mods
+ = mapMaybe mkUsage usage_mods
where
hpt = hsc_HPT hsc_env
dflags = hsc_dflags hsc_env
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index c8afd83beb..b7a1282f5c 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -46,7 +46,7 @@ import BasicTypes
import Digraph
import Exception ( tryIO, gbracket, gfinally )
import FastString
-import Maybes ( expectJust, mapCatMaybes )
+import Maybes ( expectJust )
import MonadUtils ( allM, MonadIO )
import Outputable
import Panic
@@ -1443,7 +1443,7 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l
| otherwise = HsBootFile
out_edge_keys :: HscSource -> [ModuleName] -> [Int]
- out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
+ out_edge_keys hi_boot ms = mapMaybe (lookup_key hi_boot) ms
-- If we want keep_hi_boot_nodes, then we do lookup_key with
-- the IsBootInterface parameter True; else False
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 7ab6d569bc..b20658b073 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -563,7 +563,7 @@ See CorePrep Note [Data constructor workers].
\begin{code}
getTyConImplicitBinds :: TyCon -> [CoreBind]
-getTyConImplicitBinds tc = map get_defn (mapCatMaybes dataConWrapId_maybe (tyConDataCons tc))
+getTyConImplicitBinds tc = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
getClassImplicitBinds :: Class -> [CoreBind]
getClassImplicitBinds cls = map get_defn (classAllSelIds cls)
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index f0d1840970..2359cac043 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -1103,7 +1103,7 @@ type MiniFixityEnv = FastStringEnv (Located Fixity)
addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities mini_fix_env names thing_inside
- = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
+ = extendFixityEnv (mapMaybe find_fixity names) thing_inside
where
find_fixity name
= case lookupFsEnv mini_fix_env (occNameFS occ) of
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 2c4df6955f..0c47042b4d 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -28,7 +28,6 @@ import DataCon
import CostCentre ( noCCS )
import VarSet
import VarEnv
-import Maybes ( maybeToBool )
import Module
import Name ( getOccName, isExternalName, nameOccName )
import OccName ( occNameString, occNameFS )
@@ -44,6 +43,7 @@ import ForeignCall
import Demand ( isSingleUsed )
import PrimOp ( PrimCall(..) )
+import Data.Maybe (isJust)
import Control.Monad (liftM, ap)
-- Note [Live vs free]
@@ -1106,7 +1106,7 @@ minusFVBinder v fv = fv `delVarEnv` v
-- c.f. CoreFVs.delBinderFV
elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
-elementOfFVInfo id fvs = maybeToBool (lookupVarEnv fvs id)
+elementOfFVInfo id fvs = isJust (lookupVarEnv fvs id)
lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
-- Find how the given Id is used.
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 47d45ae318..1e619ed493 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -704,7 +704,7 @@ type PragFun = Name -> [LSig Name]
mkPragFun :: [LSig Name] -> LHsBinds Name -> PragFun
mkPragFun sigs binds = \n -> lookupNameEnv prag_env n `orElse` []
where
- prs = mapCatMaybes get_sig sigs
+ prs = mapMaybe get_sig sigs
get_sig :: LSig Name -> Maybe (Located Name, LSig Name)
get_sig (L l (SpecSig nm ty inl)) = Just (nm, L l $ SpecSig nm ty (add_arity nm inl))
diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index f61f48e92a..6fc2213cbc 100644
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -341,8 +341,9 @@ findMethodBind sel_name binds
findMinimalDef :: [LSig Name] -> Maybe ClassMinimalDef
findMinimalDef = firstJusts . map toMinimalDef
where
+ toMinimalDef :: LSig Name -> Maybe ClassMinimalDef
toMinimalDef (L _ (MinimalSig bf)) = Just (fmap unLoc bf)
- toMinimalDef _ = Nothing
+ toMinimalDef _ = Nothing
\end{code}
Note [Polymorphic methods]
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 8a4c19c4de..db8505c929 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1218,9 +1218,9 @@ cond_stdOK Nothing (_, rep_tc, _)
| not (null con_whys) = Just (vcat con_whys $$ suggestion)
| otherwise = Nothing
where
- suggestion = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
- data_cons = tyConDataCons rep_tc
- con_whys = mapCatMaybes check_con data_cons
+ suggestion = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
+ data_cons = tyConDataCons rep_tc
+ con_whys = mapMaybe check_con data_cons
check_con :: DataCon -> Maybe SDoc
check_con con
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index f105cdddff..4b1bc680d5 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -38,7 +38,6 @@ import Var
import VarSet
import VarEnv
import Bag
-import Maybes
import ErrUtils ( ErrMsg, makeIntoWarning, pprLocErrMsg )
import BasicTypes
import Util
@@ -47,6 +46,8 @@ import Outputable
import SrcLoc
import DynFlags
import ListSetOps ( equivClasses )
+
+import Data.Maybe
import Data.List ( partition, mapAccumL, zip4 )
\end{code}
@@ -1033,7 +1034,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
add_to_ctxt_fixes has_ambig_tvs
| not has_ambig_tvs && all_tyvars
- , (orig:origs) <- mapCatMaybes get_good_orig (cec_encl ctxt)
+ , (orig:origs) <- mapMaybe get_good_orig (cec_encl ctxt)
= [sep [ ptext (sLit "add") <+> pprParendType pred
<+> ptext (sLit "to the context of")
, nest 2 $ ppr_skol orig $$
@@ -1102,7 +1103,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
ispecs = [ispec | (ispec, _) <- matches]
givens = getUserGivens ctxt
- matching_givens = mapCatMaybes matchable givens
+ matching_givens = mapMaybe matchable givens
matchable (evvars,skol_info,loc)
= case ev_vars_matching of
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 634e926a5e..2785215928 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -134,7 +134,7 @@ import TcRnTypes
import BasicTypes
import Unique
import UniqFM
-import Maybes ( orElse, catMaybes, firstJust )
+import Maybes ( orElse, catMaybes, firstJusts )
import Pair ( pSnd )
import TrieMap
@@ -723,9 +723,9 @@ lookupFlatEqn fam_tc tys
= do { IS { inert_solved_funeqs = solved_funeqs
, inert_flat_cache = flat_cache
, inert_cans = IC { inert_funeqs = inert_funeqs } } <- getTcSInerts
- ; return (findFunEq solved_funeqs fam_tc tys `firstJust`
- lookup_inerts inert_funeqs `firstJust`
- findFunEq flat_cache fam_tc tys) }
+ ; return (firstJusts [findFunEq solved_funeqs fam_tc tys,
+ lookup_inerts inert_funeqs,
+ findFunEq flat_cache fam_tc tys]) }
where
lookup_inerts inert_funeqs
| (ct:_) <- findFunEqs inert_funeqs fam_tc tys
diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs
index dbecf0a754..a75618b75e 100644
--- a/compiler/typecheck/TcTyDecls.lhs
+++ b/compiler/typecheck/TcTyDecls.lhs
@@ -371,7 +371,7 @@ calcRecFlags boot_details is_boot mrole_env tyclss
, rti_is_rec = is_rec }
where
rec_tycon_names = mkNameSet (map tyConName all_tycons)
- all_tycons = mapCatMaybes getTyCon tyclss
+ all_tycons = mapMaybe getTyCon tyclss
-- Recursion of newtypes/data types can happen via
-- the class TyCon, so tyclss includes the class tycons
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 55c37b9506..a7442fdbee 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -945,7 +945,7 @@ tcGetTyVar :: String -> Type -> TyVar
tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
tcIsTyVarTy :: Type -> Bool
-tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
+tcIsTyVarTy ty = isJust (tcGetTyVar_maybe ty)
-----------------------
tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])
@@ -992,7 +992,7 @@ tcInstHeadTyAppAllTyVars ty
-- and that each is distinct
ok tys = equalLength tvs tys && hasNoDups tvs
where
- tvs = mapCatMaybes get_tv tys
+ tvs = mapMaybe get_tv tys
get_tv (TyVarTy tv) = Just tv -- through synonyms
get_tv _ = Nothing
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index 20547bc51e..6ff235db6e 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -41,7 +41,6 @@ import ErrUtils
import PrelNames
import DynFlags
import Util
-import Maybes
import ListSetOps
import SrcLoc
import Outputable
@@ -49,6 +48,7 @@ import FastString
import BasicTypes ( Arity )
import Control.Monad
+import Data.Maybe
import Data.List ( (\\) )
\end{code}
@@ -1124,7 +1124,7 @@ checkFamInstRhs :: [Type] -- lhs
-> [(TyCon, [Type])] -- type family instances
-> [MsgDoc]
checkFamInstRhs lhsTys famInsts
- = mapCatMaybes check famInsts
+ = mapMaybe check famInsts
where
size = sizeTypes lhsTys
fvs = fvTypes lhsTys
diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs
index ebc2cbea5c..bb2b9f888b 100644
--- a/compiler/types/OptCoercion.lhs
+++ b/compiler/types/OptCoercion.lhs
@@ -32,6 +32,7 @@ import Util
import Unify
import ListSetOps
import InstEnv
+import Control.Monad ( zipWithM )
\end{code}
%************************************************************************
@@ -534,7 +535,7 @@ matchAxiom sym ax@(CoAxiom { co_ax_tc = tc }) ind co
, cab_rhs = rhs }) = coAxiomNthBranch ax ind in
case liftCoMatch (mkVarSet qtvs) (if sym then (mkTyConApp tc lhs) else rhs) co of
Nothing -> Nothing
- Just subst -> allMaybes (zipWith (liftCoSubstTyVar subst) roles qtvs)
+ Just subst -> zipWithM (liftCoSubstTyVar subst) roles qtvs
-------------
compatible_co :: Coercion -> Coercion -> Bool
diff --git a/compiler/utils/Maybes.lhs b/compiler/utils/Maybes.lhs
index 3c943bd224..d9e1762a2f 100644
--- a/compiler/utils/Maybes.lhs
+++ b/compiler/utils/Maybes.lhs
@@ -11,12 +11,9 @@ module Maybes (
failME, isSuccess,
orElse,
- mapCatMaybes,
- allMaybes,
firstJust, firstJusts,
whenIsJust,
expectJust,
- maybeToBool,
MaybeT(..)
) where
@@ -34,53 +31,26 @@ infixr 4 `orElse`
%************************************************************************
\begin{code}
-maybeToBool :: Maybe a -> Bool
-maybeToBool Nothing = False
-maybeToBool (Just _) = True
-
--- | Collects a list of @Justs@ into a single @Just@, returning @Nothing@ if
--- there are any @Nothings@.
-allMaybes :: [Maybe a] -> Maybe [a]
-allMaybes [] = Just []
-allMaybes (Nothing : _) = Nothing
-allMaybes (Just x : ms) = case allMaybes ms of
- Nothing -> Nothing
- Just xs -> Just (x:xs)
-
firstJust :: Maybe a -> Maybe a -> Maybe a
-firstJust (Just a) _ = Just a
-firstJust Nothing b = b
+firstJust a b = firstJusts [a, b]
-- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or
-- @Nothing@ otherwise.
firstJusts :: [Maybe a] -> Maybe a
-firstJusts = foldr firstJust Nothing
-\end{code}
+firstJusts = msum
-\begin{code}
expectJust :: String -> Maybe a -> a
{-# INLINE expectJust #-}
expectJust _ (Just x) = x
expectJust err Nothing = error ("expectJust " ++ err)
-\end{code}
-
-\begin{code}
-mapCatMaybes :: (a -> Maybe b) -> [a] -> [b]
-mapCatMaybes _ [] = []
-mapCatMaybes f (x:xs) = case f x of
- Just y -> y : mapCatMaybes f xs
- Nothing -> mapCatMaybes f xs
whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust (Just x) f = f x
whenIsJust Nothing _ = return ()
-\end{code}
-\begin{code}
--- | flipped version of @fromMaybe@.
+-- | Flipped version of @fromMaybe@, useful for chaining.
orElse :: Maybe a -> a -> a
-(Just x) `orElse` _ = x
-Nothing `orElse` y = y
+orElse = flip fromMaybe
\end{code}
%************************************************************************
View Lorry Controller Status