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

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 4bfb53b..5aebd37 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -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
 
@@ -897,7 +900,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 +917,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]