Commit 4faa1a63 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Ben Gamari

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
parent 45c6fbc5
......@@ -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]
......
......@@ -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
......
......@@ -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
......
......@@ -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] -> '>'
......
......@@ -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))
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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),
......
......@@ -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
......
......@@ -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
{-
......
......@@ -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
......
......@@ -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))
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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),
......
......@@ -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)))
$$
......
......@@ -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
......
......@@ -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 #)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 ;
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 } )