X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplVar.lhs;h=99f3e4c8e920c9415bdb5abd640ccac0c840fcf1;hb=1fb1ab5d53a09607e7f6d2450806760688396387;hp=4e4ef5582a2ce436ac061176ce3383c0c3615343;hpb=12899612693163154531da3285ec99c1c8ca2226;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SimplVar.lhs b/ghc/compiler/simplCore/SimplVar.lhs
index 4e4ef55..99f3e4c 100644
--- a/ghc/compiler/simplCore/SimplVar.lhs
+++ b/ghc/compiler/simplCore/SimplVar.lhs
@@ -13,19 +13,19 @@ module SimplVar (
 IMP_Ubiq(){-uitous-}
 IMPORT_DELOOPER(SmplLoop)		( simplExpr )
 
-import CgCompInfo	( uNFOLDING_USE_THRESHOLD,
+import Constants	( uNFOLDING_USE_THRESHOLD,
 			  uNFOLDING_CON_DISCOUNT_WEIGHT
 			)
 import CmdLineOpts	( switchIsOn, SimplifierSwitch(..) )
 import CoreSyn
-import CoreUnfold	( Unfolding(..), UnfoldingGuidance(..), SimpleUnfolding(..),
+import CoreUnfold	( Unfolding(..), UfExpr, RdrName, UnfoldingGuidance(..), SimpleUnfolding(..),
 			  FormSummary,
-			  smallEnoughToInline )
-import BinderInfo	( BinderInfo, noBinderInfo, okToInline )
+			  okToInline, smallEnoughToInline )
+import BinderInfo	( BinderInfo, noBinderInfo )
 
 import CostCentre	( CostCentre, noCostCentreAttached )
 import Id		( idType, getIdInfo, getIdUnfolding, getIdSpecialisation,
-			  GenId{-instance Outputable-}
+			  idMustBeINLINEd, GenId{-instance Outputable-}
 			)
 import SpecEnv		( SpecEnv, lookupSpecEnv )
 import IdInfo		( DeforestInfo(..) )
@@ -33,11 +33,10 @@ import Literal		( isNoRepLit )
 import MagicUFs		( applyMagicUnfoldingFun, MagicUnfoldingFun )
 import PprStyle		( PprStyle(..) )
 import PprType		( GenType{-instance Outputable-} )
-import Pretty		( ppBesides, ppStr )
+--import Pretty		( ppBesides, ppStr )
 import SimplEnv
 import SimplMonad
 import TyCon		( tyConFamilySize )
-import Type		( isPrimType, getAppDataTyConExpandingDicts, maybeAppDataTyConExpandingDicts )
 import Util		( pprTrace, assertPanic, panic )
 import Maybes		( maybeToBool )
 \end{code}
@@ -59,9 +58,25 @@ completeVar env var args
 
   | not do_deforest &&
     maybeToBool maybe_unfolding_info &&
-    (always_inline || (ok_to_inline && not essential_unfoldings_only)) && 
+    (not essential_unfoldings_only || idMustBeINLINEd var) && 
+    ok_to_inline &&
+	-- If "essential_unfolds_only" is true we do no inlinings at all,
+	-- EXCEPT for things that absolutely have to be done
+	-- (see comments with idMustBeINLINEd)
+	--
+	-- Need to be careful: the RHS of INLINE functions is protected against inlining
+	-- by essential_unfoldings_only being set true; we must not inline workers back into
+	-- wrappers, even thouth the former have an unfold-always guidance.
     costCentreOk (getEnclosingCC env) (getEnclosingCC unfold_env)
   = tick UnfoldingDone	`thenSmpl_`
+#ifdef DEBUG
+--    simplCount		`thenSmpl` \ n ->
+--    (if n > 3000 then
+--	pprTrace "Ticks > 3000 and unfolding" (ppr PprDebug var)
+--    else
+--	id
+--    )
+#endif
     simplExpr unfold_env unf_template args
 
   | maybeToBool maybe_specialisation
@@ -86,10 +101,17 @@ completeVar env var args
 	---------- Unfolding stuff
     maybe_unfolding_info 
 	= case (lookupOutIdEnv env var, unfolding_from_id) of
+
 	     (Just (_, occ_info, OutUnfolding enc_cc unf), _)
 		-> Just (occ_info, setEnclosingCC env enc_cc, unf)	
+
 	     (Just (_, occ_info, InUnfolding env_unf unf), _)
-		-> Just (occ_info, combineSimplEnv env env_unf, unf)	
+		-> Just (occ_info, env_unf, unf)	
+-- 			This combineSimplEnv is WRONG.  InUnfoldings are used for
+--			recursive decls, and we're relying on using the old unfold enf
+--			to avoid getting outselves in a loop!
+--		-> Just (occ_info, combineSimplEnv env env_unf, unf)	
+
 	     (_, CoreUnfolding unf)
 		-> Just (noBinderInfo, env, unf)
 
@@ -111,19 +133,16 @@ completeVar env var args
     ok_to_inline	      = okToInline form 
 			      		   occ_info
 			      		   small_enough
-    small_enough = smallEnoughToInline con_disc unf_thresh arg_evals guidance
+    small_enough = smallEnoughToInline arg_evals guidance
     arg_evals = [is_evald arg | arg <- args, isValArg arg]
   
     is_evald (VarArg v) = isEvaluated (lookupRhsInfo env v)
     is_evald (LitArg l) = True
 
-    con_disc   = getSimplIntSwitch sw_chkr SimplUnfoldingConDiscount
-    unf_thresh = getSimplIntSwitch sw_chkr SimplUnfoldingUseThreshold
-
 #if OMIT_DEFORESTER
     do_deforest = False
 #else
-    do_deforest = case (getInfo (getIdInfo var)) of { DoDeforest -> True; _ -> False }
+    do_deforest = case (getDeforestInfo (getIdInfo var)) of { DoDeforest -> True; _ -> False }
 #endif