X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fstranal%2FWorkWrap.lhs;h=30754e5fe51abe8c4caf2d1a42bcd24ef7970607;hb=4bc25e8c30559b7a6a87b39afcc79340ae778788;hp=71f9ef831756df690335096bcec0ad9a648b3272;hpb=62eeda5aed31173b234b2965ccf4bd6979ffd9a4;p=ghc-hetmet.git

diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 71f9ef8..30754e5 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -15,7 +15,7 @@ import CoreArity	( exprArity )
 import Var
 import Id		( Id, idType, isOneShotLambda, 
 			  setIdNewStrictness, mkWorkerId,
-			  setIdWorkerInfo, setInlinePragma,
+			  setIdWorkerInfo, setInlineActivation,
 			  setIdArity, idInfo )
 import MkId		( lazyIdKey, lazyIdUnfolding )
 import Type		( Type )
@@ -25,7 +25,8 @@ import NewDemand        ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..),
 			)
 import UniqSupply
 import Unique		( hasKey )
-import BasicTypes	( RecFlag(..), isNonRec, isNeverActive )
+import BasicTypes	( RecFlag(..), isNonRec, isNeverActive,
+                          Activation, inlinePragmaActivation )
 import VarEnv		( isEmptyVarEnv )
 import Maybes		( orElse )
 import WwLib
@@ -196,7 +197,7 @@ tryWW is_rec fn_id rhs
   |  -- isNonRec is_rec && 	-- Now omitted: see Note [Don't w/w inline things]
      certainlyWillInline unfolding
 
-  || isNeverActive inline_prag
+  || isNeverActive inline_act
 	-- No point in worker/wrappering if the thing is never inlined!
 	-- Because the no-inline prag will prevent the wrapper ever
 	-- being inlined at a call site. 
@@ -207,7 +208,7 @@ tryWW is_rec fn_id rhs
     splitThunk new_fn_id rhs
 
   | is_fun && worthSplittingFun wrap_dmds res_info
-  = splitFun new_fn_id fn_info wrap_dmds res_info inline_prag rhs
+  = splitFun new_fn_id fn_info wrap_dmds res_info inline_act rhs
 
   | otherwise
   = return [ (new_fn_id, rhs) ]
@@ -216,7 +217,7 @@ tryWW is_rec fn_id rhs
     fn_info   	 = idInfo fn_id
     maybe_fn_dmd = newDemandInfo fn_info
     unfolding 	 = unfoldingInfo fn_info
-    inline_prag  = inlinePragInfo fn_info
+    inline_act   = inlinePragmaActivation (inlinePragInfo fn_info)
 
 	-- In practice it always will have a strictness 
 	-- signature, even if it's a uninformative one
@@ -236,9 +237,9 @@ tryWW is_rec fn_id rhs
     is_thunk  = not is_fun && not (exprIsHNF rhs)
 
 ---------------------
-splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> InlinePragInfo -> Expr Var
+splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Activation -> Expr Var
          -> UniqSM [(Id, CoreExpr)]
-splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
+splitFun fn_id fn_info wrap_dmds res_info inline_act rhs
   = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) 
     (do {
 	-- The arity should match the signature
@@ -247,13 +248,14 @@ splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
     ; let
 	work_rhs = work_fn rhs
 	work_id  = mkWorkerId work_uniq fn_id (exprType work_rhs) 
-			`setInlinePragma` inline_prag
-				-- Any inline pragma (which sets when inlining is active) 
+			`setInlineActivation` inline_act
+				-- Any inline activation (which sets when inlining is active) 
 				-- on the original function is duplicated on the worker and wrapper
 				-- It *matters* that the pragma stays on the wrapper
 				-- It seems sensible to have it on the worker too, although we
 				-- can't think of a compelling reason. (In ptic, INLINE things are 
-				-- not w/wd)
+				-- not w/wd). However, the RuleMatchInfo is not transferred since
+                                -- it does not make sense for workers to be constructorlike.
 			`setIdNewStrictness` StrictSig (mkTopDmdType work_demands work_res_info)
 				-- Even though we may not be at top level, 
 				-- it's ok to give it an empty DmdEnv