X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fstranal%2FWorkWrap.lhs;h=d329b5a078f2a0a860d2c4744f1ce3ca480581df;hp=33ca298d1f0619ed2b824fc5a4eaeb00ca952e57;hb=a51fe79ebcdcb8285573a18f12cade2101533419;hpb=76dfa3944cbf149a30398d29e6762a44772c0174

diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 33ca298..d329b5a 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -7,23 +7,16 @@
 module WorkWrap ( wwTopBinds, mkWrapper ) where
 
 import CoreSyn
-import CoreUnfold	( certainlyWillInline, mkInlineRule, mkWwInlineRule )
+import CoreUnfold	( certainlyWillInline, mkInlineUnfolding, mkWwInlineRule )
 import CoreUtils	( exprType, exprIsHNF )
 import CoreArity	( exprArity )
 import Var
-import Id		( idType, isOneShotLambda, idUnfolding,
-			  setIdStrictness, mkWorkerId, setInlinePragma,
-			  setInlineActivation, setIdUnfolding,
-			  setIdArity )
+import Id
 import Type		( Type )
 import IdInfo
-import Demand           ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..), 
-			  Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
-			)
+import Demand
 import UniqSupply
-import BasicTypes	( RecFlag(..), isNonRec, isNeverActive,
-                          Activation(..), InlinePragma(..), 
-			  inlinePragmaActivation, inlinePragmaRuleMatchInfo )
+import BasicTypes
 import VarEnv		( isEmptyVarEnv )
 import Maybes		( orElse )
 import WwLib
@@ -229,6 +222,7 @@ tryWW is_rec fn_id rhs
   = return [ (fn_id, rhs) ]
 
   | is_thunk && worthSplittingThunk maybe_fn_dmd res_info
+  	-- See Note [Thunk splitting]
   = ASSERT2( isNonRec is_rec, ppr new_fn_id )	-- The thunk must be non-recursive
     checkSize new_fn_id rhs $ 
     splitThunk new_fn_id rhs
@@ -277,8 +271,8 @@ checkSize fn_id rhs thing_inside
 
   | otherwise = thing_inside
   where
-    unfolding = idUnfolding fn_id
-    inline_rule = mkInlineRule unSaturatedOk rhs (unfoldingArity unfolding)
+    unfolding   = idUnfolding fn_id
+    inline_rule = mkInlineUnfolding Nothing rhs
 
 ---------------------
 splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Expr Var
@@ -292,6 +286,12 @@ splitFun fn_id fn_info wrap_dmds res_info rhs
     ; let
 	work_rhs = work_fn rhs
 	work_id  = mkWorkerId work_uniq fn_id (exprType work_rhs) 
+		        `setIdOccInfo` occInfo fn_info
+				-- Copy over occurrence info from parent
+				-- Notably whether it's a loop breaker
+				-- Doesn't matter much, since we will simplify next, but
+				-- seems right-er to do so
+
 			`setInlineActivation` (inlinePragmaActivation inl_prag)
 				-- Any inline activation (which sets when inlining is active) 
 				-- on the original function is duplicated on the worker
@@ -310,16 +310,20 @@ splitFun fn_id fn_info wrap_dmds res_info rhs
                                 -- arity is consistent with the demand type goes through
 
 	wrap_rhs  = wrap_fn work_id
-	wrap_prag = InlinePragma { inl_inline = True
+	wrap_prag = InlinePragma { inl_inline = Inline
+                                 , inl_sat    = Nothing
                                  , inl_act    = ActiveAfter 0
                                  , inl_rule   = rule_match_info }
+		-- See Note [Wrapper activation]
+		-- The RuleMatchInfo is (and must be) unaffected
+		-- The inl_inline is bound to be False, else we would not be
+		--    making a wrapper
 
 	wrap_id   = fn_id `setIdUnfolding` mkWwInlineRule work_id wrap_rhs arity
 			  `setInlinePragma` wrap_prag
-			 	-- See Note [Wrapper activation]
-				-- The RuleMatchInfo is (and must be) unaffected
-				-- The inl_inline is bound to be False, else we would not be
-				--    making a wrapper
+		          `setIdOccInfo` NoOccInfo
+			        -- Zap any loop-breaker-ness, to avoid bleating from Lint
+				-- about a loop breaker with an INLINE rule
 
     ; return ([(work_id, work_rhs), (wrap_id, wrap_rhs)]) })
 	-- Worker first, because wrapper mentions it
@@ -349,8 +353,8 @@ get_one_shots (Note _ e) = get_one_shots e
 get_one_shots _    	 = noOneShotInfo
 \end{code}
 
-Thunk splitting
-~~~~~~~~~~~~~~~
+Note [Thunk splitting]
+~~~~~~~~~~~~~~~~~~~~~~
 Suppose x is used strictly (never mind whether it has the CPR
 property).  
 
@@ -384,6 +388,7 @@ function, so that if x's demand is deeper (say U(U(L,L),L))
 then the splitting will go deeper too.
 
 \begin{code}
+-- See Note [Thunk splitting]
 -- splitThunk converts the *non-recursive* binding
 --	x = e
 -- into