Commit e16826b1 authored by Icelandjack's avatar Icelandjack Committed by Joachim Breitner

Cleaned up Maybes.lhs

parent 5d04603b
......@@ -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]
......
......@@ -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 })
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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.
......
......@@ -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))
......
......@@ -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]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
%************************************************************************
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment