diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-01-27 13:15:15 +0100 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2016-01-27 13:56:48 +0100 |
commit | 4faa1a63d0496fd511d2d139622dbf7ef2ce4655 (patch) | |
tree | a0877a6063443197c5425c506ed14354d9fe8060 /compiler | |
parent | 45c6fbc5284f83e1253ff9f3b49fe54a76c20ba7 (diff) | |
download | haskell-4faa1a63d0496fd511d2d139622dbf7ef2ce4655.tar.gz |
s/unLifted/unlifted for consistency
This was causing trouble as we had to remember when to use "unLifted"
and when to use "unlifted".
"unlifted" is used instead of "unLifted" as it's a single word.
Reviewers: austin, hvr, goldfire, bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1852
Diffstat (limited to 'compiler')
35 files changed, 95 insertions, 95 deletions
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 65b8b2b9ee..2fd9981c1b 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -69,7 +69,7 @@ import BasicTypes import Binary import Maybes ( orElse ) -import Type ( Type, isUnLiftedType ) +import Type ( Type, isUnliftedType ) import TyCon ( isNewTyCon, isClassTyCon ) import DataCon ( splitDataProductType_maybe ) @@ -1355,7 +1355,7 @@ toCleanDmd (JD { sd = s, ud = u }) expr_ty Abs | is_unlifted -> (Use One (), Used) | otherwise -> (Abs, Used) - is_unlifted = isUnLiftedType expr_ty + is_unlifted = isUnliftedType expr_ty -- See Note [Analysing with absent demand] diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 97224c6660..dca026dccd 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -173,7 +173,7 @@ data LambdaFormInfo -- because then we know the entry code will do -- For a function, the entry code is the fast entry point - | LFUnLifted -- A value of unboxed type; + | LFUnlifted -- A value of unboxed type; -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description @@ -211,7 +211,7 @@ data StandardFormInfo mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnLiftedType ty = LFUnLifted + | isUnliftedType ty = LFUnlifted | might_be_a_function ty = LFUnknown True | otherwise = LFUnknown False where @@ -234,7 +234,7 @@ mkLFReEntrant top fvs args arg_descr ------------- mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo mkLFThunk thunk_ty top fvs upd_flag - = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) ) + = ASSERT( not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty) ) LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk @@ -421,7 +421,7 @@ nodeMustPointToIt _ (LFCon _) = True -- 27/11/92. nodeMustPointToIt _ (LFUnknown _) = True -nodeMustPointToIt _ LFUnLifted = False +nodeMustPointToIt _ LFUnlifted = False nodeMustPointToIt _ LFLetNoEscape = False {- Note [GC recovery] @@ -525,7 +525,7 @@ getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc | n_args < arity = SlowCall -- Not enough args | otherwise = DirectEntry (enterIdLabel dflags name (idCafInfo id)) arity -getCallMethod _ _name _ LFUnLifted n_args _v_args _cg_loc _self_loop_info +getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 8e74c22fba..923450e6f3 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -395,7 +395,7 @@ MutVar#. The types are compatible though, so we can just generate an assignment. -} cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts - | isUnLiftedType (idType v) -- Note [Dodgy unsafeCoerce 1] + | isUnliftedType (idType v) -- Note [Dodgy unsafeCoerce 1] || reps_compatible = -- assignment suffices for unlifted types do { dflags <- getDynFlags diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 03a936fad0..95dfa99389 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -638,7 +638,7 @@ showTypeCategory ty | otherwise = case tcSplitTyConApp_maybe ty of Nothing -> '.' Just (tycon, _) -> - (if isUnLiftedTyCon tycon then Data.Char.toLower else \x -> x) $ + (if isUnliftedTyCon tycon then Data.Char.toLower else \x -> x) $ let anyOf us = getUnique tycon `elem` us in case () of _ | anyOf [funTyConKey] -> '>' diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 9c61b39fb4..f0f27646a3 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -473,7 +473,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- Check the let/app invariant -- See Note [CoreSyn let/app invariant] in CoreSyn - ; checkL (not (isUnLiftedType binder_ty) + ; checkL (not (isUnliftedType binder_ty) || (isNonRec rec_flag && exprOkForSpeculation rhs)) (mkRhsPrimMsg binder rhs) @@ -759,7 +759,7 @@ lintCoreArg fun_ty (Type arg_ty) lintCoreArg fun_ty arg = do { arg_ty <- lintCoreExpr arg - ; checkL (not (isUnLiftedType arg_ty) || exprOkForSpeculation arg) + ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) ; lintValApp arg fun_ty arg_ty } @@ -1042,7 +1042,7 @@ lintType ty@(TyConApp tc tys) = lintType ty' -- Expand type synonyms, so that we do not bogusly complain -- about un-saturated type synonyms - | isUnLiftedTyCon tc || isTypeSynonymTyCon tc || isTypeFamilyTyCon tc + | isUnliftedTyCon tc || isTypeSynonymTyCon tc || isTypeFamilyTyCon tc -- Also type synonyms and type families , length tys < tyConArity tc = failWithL (hang (text "Un-saturated type application") 2 (ppr ty)) @@ -1291,7 +1291,7 @@ lintCoercion (CoVarCo cv) | otherwise = do { lintTyCoVarInScope cv ; cv' <- lookupIdInScope cv - ; lintUnLiftedCoVar cv + ; lintUnliftedCoVar cv ; return $ coVarKindsTypesRole cv' } -- See Note [Bad unsafe coercion] @@ -1510,9 +1510,9 @@ lintCoercion this@(AxiomRuleCo co cs) , text "Provided:" <+> int n ] ---------- -lintUnLiftedCoVar :: CoVar -> LintM () -lintUnLiftedCoVar cv - = when (not (isUnLiftedType (coVarKind cv))) $ +lintUnliftedCoVar :: CoVar -> LintM () +lintUnliftedCoVar cv + = when (not (isUnliftedType (coVarKind cv))) $ failWithL (text "Bad lifted equality:" <+> ppr cv <+> dcolon <+> ppr (coVarKind cv)) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 724f72bbc4..4708df3f48 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -368,7 +368,7 @@ cpeBind :: TopLevelFlag -> CorePrepEnv -> CoreBind cpeBind top_lvl env (NonRec bndr rhs) = do { (_, bndr1) <- cpCloneBndr env bndr ; let dmd = idDemandInfo bndr - is_unlifted = isUnLiftedType (idType bndr) + is_unlifted = isUnliftedType (idType bndr) ; (floats, bndr2, rhs2) <- cpePair top_lvl NonRecursive dmd is_unlifted @@ -764,7 +764,7 @@ cpeArg env dmd arg arg_ty arg_float = mkFloat dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } } where - is_unlifted = isUnLiftedType arg_ty + is_unlifted = isUnliftedType arg_ty is_strict = isStrictDmd dmd want_float = wantFloatNested NonRecursive (is_strict || is_unlifted) diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 8d4529aba5..167654e1ea 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -1063,7 +1063,7 @@ maybe_substitute subst b r , isAlwaysActive (idInlineActivation b) -- Note [Inline prag in simplOpt] , not (isStableUnfolding (idUnfolding b)) , not (isExportedId b) - , not (isUnLiftedType (idType b)) || exprOkForSpeculation r + , not (isUnliftedType (idType b)) || exprOkForSpeculation r = Just (extendIdSubst subst b r) | otherwise diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 2a7906a908..48cdb5e5f6 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -500,7 +500,7 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr size_up (Let (NonRec binder rhs) body) = size_up rhs `addSizeNSD` size_up body `addSizeN` - (if isUnLiftedType (idType binder) then 0 else 10) + (if isUnliftedType (idType binder) then 0 else 10) -- For the allocation -- If the binder has an unlifted type there is no allocation @@ -559,7 +559,7 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr -- unboxed variables, inline primops and unsafe foreign calls -- are all "inline" things: - is_inline_scrut (Var v) = isUnLiftedType (idType v) + is_inline_scrut (Var v) = isUnliftedType (idType v) is_inline_scrut scrut | (Var f, _) <- collectArgs scrut = case idDetails f of diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index eaccb33e91..a403f290ec 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -429,7 +429,7 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this expression -- as per the invariants of 'CoreExpr': see "CoreSyn#let_app_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = isUnLiftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs = isUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) @@ -1278,7 +1278,7 @@ app_ok primop_ok fun args -> primop_ok op -- A bit conservative: we don't really need && all (expr_ok primop_ok) args -- to care about lazy arguments, but this is easy - _other -> isUnLiftedType (idType fun) -- c.f. the Var case of exprIsHNF + _other -> isUnliftedType (idType fun) -- c.f. the Var case of exprIsHNF || idArity fun > n_val_args -- Partial apps || (n_val_args == 0 && isEvaldUnfolding (idUnfolding fun)) -- Let-bound values diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index b7a578f533..a5faef0201 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -1204,7 +1204,7 @@ mkTickish :: BoxLabel -> Bool -> Bool -> SrcSpan -> OccEnv Id -> [String] -> TM (Tickish Id) mkTickish boxLabel countEntries topOnly pos fvs decl_path = do - let ids = filter (not . isUnLiftedType . idType) $ occEnvElts fvs + let ids = filter (not . isUnliftedType . idType) $ occEnvElts fvs -- unlifted types cause two problems here: -- * we can't bind them at the GHCi prompt -- (bindLocalsAtBreakpoint already fliters them out), diff --git a/compiler/deSugar/DsCCall.hs b/compiler/deSugar/DsCCall.hs index 9a3fe5a220..0d9bbb4362 100644 --- a/compiler/deSugar/DsCCall.hs +++ b/compiler/deSugar/DsCCall.hs @@ -157,7 +157,7 @@ unboxArg arg -- Data types with a single constructor, which has a single, primitive-typed arg -- This deals with Int, Float etc; also Ptr, ForeignPtr | is_product_type && data_con_arity == 1 - = ASSERT2(isUnLiftedType data_con_arg_ty1, pprType arg_ty) + = ASSERT2(isUnliftedType data_con_arg_ty1, pprType arg_ty) -- Typechecker ensures this do case_bndr <- newSysLocalDs arg_ty prim_arg <- newSysLocalDs data_con_arg_ty1 diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index c3c17c7e39..a3b8f1a91d 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -114,7 +114,7 @@ ds_val_bind (NonRecursive, hsbinds) body ds_val_bind (_is_rec, binds) body = do { (force_vars,prs) <- dsLHsBinds binds ; let body' = foldr seqVar body force_vars - ; ASSERT2( not (any (isUnLiftedType . idType . fst) prs), ppr _is_rec $$ ppr binds ) + ; ASSERT2( not (any (isUnliftedType . idType . fst) prs), ppr _is_rec $$ ppr binds ) case prs of [] -> return body _ -> return (Let (Rec prs) body') } @@ -183,11 +183,11 @@ unliftedMatchOnly (AbsBinds { abs_binds = lbinds }) unliftedMatchOnly (AbsBindsSig { abs_sig_bind = L _ bind }) = unliftedMatchOnly bind unliftedMatchOnly (PatBind { pat_lhs = lpat, pat_rhs_ty = rhs_ty }) - = isUnLiftedType rhs_ty + = isUnliftedType rhs_ty || isUnliftedLPat lpat - || any (isUnLiftedType . idType) (collectPatBinders lpat) + || any (isUnliftedType . idType) (collectPatBinders lpat) unliftedMatchOnly (FunBind { fun_id = L _ id }) - = isUnLiftedType (idType id) + = isUnliftedType (idType id) unliftedMatchOnly _ = False -- I hope! Checked immediately by caller in fact {- diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs index 0805ca096a..a87526ff6c 100644 --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -782,7 +782,7 @@ getPrimTyOf ty case splitDataProductType_maybe rep_ty of Just (_, _, data_con, [prim_ty]) -> ASSERT(dataConSourceArity data_con == 1) - ASSERT2(isUnLiftedType prim_ty, ppr prim_ty) + ASSERT2(isUnliftedType prim_ty, ppr prim_ty) prim_ty _other -> pprPanic "DsForeign.getPrimTyOf" (ppr ty) where diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 4c9e0b4ea9..0e054bff54 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -409,7 +409,7 @@ schemeE d s p e@(AnnLit lit) = returnUnboxedAtom d s p e (typeArgRep (litera schemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e V schemeE d s p e@(AnnVar v) - | isUnLiftedType (idType v) = returnUnboxedAtom d s p e (bcIdArgRep v) + | isUnliftedType (idType v) = returnUnboxedAtom d s p e (bcIdArgRep v) | otherwise = schemeT d s p e schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) @@ -488,7 +488,7 @@ schemeE d s p (AnnLet binds (_,body)) = do -- best way to calculate the free vars but it seemed like the least -- intrusive thing to do schemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs) - = if isUnLiftedType ty + = if isUnliftedType ty then do -- If the result type is unlifted, then we must generate -- let f = \s . tick<n> e @@ -822,7 +822,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple Nothing -> p_alts0 bndr_ty = idType bndr - isAlgCase = not (isUnLiftedType bndr_ty) && isNothing is_unboxed_tuple + isAlgCase = not (isUnliftedType bndr_ty) && isNothing is_unboxed_tuple -- given an alt, return a discr and code for it. codeAlt (DEFAULT, _, (_,rhs)) diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs index e92db9fd1c..f32b5a387b 100644 --- a/compiler/simplCore/FloatIn.hs +++ b/compiler/simplCore/FloatIn.hs @@ -25,7 +25,7 @@ import CoreUtils ( exprIsDupable, exprIsExpandable, import CoreFVs import Id ( isOneShotBndr, idType ) import Var -import Type ( isUnLiftedType ) +import Type ( isUnliftedType ) import VarSet import Util import DynFlags @@ -385,7 +385,7 @@ floating in cases with a single alternative that may bind values. -} fiExpr dflags to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)]) - | isUnLiftedType (idType case_bndr) + | isUnliftedType (idType case_bndr) , exprOkForSideEffects (deAnnotate scrut) -- See PrimOp, Note [PrimOp can_fail and has_side_effects] = wrapFloats shared_binds $ @@ -444,7 +444,7 @@ noFloatIntoRhs :: CoreExprWithFVs -> Bool -- ^ True if it's a bad idea to float bindings into this RHS -- Preconditio: rhs :: rhs_ty noFloatIntoRhs rhs@(_, rhs') - = isUnLiftedType rhs_ty -- See Note [Do not destroy the let/app invariant] + = isUnliftedType rhs_ty -- See Note [Do not destroy the let/app invariant] || noFloatIntoExpr rhs' where rhs_ty = exprTypeFV rhs diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 41b8b6bf01..e3ca7448a4 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -78,7 +78,7 @@ import Literal ( litIsTrivial ) import Demand ( StrictSig ) import Name ( getOccName, mkSystemVarName ) import OccName ( occNameString ) -import Type ( isUnLiftedType, Type, mkPiTypes ) +import Type ( isUnliftedType, Type, mkPiTypes ) import BasicTypes ( Arity, RecFlag(..) ) import UniqSupply import Util @@ -475,10 +475,10 @@ lvlMFE True env e@(_, AnnCase {}) = lvlExpr env e -- Don't share cases lvlMFE strict_ctxt env ann_expr - | isUnLiftedType (exprType expr) + | isUnliftedType (exprType expr) -- Can't let-bind it; see Note [Unlifted MFEs] -- This includes coercions, which we don't want to float anyway - -- NB: no need to substitute cos isUnLiftedType doesn't change + -- NB: no need to substitute cos isUnliftedType doesn't change || notWorthFloating ann_expr abs_vars || not float_me = -- Don't float it out @@ -699,7 +699,7 @@ lvlBind env (AnnNonRec bndr rhs) || isCoVar bndr -- Difficult to fix up CoVar occurrences (see extendPolyLvlEnv) -- so we will ignore this case for now || not (profitableFloat env dest_lvl) - || (isTopLvl dest_lvl && isUnLiftedType (idType bndr)) + || (isTopLvl dest_lvl && isUnliftedType (idType bndr)) -- We can't float an unlifted binding to top level, so we don't -- float it at all. It's a bit brutal, but unlifted bindings -- aren't expensive either diff --git a/compiler/simplCore/SimplEnv.hs b/compiler/simplCore/SimplEnv.hs index 1f77657fe1..ecb2e66d68 100644 --- a/compiler/simplCore/SimplEnv.hs +++ b/compiler/simplCore/SimplEnv.hs @@ -423,7 +423,7 @@ unitFloat bind = Floats (unitOL bind) (flag bind) flag (NonRec bndr rhs) | not (isStrictId bndr) = FltLifted | exprOkForSpeculation rhs = FltOkSpec -- Unlifted, and lifted but ok-for-spec (eg HNF) - | otherwise = ASSERT2( not (isUnLiftedType (idType bndr)), ppr bndr ) + | otherwise = ASSERT2( not (isUnliftedType (idType bndr)), ppr bndr ) FltCareful -- Unlifted binders can only be let-bound if exprOkForSpeculation holds diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 6880330c4e..b798013e7c 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -457,7 +457,7 @@ prepareRhs :: TopLevelFlag -> SimplEnv -> OutId -> OutExpr -> SimplM (SimplEnv, -- Adds new floats to the env iff that allows us to return a good RHS prepareRhs top_lvl env id (Cast rhs co) -- Note [Float coercions] | Pair ty1 _ty2 <- coercionKind co -- Do *not* do this if rhs has an unlifted type - , not (isUnLiftedType ty1) -- see Note [Float coercions (unlifted)] + , not (isUnliftedType ty1) -- see Note [Float coercions (unlifted)] = do { (env', rhs') <- makeTrivialWithInfo top_lvl env sanitised_info rhs ; return (env', Cast rhs' co) } where @@ -600,7 +600,7 @@ bindingOk :: TopLevelFlag -> CoreExpr -> Type -> Bool -- True iff we can have a binding of this expression at this level -- Precondition: the type is the type of the expression bindingOk top_lvl _ expr_ty - | isTopLevel top_lvl = not (isUnLiftedType expr_ty) + | isTopLevel top_lvl = not (isUnliftedType expr_ty) | otherwise = True {- @@ -1914,7 +1914,7 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont Just (rule_rhs, cont') -> simplExprF env' rule_rhs cont' Nothing -> reallyRebuildCase env scrut case_bndr alts cont } where - is_unlifted = isUnLiftedType (idType case_bndr) + is_unlifted = isUnliftedType (idType case_bndr) all_dead_bndrs = all isDeadBinder bndrs -- bndrs are [InId] is_plain_seq = all_dead_bndrs && isDeadBinder case_bndr -- Evaluation *only* for effect seq_id_ty = idType seqId @@ -2412,7 +2412,7 @@ mkDupableCont env cont@(Select { sc_bndr = case_bndr, sc_alts = [(_, bs, _rhs)] -- | not (exprIsDupable rhs && contIsDupable case_cont) -- | not (isDeadBinder case_bndr) | all isDeadBinder bs -- InIds - && not (isUnLiftedType (idType case_bndr)) + && not (isUnliftedType (idType case_bndr)) -- Note [Single-alternative-unlifted] = return (env, mkBoringStop (contHoleType cont), cont) @@ -2654,7 +2654,7 @@ for several reasons where v::Void#. The value passed to this function is void, which generates (almost) no code. -* CPR. We used to say "&& isUnLiftedType rhs_ty'" here, but now +* CPR. We used to say "&& isUnliftedType rhs_ty'" here, but now we make the join point into a function whenever used_bndrs' is empty. This makes the join-point more CPR friendly. Consider: let j = if .. then I# 3 else I# 4 diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index d86a95a6b3..a0c8938d70 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -1260,7 +1260,7 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs { -- Figure out the type of the specialised function let body_ty = applyTypeToArgs rhs fn_type rule_args (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted - | isUnLiftedType body_ty -- C.f. WwLib.mkWorkerArgs + | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId]) | otherwise = (poly_tyvars, poly_tyvars) spec_id_ty = mkPiTypes lam_args body_ty diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index 07db9bf775..0f81ab3027 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -480,7 +480,7 @@ coreToStgExpr e = pprPanic "coreToStgExpr" (ppr e) mkStgAltType :: Id -> [CoreAlt] -> AltType mkStgAltType bndr alts = case repType (idType bndr) of UnaryRep rep_ty -> case tyConAppTyCon_maybe rep_ty of - Just tc | isUnLiftedTyCon tc -> PrimAlt tc + Just tc | isUnliftedTyCon tc -> PrimAlt tc | isAbstractTyCon tc -> look_for_better_tycon | isAlgTyCon tc -> AlgAlt tc | otherwise -> ASSERT2( _is_poly_alt_tycon tc, ppr tc ) @@ -654,7 +654,7 @@ coreToStgArgs (arg : args) = do -- Non-type argument let arg_ty = exprType arg stg_arg_ty = stgArgType stg_arg - bad_args = (isUnLiftedType arg_ty && not (isUnLiftedType stg_arg_ty)) + bad_args = (isUnliftedType arg_ty && not (isUnliftedType stg_arg_ty)) || (map typePrimRep (flattenRepType (repType arg_ty)) /= map typePrimRep (flattenRepType (repType stg_arg_ty))) -- In GHCi we coerce an argument of type BCO# (unlifted) to HValue (lifted), diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs index 1499ae216c..a871778e32 100644 --- a/compiler/stgSyn/StgLint.hs +++ b/compiler/stgSyn/StgLint.hs @@ -105,8 +105,8 @@ lint_binds_help (binder, rhs) _maybe_rhs_ty <- lintStgRhs rhs -- Check binder doesn't have unlifted type - checkL (not (isUnLiftedType binder_ty)) - (mkUnLiftedTyMsg binder rhs) + checkL (not (isUnliftedType binder_ty)) + (mkUnliftedTyMsg binder rhs) -- Check match to RHS type -- Actually we *can't* check the RHS type, because @@ -520,8 +520,8 @@ _mkRhsMsg binder ty hsep [text "Rhs type:", ppr ty] ] -mkUnLiftedTyMsg :: Id -> StgRhs -> SDoc -mkUnLiftedTyMsg binder rhs +mkUnliftedTyMsg :: Id -> StgRhs -> SDoc +mkUnliftedTyMsg binder rhs = (text "Let(rec) binder" <+> quotes (ppr binder) <+> text "has unlifted type" <+> quotes (ppr (idType binder))) $$ diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index b9aca82f6a..3d9ab8365a 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -207,7 +207,7 @@ mkWorkerArgs dflags args all_one_shot res_ty = (args ++ [newArg], args ++ [voidPrimId]) where needsAValueLambda = - isUnLiftedType res_ty + isUnliftedType res_ty || not (gopt Opt_FunToThunk dflags) -- see Note [Protecting the last value argument] @@ -628,7 +628,7 @@ mkWWcpr_help :: (DataCon, [Type], [Type], Coercion) mkWWcpr_help (data_con, inst_tys, arg_tys, co) | [arg_ty1] <- arg_tys - , isUnLiftedType arg_ty1 + , isUnliftedType arg_ty1 -- Special case when there is a single result of unlifted type -- -- Wrapper: case (..call worker..) of x -> C x @@ -742,7 +742,7 @@ every primitive type, so the function is partial. mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) mk_absent_let dflags arg - | not (isUnLiftedType arg_ty) + | not (isUnliftedType arg_ty) = Just (Let (NonRec arg abs_rhs)) | Just tc <- tyConAppTyCon_maybe arg_ty , Just lit <- absentLiteralOf tc diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 8adfa357db..1107710bcc 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -2062,7 +2062,7 @@ checkStrictBinds top_lvl rec_group orig_binds tc_binds poly_ids any_pat_looks_lazy = any (looksLazyPatBind . unLoc) orig_binds is_unlifted id = case tcSplitSigmaTy (idType id) of - (_, _, rho) -> isUnLiftedType rho + (_, _, rho) -> isUnliftedType rho -- For the is_unlifted check, we need to look inside polymorphism -- and overloading. E.g. x = (# 1, True #) -- would get type forall a. Num a => (# a, Bool #) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 35c27bf1d5..88fc1ad08a 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -953,7 +953,7 @@ inferConstraints main_cls cls_tys inst_ty rep_tc rep_tc_args , (arg_n, arg_t_or_k, arg_ty) <- zip3 [1..] t_or_ks $ dataConInstOrigArgTys data_con all_rep_tc_args - , not (isUnLiftedType arg_ty) + , not (isUnliftedType arg_ty) , let orig = DerivOriginDC data_con arg_n , pred <- get_arg_constraints orig arg_t_or_k arg_ty ] @@ -1261,7 +1261,7 @@ cond_args cls (_, tc, _) where bad_args = [ arg_ty | con <- tyConDataCons tc , arg_ty <- dataConOrigArgTys con - , isUnLiftedType arg_ty + , isUnliftedType arg_ty , not (ok_ty arg_ty) ] cls_key = classKey cls diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 218c0a4991..caa327e3d9 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -478,7 +478,7 @@ mkCompareFields tycon op tys where go [] _ _ = eqResult op go [ty] (a:_) (b:_) - | isUnLiftedType ty = unliftedOrdOp tycon ty op a b + | isUnliftedType ty = unliftedOrdOp tycon ty op a b | otherwise = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b) go (ty:tys) (a:as) (b:bs) = mk_compare ty a b (ltResult op) @@ -490,7 +490,7 @@ mkCompareFields tycon op tys -- (case (compare a b) of { LT -> <lt>; EQ -> <eq>; GT -> <bt> }) -- but with suitable special cases for mk_compare ty a b lt eq gt - | isUnLiftedType ty + | isUnliftedType ty = unliftedCompare lt_op eq_op a_expr b_expr lt eq gt | otherwise = nlHsCase (nlHsPar (nlHsApp (nlHsApp (nlHsVar compare_RDR) a_expr) b_expr)) @@ -1055,7 +1055,7 @@ gen_Read_binds get_fixity loc tycon data_con_str con = occNameString (getOccName con) - read_arg a ty = ASSERT( not (isUnLiftedType ty) ) + read_arg a ty = ASSERT( not (isUnliftedType ty) ) noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR])) read_field lbl a = read_lbl lbl ++ @@ -1174,7 +1174,7 @@ gen_Show_binds get_fixity loc tycon show_arg :: RdrName -> Type -> LHsExpr RdrName show_arg b arg_ty - | isUnLiftedType arg_ty + | isUnliftedType arg_ty -- See Note [Deriving and unboxed types] in TcDeriv = nlHsApps compose_RDR [mk_shows_app boxed_arg, mk_showString_app postfixMod] @@ -1932,7 +1932,7 @@ gen_Lift_binds loc tycon tys_needed = dataConOrigArgTys data_con mk_lift_app ty a - | not (isUnLiftedType ty) = nlHsApp (nlHsVar lift_RDR) + | not (isUnliftedType ty) = nlHsApp (nlHsVar lift_RDR) (nlHsVar a) | otherwise = nlHsApp (nlHsVar litE_RDR) (primLitOp (mkBoxExp (nlHsVar a))) @@ -2263,7 +2263,7 @@ and_Expr a b = genOpApp a and_RDR b eq_Expr :: TyCon -> Type -> LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName eq_Expr tycon ty a b - | not (isUnLiftedType ty) = genOpApp a eq_RDR b + | not (isUnliftedType ty) = genOpApp a eq_RDR b | otherwise = genPrimOpApp a prim_eq b where (_, _, prim_eq, _, _) = primOrdOps "Eq" tycon ty diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs index 33c04b3693..08b3c9abca 100644 --- a/compiler/typecheck/TcGenGenerics.hs +++ b/compiler/typecheck/TcGenGenerics.hs @@ -175,7 +175,7 @@ canDoGenerics tc tc_args -- Nor can we do the job if it's an existential data constructor, -- Nor if the args are polymorphic types (I don't think) - bad_arg_type ty = (isUnLiftedType ty && not (allowedUnliftedTy ty)) + bad_arg_type ty = (isUnliftedType ty && not (allowedUnliftedTy ty)) || not (isTauTy ty) allowedUnliftedTy :: Type -> Bool diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 42581a6c5d..440691ddb6 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -350,7 +350,7 @@ tc_pat penv lpat@(LazyPat pat) pat_ty thing_inside -- see Note [Hopping the LIE in lazy patterns] -- Check there are no unlifted types under the lazy pattern - ; when (any (isUnLiftedType . idType) $ collectPatBinders pat') $ + ; when (any (isUnliftedType . idType) $ collectPatBinders pat') $ lazyUnliftedPatErr lpat -- Check that the expected pattern type is itself lifted diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 03cbf6762f..bbe3179b2b 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -568,7 +568,7 @@ mkPatSynBuilderId has_sig dir (L _ name) ; let qtvs = univ_tvs ++ ex_tvs theta = req_theta ++ prov_theta mk_sigma = if has_sig then mkSpecSigmaTy else mkInvSigmaTy - need_dummy_arg = isUnLiftedType pat_ty && null arg_tys && null theta + need_dummy_arg = isUnliftedType pat_ty && null arg_tys && null theta builder_sigma = add_void need_dummy_arg $ mk_sigma qtvs theta (mkFunTys arg_tys pat_ty) builder_id = mkExportedVanillaId builder_name builder_sigma diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index efb703c953..aabf72d877 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1688,7 +1688,7 @@ tcRnStmt hsc_env rdr_stmt -- None of the Ids should be of unboxed type, because we -- cast them all to HValues in the end! - mapM_ bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ; + mapM_ bad_unboxed (filter (isUnliftedType . idType) zonked_ids) ; traceTc "tcs 1" empty ; this_mod <- getModule ; diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index ac7e1b707d..12576cd4ed 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1295,7 +1295,7 @@ reifyTyCon tc = return (TH.PrimTyConI (reifyName tc) 2 False) | isPrimTyCon tc - = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc)) + = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnliftedTyCon tc)) | isTypeFamilyTyCon tc = do { let tvs = tyConTyVars tc diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 4f744680bd..a3e449dcfd 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -151,7 +151,7 @@ module TcType ( substTyAddInScope, substTyUnchecked, substTheta, - isUnLiftedType, -- Source types are always lifted + isUnliftedType, -- Source types are always lifted isUnboxedTupleType, -- Ditto isPrimitiveType, @@ -2176,13 +2176,13 @@ legalOutgoingTyCon dflags _ tc legalFFITyCon :: TyCon -> Validity -- True for any TyCon that can possibly be an arg or result of an FFI call legalFFITyCon tc - | isUnLiftedTyCon tc = IsValid + | isUnliftedTyCon tc = IsValid | tc == unitTyCon = IsValid | otherwise = boxedMarshalableTyCon tc marshalableTyCon :: DynFlags -> TyCon -> Validity marshalableTyCon dflags tc - | isUnLiftedTyCon tc + | isUnliftedTyCon tc , not (isUnboxedTupleTyCon tc) , case tyConPrimRep tc of -- Note [Marshalling VoidRep] VoidRep -> False @@ -2212,7 +2212,7 @@ legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity -- Strictly speaking it is unnecessary to ban unboxed tuples here since -- currently they're of the wrong kind to use in function args anyway. legalFIPrimArgTyCon dflags tc - | isUnLiftedTyCon tc + | isUnliftedTyCon tc , not (isUnboxedTupleTyCon tc) = validIfUnliftedFFITypes dflags | otherwise @@ -2222,7 +2222,7 @@ legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity -- Check result type of 'foreign import prim'. Allow simple unlifted -- types and also unboxed tuple result types '... -> (# , , #)' legalFIPrimResultTyCon dflags tc - | isUnLiftedTyCon tc + | isUnliftedTyCon tc , (isUnboxedTupleTyCon tc || case tyConPrimRep tc of -- Note [Marshalling VoidRep] VoidRep -> False diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 3aa8d78cf2..39d9afc6ef 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -438,7 +438,7 @@ removed the check. See Trac #11120 comment:19. check_lifted ty = do { env <- tcInitOpenTidyEnv (tyCoVarsOfType ty) - ; checkTcM (not (isUnLiftedType ty)) (unliftedArgErr env ty) } + ; checkTcM (not (isUnliftedType ty)) (unliftedArgErr env ty) } unliftedArgErr :: TidyEnv -> Type -> (TidyEnv, SDoc) unliftedArgErr env ty = (env, sep [text "Illegal unlifted type:", ppr_tidy env ty]) @@ -585,7 +585,7 @@ check_arg_type env ctxt rank ty ; check_type env ctxt rank' ty ; check_lifted ty } - -- NB the isUnLiftedType test also checks for + -- NB the isUnliftedType test also checks for -- T State# -- where there is an illegal partial application of State# (which has -- kind * -> #); see Note [The kind invariant] in TyCoRep diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 676d2f9a52..f89de22741 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -51,7 +51,7 @@ module TyCon( isOpenTypeFamilyTyCon, isClosedSynFamilyTyConWithAxiom_maybe, familyTyConInjectivityInfo, isBuiltInSynFamTyCon_maybe, - isUnLiftedTyCon, + isUnliftedTyCon, isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs, isTyConAssoc, tyConAssoc_maybe, isRecursiveTyCon, @@ -574,7 +574,7 @@ data TyCon -- pointers). This 'PrimRep' holds that -- information. Only relevant if tyConKind = # - isUnLifted :: Bool, -- ^ Most primitive tycons are unlifted (may + isUnlifted :: Bool, -- ^ Most primitive tycons are unlifted (may -- not contain bottom) but other are lifted, -- e.g. @RealWorld@ -- Only relevant if tyConKind = * @@ -1250,7 +1250,7 @@ mkPrimTyCon' name kind roles rep is_unlifted rep_nm tyConArity = length roles, tcRoles = roles, primTyConRep = rep, - isUnLifted = is_unlifted, + isUnlifted = is_unlifted, primRepName = rep_nm } @@ -1321,7 +1321,7 @@ makeTyConAbstract tc tyConArity = tyConArity tc, tcRoles = tyConRoles tc, primTyConRep = PtrRep, - isUnLifted = False, + isUnlifted = False, primRepName = Nothing } where name = tyConName tc @@ -1333,13 +1333,13 @@ isPrimTyCon _ = False -- | Is this 'TyCon' unlifted (i.e. cannot contain bottom)? Note that this can -- only be true for primitive and unboxed-tuple 'TyCon's -isUnLiftedTyCon :: TyCon -> Bool -isUnLiftedTyCon (PrimTyCon {isUnLifted = is_unlifted}) +isUnliftedTyCon :: TyCon -> Bool +isUnliftedTyCon (PrimTyCon {isUnlifted = is_unlifted}) = is_unlifted -isUnLiftedTyCon (AlgTyCon { algTcRhs = rhs } ) +isUnliftedTyCon (AlgTyCon { algTcRhs = rhs } ) | TupleTyCon { tup_sort = sort } <- rhs = not (isBoxed (tupleSortBoxity sort)) -isUnLiftedTyCon _ = False +isUnliftedTyCon _ = False -- | Returns @True@ if the supplied 'TyCon' resulted from either a -- @data@ or @newtype@ declaration diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 0b51f5d928..81e5773fa6 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -101,7 +101,7 @@ module Type ( isPiTy, -- (Lifting and boxity) - isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType, + isUnliftedType, isUnboxedTupleType, isAlgType, isClosedAlgType, isPrimitiveType, isStrictType, isLevityTy, isLevityVar, getLevity, getLevityFromKind, @@ -1846,17 +1846,17 @@ pprSourceTyCon tycon -} -- | See "Type#type_classification" for what an unlifted type is -isUnLiftedType :: Type -> Bool - -- isUnLiftedType returns True for forall'd unlifted types: +isUnliftedType :: Type -> Bool + -- isUnliftedType returns True for forall'd unlifted types: -- x :: forall a. Int# -- I found bindings like these were getting floated to the top level. -- They are pretty bogus types, mind you. It would be better never to -- construct them -isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty' -isUnLiftedType (ForAllTy (Named {}) ty) = isUnLiftedType ty -isUnLiftedType (TyConApp tc _) = isUnLiftedTyCon tc -isUnLiftedType _ = False +isUnliftedType ty | Just ty' <- coreView ty = isUnliftedType ty' +isUnliftedType (ForAllTy (Named {}) ty) = isUnliftedType ty +isUnliftedType (TyConApp tc _) = isUnliftedTyCon tc +isUnliftedType _ = False -- | Extract the levity classifier of a type. Panics if this is not possible. getLevity :: String -- ^ Printed in case of an error @@ -1906,10 +1906,10 @@ isClosedAlgType ty -- | Computes whether an argument (or let right hand side) should -- be computed strictly or lazily, based only on its type. --- Currently, it's just 'isUnLiftedType'. +-- Currently, it's just 'isUnliftedType'. isStrictType :: Type -> Bool -isStrictType = isUnLiftedType +isStrictType = isUnliftedType isPrimitiveType :: Type -> Bool -- ^ Returns true of types that are opaque to Haskell. diff --git a/compiler/vectorise/Vectorise/Type/Classify.hs b/compiler/vectorise/Vectorise/Type/Classify.hs index 55eb459e8e..07d8b1fa34 100644 --- a/compiler/vectorise/Vectorise/Type/Classify.hs +++ b/compiler/vectorise/Vectorise/Type/Classify.hs @@ -120,5 +120,5 @@ tyConsOfTypes = unionManyUniqSets . map tyConsOfType -- tyConsOfType :: Type -> UniqSet TyCon tyConsOfType ty = filterUniqSet not_tuple_or_unlifted $ Type.tyConsOfType ty - where not_tuple_or_unlifted tc = not (isUnLiftedTyCon tc || isTupleTyCon tc) + where not_tuple_or_unlifted tc = not (isUnliftedTyCon tc || isTupleTyCon tc) |