Commit 74d5597e authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Don't expose the unfolding of dictionary selectors without -O

When compiling without -O we were getting code like this

	f x = case GHC.Base.$f20 of
		  :DEq eq neq -> eq x x

But because of the -O the $f20 dictionary is not available, so exposing
the dictionary selector was useless.  Yet it makes the code bigger!
Better to get
	f x = GHC.Base.== GHC.Bsae.$f20 x x

This patch suppresses the implicit unfolding for dictionary selectors
when compiling without -O.  We could do the same for other implicit
Ids, but this will do for now.

There should be no effect when compiling with -O.  Programs should
be smaller without -O and may run a tiny bit slower.
parent 0a8ad35f
......@@ -827,8 +827,11 @@ at the outside. When dealing with classes it's very convenient to
recover the original type signature from the class op selector.
\begin{code}
mkDictSelId :: Name -> Class -> Id
mkDictSelId name clas
mkDictSelId :: Bool -- True <=> don't include the unfolding
-- Little point on imports without -O, because the
-- dictionary itself won't be visible
-> Name -> Class -> Id
mkDictSelId no_unf name clas
= mkGlobalId (ClassOpId clas) name sel_ty info
where
sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
......@@ -840,8 +843,9 @@ mkDictSelId name clas
info = noCafIdInfo
`setArityInfo` 1
`setUnfoldingInfo` mkTopUnfolding rhs
`setAllStrictnessInfo` Just strict_sig
`setUnfoldingInfo` (if no_unf then noUnfolding
else mkTopUnfolding rhs)
-- We no longer use 'must-inline' on record selectors. They'll
-- inline like crazy if they scrutinise a constructor
......
......@@ -242,14 +242,17 @@ mkTyConSelIds tycon rhs
------------------------------------------------------
\begin{code}
buildClass :: Name -> [TyVar] -> ThetaType
buildClass :: Bool -- True <=> do not include unfoldings
-- on dict selectors
-- Used when importing a class without -O
-> Name -> [TyVar] -> ThetaType
-> [FunDep TyVar] -- Functional dependencies
-> [TyThing] -- Associated types
-> [(Name, DefMeth, Type)] -- Method info
-> RecFlag -- Info for type constructor
-> TcRnIf m n Class
buildClass class_name tvs sc_theta fds ats sig_stuff tc_isrec
buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec
= do { traceIf (text "buildClass")
; tycon_name <- newImplicitBinder class_name mkClassTyConOcc
; datacon_name <- newImplicitBinder class_name mkClassDataConOcc
......@@ -261,7 +264,7 @@ buildClass class_name tvs sc_theta fds ats sig_stuff tc_isrec
let { rec_tycon = classTyCon rec_clas
; op_tys = [ty | (_,_,ty) <- sig_stuff]
; op_items = [ (mkDictSelId op_name rec_clas, dm_info)
; op_items = [ (mkDictSelId no_unf op_name rec_clas, dm_info)
| (op_name, dm_info, _) <- sig_stuff ] }
-- Build the selector id and default method id
......@@ -283,7 +286,7 @@ buildClass class_name tvs sc_theta fds ats sig_stuff tc_isrec
-- D_sc1, D_sc2
-- (We used to call them D_C, but now we can have two different
-- superclasses both called C!)
; let sc_sel_ids = [mkDictSelId sc_name rec_clas | sc_name <- sc_sel_names]
; let sc_sel_ids = [mkDictSelId no_unf sc_name rec_clas | sc_name <- sc_sel_names]
-- Use a newtype if the class constructor has exactly one field:
-- i.e. exactly one operation or superclass taken together
......
......@@ -423,7 +423,7 @@ tcIfaceDecl ignore_prags
; fds <- mapM tc_fd rdr_fds
; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
; cls <- buildClass cls_name tyvars ctxt fds ats sigs tc_isrec
; cls <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
; return (AClass cls) }
where
tc_sig (IfaceClassOp occ dm rdr_ty)
......
......@@ -776,7 +776,8 @@ tcTyClDecl1 calc_isrec
tycon_name = tyConName (classTyCon clas)
tc_isrec = calc_isrec tycon_name
in
buildClass class_name tvs' ctxt' fds' ats'
buildClass False {- Must include unfoldings for selectors -}
class_name tvs' ctxt' fds' ats'
sig_stuff tc_isrec)
; return (AClass clas : ats')
-- NB: Order is important due to the call to `mkGlobalThings' when
......
Supports Markdown
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