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

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 15725fd..f14ab4d 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -58,7 +58,7 @@ module BasicTypes(
 	Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
         RuleMatchInfo(..), isConLike, isFunLike, 
         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma,
-	isDefaultInlinePragma, isInlinePragma,
+	isDefaultInlinePragma, isInlinePragma, inlinePragmaSat,
         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
 
@@ -597,6 +597,8 @@ data InlinePragma  	     -- Note [InlinePragma]
   = InlinePragma
       { inl_inline :: Bool           -- True <=> INLINE, 
       		      		     -- False <=> no pragma at all, or NOINLINE
+      , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n 
+      		      	    	     --            explicit (non-type, non-dictionary) args
       , inl_act    :: Activation     -- Says during which phases inlining is allowed
       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
     } deriving( Eq )
@@ -615,6 +617,8 @@ If you write nothing at all, you get defaultInlinePragma:
 It's not possible to get that combination by *writing* something, so 
 if an Id has defaultInlinePragma it means the user didn't specify anything.
 
+If inl_inline = True, then the Id should have an InlineRule unfolding.
+
 Note [CONLIKE pragma]
 ~~~~~~~~~~~~~~~~~~~~~
 The ConLike constructor of a RuleMatchInfo is aimed at the following.
@@ -662,15 +666,20 @@ isFunLike _            = False
 
 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
   :: InlinePragma
-defaultInlinePragma 
-  = InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = False }
-alwaysInlinePragma
-  = InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = True }
-neverInlinePragma   
-   = InlinePragma { inl_act = NeverActive, inl_rule = FunLike, inl_inline = False }
-dfunInlinePragma   
-   = InlinePragma { inl_act = AlwaysActive, inl_rule = ConLike, inl_inline = False }
-                                    
+defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
+                                   , inl_rule = FunLike
+                                   , inl_inline = False
+                                   , inl_sat = Nothing }
+
+alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
+neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
+
+-- 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
@@ -681,6 +690,9 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation
 isInlinePragma :: InlinePragma -> Bool
 isInlinePragma prag = inl_inline prag
 
+inlinePragmaSat :: InlinePragma -> Maybe Arity
+inlinePragmaSat = inl_sat
+
 inlinePragmaActivation :: InlinePragma -> Activation
 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
 
@@ -694,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)
 
@@ -704,17 +716,20 @@ instance Outputable RuleMatchInfo where
    ppr FunLike = ptext (sLit "FUNLIKE")
 
 instance Outputable InlinePragma where
-  ppr (InlinePragma { inl_inline = inline, inl_act = activation, inl_rule = info })
-    = pp_inline <+> pp_info <+> pp_activation
+  ppr (InlinePragma { inl_inline = inline, inl_act = activation
+                    , inl_rule = info, inl_sat = mb_arity })
+    = 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