Ensure runhaskell is rebuild in stage2

[ghc-hetmet.git] / compiler / coreSyn / CoreUnfold.lhs

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index 1bc945d..5797cba 100644 (file)
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -27,12 +27,10 @@ module CoreUnfold (
        couldBeSmallEnoughToInline, 
        certainlyWillInline, smallEnoughToInline,
 
-       callSiteInline, CallContInfo(..)
+       callSiteInline, CallCtxt(..)
 
     ) where
 
-#include "HsVersions.h"
-
 import StaticFlags
 import DynFlags
 import CoreSyn
@@ -48,6 +46,7 @@ import Type
 import PrelNames
 import Bag
 import FastTypes
+import FastString
 import Outputable
 
 \end{code}
@@ -85,11 +84,11 @@ mkUnfolding top_lvl expr
        -- it gets fixed up next round
 
 instance Outputable Unfolding where
-  ppr NoUnfolding = ptext SLIT("No unfolding")
-  ppr (OtherCon cs) = ptext SLIT("OtherCon") <+> ppr cs
-  ppr (CompulsoryUnfolding e) = ptext SLIT("Compulsory") <+> ppr e
+  ppr NoUnfolding = ptext (sLit "No unfolding")
+  ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs
+  ppr (CompulsoryUnfolding e) = ptext (sLit "Compulsory") <+> ppr e
   ppr (CoreUnfolding e top hnf cheap g) 
-       = ptext SLIT("Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g, 
+       = ptext (sLit "Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g, 
                                     ppr e]
 
 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
@@ -106,9 +105,9 @@ mkCompulsoryUnfolding expr  -- Used for things that absolutely must be unfolded
 
 \begin{code}
 instance Outputable UnfoldingGuidance where
-    ppr UnfoldNever    = ptext SLIT("NEVER")
+    ppr UnfoldNever    = ptext (sLit "NEVER")
     ppr (UnfoldIfGoodArgs v cs size discount)
-      = hsep [ ptext SLIT("IF_ARGS"), int v,
+      = hsep [ ptext (sLit "IF_ARGS"), int v,
               brackets (hsep (map int cs)),
               int size,
               int discount ]
@@ -513,19 +512,25 @@ callSiteInline :: DynFlags
               -> Id                    -- The Id
               -> Bool                  -- True if there are are no arguments at all (incl type args)
               -> [Bool]                -- One for each value arg; True if it is interesting
-              -> CallContInfo          -- True <=> continuation is interesting
+              -> CallCtxt              -- True <=> continuation is interesting
               -> Maybe CoreExpr        -- Unfolding, if any
 
 
-data CallContInfo = BoringCont         
-                 | InterestingCont     -- Somewhat interesting
-                 | CaseCont            -- Very interesting; the argument of a case
-                                       -- that decomposes its scrutinee
+data CallCtxt = BoringCtxt
+
+             | ArgCtxt Bool    -- We're somewhere in the RHS of function with rules
+                               --      => be keener to inline
+                       Int     -- We *are* the argument of a function with this arg discount
+                               --      => be keener to inline
+               -- INVARIANT: ArgCtxt False 0 ==> BoringCtxt
+
+             | CaseCtxt        -- We're the scrutinee of a case
+                               -- that decomposes its scrutinee
 
-instance Outputable CallContInfo where
-  ppr BoringCont      = ptext SLIT("BoringCont")
-  ppr InterestingCont = ptext SLIT("InterestingCont")
-  ppr CaseCont               = ptext SLIT("CaseCont")
+instance Outputable CallCtxt where
+  ppr BoringCtxt    = ptext (sLit "BoringCtxt")
+  ppr (ArgCtxt _ _) = ptext (sLit "ArgCtxt")
+  ppr CaseCtxt             = ptext (sLit "CaseCtxt")
 
 callSiteInline dflags active_inline id lone_variable arg_infos cont_info
   = case idUnfolding id of {
@@ -588,17 +593,18 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 
                    interesting_saturated_call 
                        = case cont_info of
-                           BoringCont -> not is_top && n_vals_wanted > 0       -- Note [Nested functions] 
-                           CaseCont   -> not lone_variable || not is_value     -- Note [Lone variables]
-                           InterestingCont -> n_vals_wanted > 0
+                           BoringCtxt -> not is_top && n_vals_wanted > 0       -- Note [Nested functions] 
+                           CaseCtxt   -> not lone_variable || not is_value     -- Note [Lone variables]
+                           ArgCtxt {} -> True
+                               -- Was: n_vals_wanted > 0; but see test eyeball/inline1.hs
 
                    small_enough = (size - discount) <= opt_UF_UseThreshold
                    discount = computeDiscount n_vals_wanted arg_discounts 
                                               res_discount' arg_infos
                    res_discount' = case cont_info of
-                                       BoringCont      -> 0
-                                       CaseCont        -> res_discount
-                                       InterestingCont -> 4 `min` res_discount
+                                       BoringCtxt  -> 0
+                                       CaseCtxt    -> res_discount
+                                       ArgCtxt _ _ -> 4 `min` res_discount
                        -- res_discount can be very large when a function returns
                        -- construtors; but we only want to invoke that large discount
                        -- when there's a case continuation.