X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=a2517342e74289cebaee36b66a832cfbedb3fab6;hb=fbff1b7b9c89f6369c4394a0b10fa7c06e011698;hp=4bfb53b43b0364442c13bcacc2de16adcf906bf4;hpb=a3bab0506498db41853543558c52a4fda0d183af;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 4bfb53b..a251734 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -13,7 +13,7 @@ have a standard form, namely:
 
 \begin{code}
 module MkId (
-        mkDictFunId, mkDictFunTy, mkDefaultMethodId, mkDictSelId,
+        mkDictFunId, mkDictFunTy, mkDictSelId,
 
         mkDataConIds,
         mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
@@ -235,9 +235,9 @@ mkDataConIds wrap_name wkr_name data_con
 
     wkr_arity = dataConRepArity data_con
     wkr_info  = noCafIdInfo
-                `setArityInfo`          wkr_arity
+                `setArityInfo`       wkr_arity
                 `setStrictnessInfo`  Just wkr_sig
-                `setUnfoldingInfo`      evaldUnfolding  -- Record that it's evaluated,
+                `setUnfoldingInfo`   evaldUnfolding  -- Record that it's evaluated,
                                                         -- even if arity = 0
 
     wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
@@ -270,6 +270,7 @@ mkDataConIds wrap_name wkr_name data_con
     nt_work_id   = mkGlobalId (DataConWrapId data_con) wkr_name wrap_ty nt_work_info
     nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo
                   `setArityInfo` 1      -- Arity 1
+                  `setInlinePragInfo`    alwaysInlinePragma
                   `setUnfoldingInfo`     newtype_unf
     id_arg1      = mkTemplateLocal 1 (head orig_arg_tys)
     newtype_unf  = ASSERT2( isVanillaDataCon data_con &&
@@ -433,19 +434,21 @@ mkDictSelId no_unf name clas
 
     base_info = noCafIdInfo
                 `setArityInfo`      1
-                `setStrictnessInfo`  Just strict_sig
+                `setStrictnessInfo` Just strict_sig
                 `setUnfoldingInfo`  (if no_unf then noUnfolding
-				     else mkImplicitUnfolding rhs)
+	                             else mkImplicitUnfolding rhs)
 		   -- In module where class op is defined, we must add
 		   -- the unfolding, even though it'll never be inlined
 		   -- becuase we use that to generate a top-level binding
 		   -- for the ClassOp
 
-    info = base_info    `setSpecInfo`       mkSpecInfo [rule]
-			`setInlinePragInfo` neverInlinePragma
-		-- Add a magic BuiltinRule, and never inline it
-		-- so that the rule is always available to fire.
-		-- See Note [ClassOp/DFun selection] in TcInstDcls
+    info | new_tycon = base_info `setInlinePragInfo` alwaysInlinePragma
+    	   	   -- See Note [Single-method classes] for why alwaysInlinePragma
+         | otherwise = base_info  `setSpecInfo`       mkSpecInfo [rule]
+		       		  `setInlinePragInfo` neverInlinePragma
+		   -- Add a magic BuiltinRule, and never inline it
+		   -- so that the rule is always available to fire.
+		   -- See Note [ClassOp/DFun selection] in TcInstDcls
 
     n_ty_args = length tyvars
 
@@ -823,11 +826,6 @@ BUT make sure they are *exported* LocalIds (mkExportedLocalId) so
 that they aren't discarded by the occurrence analyser.
 
 \begin{code}
-mkDefaultMethodId :: Id		-- Selector Id
-		  -> Name	-- Default method name
-		  -> Id		-- Default method Id
-mkDefaultMethodId sel_id dm_name = mkExportedLocalId dm_name (idType sel_id)
-
 mkDictFunId :: Name      -- Name to use for the dict fun;
             -> [TyVar]
             -> ThetaType
@@ -897,7 +895,8 @@ unsafeCoerceId :: Id
 unsafeCoerceId
   = pcMiscPrelId unsafeCoerceName ty info
   where
-    info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
            
 
     ty  = mkForAllTys [argAlphaTyVar,openBetaTyVar]
@@ -913,15 +912,16 @@ nullAddrId :: Id
 -- a way to write this literal in Haskell.
 nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
   where
-    info = noCafIdInfo `setUnfoldingInfo` 
-           mkCompulsoryUnfolding (Lit nullAddrLit)
+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)
 
 ------------------------------------------------
 seqId :: Id	-- See Note [seqId magic]
 seqId = pcMiscPrelId seqName ty info
   where
-    info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
-                       `setSpecInfo` mkSpecInfo [seq_cast_rule]
+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
+                       `setSpecInfo`       mkSpecInfo [seq_cast_rule]
            
 
     ty  = mkForAllTys [alphaTyVar,argBetaTyVar]