Fix a long-standing infelicity in the type pretty printer

[ghc-hetmet.git] / compiler / specialise / Specialise.lhs

diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index b772a3f..ad641d4 100644 (file)
--- 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]
@@ -938,7 +939,7 @@ bindAuxiliaryDicts subst triples = go subst [] triples
              -- No auxiliary binding necessary
       | otherwise        = go subst_w_unf (NonRec dx_id dx : binds) pairs
       where
-        dx_id1 = dx_id `setIdUnfolding` mkUnfolding False dx
+        dx_id1 = dx_id `setIdUnfolding` mkUnfolding False False dx
        subst_w_unf = extendIdSubst subst d (Var dx_id1)
                     -- Important!  We're going to substitute dx_id1 for d
             -- and we want it to look "interesting", else we won't gather *any*