X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecialise.lhs;h=5d780ea212cc267b49fc4d97cee5d01f3c9b0837;hp=ad641d4c93e4419f5cc11f6b7272ea146952a030;hb=76dfa3944cbf149a30398d29e6762a44772c0174;hpb=c56450419ef6c819ad86ab01dca6fd2966b11305

diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index ad641d4..5d780ea 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -29,6 +29,7 @@ import Name
 import MkId		( voidArgId, realWorldPrimId )
 import FiniteMap
 import Maybes		( catMaybes, isJust )
+import BasicTypes	( isNeverActive, inlinePragmaActivation )
 import Bag
 import Util
 import Outputable
@@ -773,6 +774,9 @@ specDefn subst body_uds fn rhs
   |  rhs_tyvars `lengthIs`     n_tyvars -- Rhs of fn's defn has right number of big lambdas
   && rhs_ids    `lengthAtLeast` n_dicts	-- and enough dict args
   && notNull calls_for_me		-- And there are some calls to specialise
+  && not (isNeverActive (idInlineActivation fn))
+	-- Don't specialise NOINLINE things
+	-- See Note [Auto-specialisation and RULES]
 
 --   && not (certainlyWillInline (idUnfolding fn))	-- And it's not small
 --	See Note [Inline specialisation] for why we do not 
@@ -804,7 +808,7 @@ specDefn subst body_uds fn rhs
     (tyvars, theta, _) = tcSplitSigmaTy fn_type
     n_tyvars	       = length tyvars
     n_dicts	       = length theta
-    inline_act         = idInlineActivation fn
+    inl_act            = inlinePragmaActivation (idInlinePragma fn)
 
 	-- Figure out whether the function has an INLINE pragma
 	-- See Note [Inline specialisations]
@@ -886,10 +890,6 @@ specDefn subst body_uds fn rhs
 	         spec_id_ty = mkPiTypes lam_args body_ty
 	
            ; spec_f <- newSpecIdSM fn spec_id_ty
-  	   ; let spec_f_w_arity = setIdArity spec_f (max 0 (fn_arity - n_dicts))
-		-- Adding arity information just propagates it a bit faster
-		-- See Note [Arity decrease] in Simplify
-
            ; (spec_rhs, rhs_uds) <- specExpr rhs_subst2 (mkLams lam_args body)
 	   ; let
 		-- The rule to put in the function's specialisation is:
@@ -897,20 +897,26 @@ specDefn subst body_uds fn rhs
 	        rule_name = mkFastString ("SPEC " ++ showSDoc (ppr fn <+> ppr spec_ty_args))
   		spec_env_rule = mkLocalRule
 			          rule_name
-				  inline_act 	-- Note [Auto-specialisation and RULES]
+				  inl_act 	-- Note [Auto-specialisation and RULES]
 			 	  (idName fn)
 			          (poly_tyvars ++ inst_dict_ids)
 				  inst_args 
-				  (mkVarApps (Var spec_f_w_arity) app_args)
+				  (mkVarApps (Var spec_f) app_args)
 
 		-- Add the { d1' = dx1; d2' = dx2 } usage stuff
 	   	final_uds = foldr consDictBind rhs_uds dx_binds
 
+		-- Adding arity information just propagates it a bit faster
+		-- 	See Note [Arity decrease] in Simplify
+		-- Copy InlinePragma information from the parent Id.
+		-- So if f has INLINE[1] so does spec_f
+  	        spec_f_w_arity = spec_f `setIdArity`          max 0 (fn_arity - n_dicts)
+                                        `setInlineActivation` inl_act
+
+		-- Add an InlineRule if the parent has one
 		-- See Note [Inline specialisations]
 		final_spec_f | Just sat <- fn_has_inline_rule
-			     = spec_f_w_arity `setInlineActivation` inline_act
-			               	      `setIdUnfolding` mkInlineRule sat spec_rhs spec_arity
-					      	-- I'm not sure this should be unconditionally InlSat
+			     = spec_f_w_arity `setIdUnfolding` mkInlineRule sat spec_rhs spec_arity
 			     | otherwise 
 			     = spec_f_w_arity
 	   ; return (Just ((final_spec_f, spec_rhs), final_uds, spec_env_rule)) } }
@@ -1112,10 +1118,14 @@ also add
 	RULE f g_spec = 0
 
 But that's a bit complicated.  For now we ask the programmer's help,
-by *copying the INLINE activation pragma* to the auto-specialised rule.
-So if g says {-# NOINLINE[2] g #-}, then the auto-spec rule will also
-not be active until phase 2.  
+by *copying the INLINE activation pragma* to the auto-specialised
+rule.  So if g says {-# NOINLINE[2] g #-}, then the auto-spec rule
+will also not be active until phase 2.  And that's what programmers
+should jolly well do anyway, even aside from specialisation, to ensure
+that g doesn't inline too early.
 
+This in turn means that the RULE would never fire for a NOINLINE
+thing so not much point in generating a specialisation at all.
 
 Note [Specialisation shape]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1141,13 +1151,12 @@ It's a silly exapmle, but we get
 where choose doesn't have any dict arguments.  Thus far I have not
 tried to fix this (wait till there's a real example).
 
-
 Note [Inline specialisations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We transfer to the specialised function any INLINE stuff from the
-original.  This means (a) the Activation in the IdInfo, and (b) any
-InlineMe on the RHS.  We do not, however, transfer the RuleMatchInfo
-since we do not expect the specialisation to occur in rewrite rules.
+original.  This means 
+   (a) the Activation for its inlining (from its InlinePragma)
+   (b) any InlineRule
 
 This is a change (Jun06).  Previously the idea is that the point of
 inlining was precisely to specialise the function at its call site,
@@ -1166,9 +1175,6 @@ arguments alone are enough to specialise (even though the args are too
 boring to trigger inlining), and it's certainly better to call the 
 specialised version.
 
-A case in point is dictionary functions, which are current marked
-INLINE, but which are worth specialising.
-
 
 %************************************************************************
 %*									*