X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecialise.lhs;h=d73856585674f815de8cfa3bb0f58558043cf187;hb=99d1354f70b94951fa8f7401ba82881a317b6a55;hp=c51b27de3f1688605f66f78bd31818e37640471a;hpb=72462499b891d5779c19f3bda03f96e24f9554ae;p=ghc-hetmet.git

diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index c51b27d..d738565 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -29,7 +29,6 @@ import Name
 import MkId		( voidArgId, realWorldPrimId )
 import FiniteMap
 import Maybes		( catMaybes, isJust )
-import BasicTypes	( Arity )
 import Bag
 import Util
 import Outputable
@@ -801,7 +800,7 @@ specDefn subst body_uds fn rhs
   where
     fn_type	       = idType fn
     fn_arity	       = idArity fn
-    fn_unf             = idUnfolding fn
+    fn_unf             = realIdUnfolding fn	-- Ignore loop-breaker-ness here
     (tyvars, theta, _) = tcSplitSigmaTy fn_type
     n_tyvars	       = length tyvars
     n_dicts	       = length theta
@@ -809,15 +808,12 @@ specDefn subst body_uds fn rhs
 
 	-- Figure out whether the function has an INLINE pragma
 	-- See Note [Inline specialisations]
-    fn_has_inline_rule :: Maybe (InlineRuleInfo, Arity)	 -- Gives arity of the *specialised* inline rule
-    fn_has_inline_rule
-      | Just inl <- isInlineRule_maybe fn_unf 
-      = case inl of
-      	   InlWrapper _ -> Just (InlUnSat, spec_arity)
-	   _            -> Just (inl,      spec_arity)
-      | otherwise = Nothing
-      where
-        spec_arity = unfoldingArity fn_unf - n_dicts
+    fn_has_inline_rule :: Maybe Bool	-- Derive sat-flag from existing thing
+    fn_has_inline_rule = case isInlineRule_maybe fn_unf of
+                           Just (_,sat) -> Just sat
+			   Nothing      -> Nothing
+
+    spec_arity = unfoldingArity fn_unf - n_dicts  -- Arity of the *specialised* inline rule
 
     (rhs_tyvars, rhs_ids, rhs_body) = collectTyAndValBinders rhs
 
@@ -829,7 +825,8 @@ specDefn subst body_uds fn rhs
 
     already_covered :: [CoreExpr] -> Bool
     already_covered args	  -- Note [Specialisations already covered]
-       = isJust (lookupRule (const True) (substInScope subst) 
+       = isJust (lookupRule (const True) realIdUnfolding 
+                            (substInScope subst) 
        	 		    fn args (idCoreRules fn))
 
     mk_ty_args :: [Maybe Type] -> [CoreExpr]
@@ -910,9 +907,9 @@ specDefn subst body_uds fn rhs
 	   	final_uds = foldr consDictBind rhs_uds dx_binds
 
 		-- See Note [Inline specialisations]
-		final_spec_f | Just (inl, spec_arity) <- fn_has_inline_rule
+		final_spec_f | Just sat <- fn_has_inline_rule
 			     = spec_f_w_arity `setInlineActivation` inline_act
-			               	      `setIdUnfolding` mkInlineRule inl spec_rhs spec_arity
+			               	      `setIdUnfolding` mkInlineRule sat spec_rhs spec_arity
 					      	-- I'm not sure this should be unconditionally InlSat
 			     | otherwise 
 			     = spec_f_w_arity