X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=f14ab4d98ceeb84a4cf4d25cccdaad78db1860a2;hb=011680bdbd73c93f6fd8363aaef93f995ba8f5b1;hp=3a882a707a11be2e825be63acb59f55d794f38b5;hpb=023b31fe82746b937ab0eba78b11559be782ebcf;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 3a882a7..f14ab4d 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -673,8 +673,13 @@ defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
 
 alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
-dfunInlinePragma   = defaultInlinePragma { inl_rule   = ConLike }
-                                    
+
+-- A DFun has an always-active inline activation so that 
+-- exprIsConApp_maybe can "see" its unfolding
+-- (However, its actual Unfolding is a DFunUnfolding, which is
+--  never inlined other than via exprIsConApp_maybe.)
+dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive
+                                         , inl_rule = ConLike }
 
 isDefaultInlinePragma :: InlinePragma -> Bool
 isDefaultInlinePragma (InlinePragma { inl_act = activation
@@ -701,8 +706,8 @@ setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
 
 instance Outputable Activation where
-   ppr AlwaysActive     = ptext (sLit "ALWAYS")
-   ppr NeverActive      = ptext (sLit "NEVER")
+   ppr AlwaysActive     = brackets (ptext (sLit "ALWAYS"))
+   ppr NeverActive      = brackets (ptext (sLit "NEVER"))
    ppr (ActiveBefore n) = brackets (char '~' <> int n)
    ppr (ActiveAfter n)  = brackets (int n)
 
@@ -713,18 +718,18 @@ instance Outputable RuleMatchInfo where
 instance Outputable InlinePragma where
   ppr (InlinePragma { inl_inline = inline, inl_act = activation
                     , inl_rule = info, inl_sat = mb_arity })
-    = pp_inline <> pp_activation <+> pp_sat <+> pp_info 
+    = pp_inl_act (inline, activation) <+> pp_sat <+> pp_info 
     where
-      pp_inline | inline    = ptext (sLit "INLINE")
-                | otherwise = ptext (sLit "NOINLINE")
+      pp_inl_act (False, AlwaysActive)  = empty	-- defaultInlinePragma
+      pp_inl_act (False, NeverActive)   = ptext (sLit "NOINLINE")
+      pp_inl_act (False, act)           = ptext (sLit "NOINLINE") <> ppr act
+      pp_inl_act (True,  AlwaysActive)  = ptext (sLit "INLINE")
+      pp_inl_act (True,  act)           = ptext (sLit "INLINE") <> ppr act
+
       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
              | otherwise           = empty
       pp_info | isFunLike info = empty
               | otherwise      = ppr info
-      pp_activation 
-        | inline     && isAlwaysActive activation = empty
-        | not inline && isNeverActive  activation = empty
-        | otherwise                               = ppr activation    
 
 isActive :: CompilerPhase -> Activation -> Bool
 isActive _ NeverActive      = False