X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FMkId.lhs;h=7d472b12e9c64b4baf0868a555793b0a63dbe197;hb=74d5597ec6069dab0aacb0b7c23d68b54d0f3bb4;hp=665b898fa01a4d99c5410bf1d2a51fc740b6e689;hpb=0a8ad35fdcee761755e53270b2474c9b13a055dd;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 665b898..7d472b1 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -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