mkUsgTy, UsageAnn(..)
)
import Module ( Module )
-import CoreUnfold ( mkUnfolding )
+import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding )
import Subst ( mkTopTyVarSubst, substTheta )
import TyCon ( TyCon, isNewTyCon, tyConDataCons, isDataTyCon )
-import Class ( Class, classBigSig, classTyCon )
+import Class ( Class, classBigSig, classTyCon, classTyVars, classSelIds )
import Var ( Id, TyVar )
import VarSet ( isEmptyVarSet )
import Const ( Con(..) )
`setArityInfo` exactArity (n_dicts + n_ex_dicts + n_id_args)
`setUnfoldingInfo` unfolding
where
- unfolding = mkUnfolding (Note InlineMe con_rhs)
+ unfolding = mkTopUnfolding (Note InlineMe con_rhs)
+ -- The dictionary constructors of a class don't get a binding,
+ -- but they are always saturated, so they should always be inlined.
(tyvars, theta, ex_tyvars, ex_theta, orig_arg_tys, tycon)
= dataConSig data_con
-- ToDo: consider adding further IdInfo
- unfolding = mkUnfolding sel_rhs
+ unfolding = mkTopUnfolding sel_rhs
(tyvars, theta, tau) = splitSigmaTy selector_ty
(data_ty,rhs_ty) = expectJust "StdIdInfoRec" (splitFunTy_maybe tau)
-- ToDo: consider adding further IdInfo
- unfolding = mkUnfolding sel_rhs
+ unfolding = mkTopUnfolding sel_rhs
(tyvars, theta, tau) = splitSigmaTy selector_ty
(data_ty,rhs_ty) = expectJust "StdIdInfoRec" (splitFunTy_maybe tau)
where
sel_id = mkId name ty info
field_lbl = mkFieldLabel name ty tag
- tag = assoc "MkId.mkDictSelId" ((sc_sel_ids ++ op_sel_ids) `zip` allFieldLabelTags) sel_id
+ tag = assoc "MkId.mkDictSelId" (classSelIds clas `zip` allFieldLabelTags) sel_id
info = mkIdInfo (RecordSelId field_lbl)
`setUnfoldingInfo` unfolding
-- We no longer use 'must-inline' on record selectors. They'll
-- inline like crazy if they scrutinise a constructor
- unfolding = mkUnfolding rhs
+ unfolding = mkTopUnfolding rhs
- (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
+ tyvars = classTyVars clas
tycon = classTyCon clas
[data_con] = tyConDataCons tycon
info = mkIdInfo (ConstantId (PrimOp prim_op))
`setUnfoldingInfo` unfolding
- `setInlinePragInfo` IMustBeINLINEd
- -- The pragma @IMustBeINLINEd@ says that this Id absolutely
+
+ unfolding = mkCompulsoryUnfolding rhs
+ -- The mkCompulsoryUnfolding says that this Id absolutely
-- must be inlined. It's only used for primitives,
-- because we don't want to make a closure for each of them.
-
-
- unfolding = mkUnfolding rhs
args = mkTemplateLocals arg_tys
rhs = mkLams tyvars $ mkLams args $
mkDictFunId dfun_name clas inst_tyvars inst_tys inst_decl_theta
= mkVanillaId dfun_name dfun_ty
where
- (class_tyvars, sc_theta, _, _, _) = classBigSig clas
+ (class_tyvars, sc_theta, _, _) = classBigSig clas
sc_theta' = substTheta (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
dfun_theta = case inst_decl_theta of
= pcMiscPrelId unsafeCoerceIdKey pREL_GHC SLIT("unsafeCoerce#") ty info
where
info = vanillaIdInfo
- `setUnfoldingInfo` mkUnfolding rhs
- `setInlinePragInfo` IMustBeINLINEd
+ `setUnfoldingInfo` mkCompulsoryUnfolding rhs
ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
= pcMiscPrelId getTagIdKey pREL_GHC SLIT("getTag#") ty info
where
info = vanillaIdInfo
- `setUnfoldingInfo` mkUnfolding rhs
- `setInlinePragInfo` IMustBeINLINEd
+ `setUnfoldingInfo` mkCompulsoryUnfolding rhs
-- We don't provide a defn for this; you must inline it
ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)