X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecialise.lhs;h=d73856585674f815de8cfa3bb0f58558043cf187;hb=8b9bb4690b3252a3b0413a4fb208e2e840692e64;hp=b772a3f25cefe9a71c167464d06a672b9a15c67c;hpb=a263737bbf44050a7b5ecbe267ddf85d410b73e5;p=ghc-hetmet.git diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs index b772a3f..d738565 100644 --- a/compiler/specialise/Specialise.lhs +++ b/compiler/specialise/Specialise.lhs @@ -800,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 @@ -808,7 +808,7 @@ specDefn subst body_uds fn rhs -- Figure out whether the function has an INLINE pragma -- See Note [Inline specialisations] - fn_has_inline_rule :: Maybe InlSatFlag -- Derive sat-flag from existing thing + 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 @@ -825,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]