diff options
Diffstat (limited to 'compiler/GHC/Core/Opt/WorkWrap.hs')
| -rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap.hs | 23 |
1 files changed, 11 insertions, 12 deletions
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs index 93c4c31995..68a34a634d 100644 --- a/compiler/GHC/Core/Opt/WorkWrap.hs +++ b/compiler/GHC/Core/Opt/WorkWrap.hs @@ -753,7 +753,7 @@ splitFun ww_opts fn_id rhs = warnPprTrace (not (wrap_dmds `lengthIs` (arityInfo fn_info))) "splitFun" (ppr fn_id <+> (ppr wrap_dmds $$ ppr cpr)) $ - do { mb_stuff <- mkWwBodies ww_opts fn_id arg_vars (exprType body) wrap_dmds cpr + do { mb_stuff <- mkWwBodies ww_opts fn_id arg_vars (exprType body) wrap_dmds fun_dmd cpr ; case mb_stuff of Nothing -> -- No useful wrapper; leave the binding alone return [(fn_id, rhs)] @@ -786,14 +786,15 @@ splitFun ww_opts fn_id rhs (ppr fn_id <> colon <+> text "ct_arty:" <+> int (ct_arty cpr_ty) <+> text "arityInfo:" <+> ppr (arityInfo fn_info)) $ ct_cpr cpr_ty + fun_dmd = idDemandInfo fn_id mkWWBindPair :: WwOpts -> Id -> IdInfo -> [Var] -> CoreExpr -> Unique -> Divergence - -> ([Demand],[CbvMark], JoinArity, Id -> CoreExpr, Expr CoreBndr -> CoreExpr) + -> ([Demand],[CbvMark], JoinArity, Demand, Id -> CoreExpr, Expr CoreBndr -> CoreExpr) -> [(Id, CoreExpr)] mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div - (work_demands, cbv_marks :: [CbvMark], join_arity, wrap_fn, work_fn) - = -- pprTrace "mkWWBindPair" (ppr fn_id <+> ppr wrap_id <+> ppr work_id $$ ppr wrap_rhs) $ + (work_demands, cbv_marks :: [CbvMark], join_arity, work_dmd, wrap_fn, work_fn) + = pprTrace "mkWWBindPair" (ppr fn_id <+> ppr wrap_id <+> ppr work_id <+> ppr work_dmd $$ ppr wrap_rhs) $ [(work_id, work_rhs), (wrap_id, wrap_rhs)] -- Worker first, because wrapper mentions it where @@ -840,7 +841,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div `setIdCprSig` topCprSig - `setIdDemandInfo` worker_demand + `setIdDemandInfo` work_dmd `setIdArity` work_arity -- Set the arity so that the Core Lint check that the @@ -855,9 +856,9 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div work_arity = length work_demands :: Int -- See Note [Demand on the worker] - single_call = saturatedByOneShots arity (demandInfo fn_info) - worker_demand | single_call = mkWorkerDemand work_arity - | otherwise = topDmd + --single_call = saturatedByOneShots arity (demandInfo fn_info) + --worker_demand | single_call = mkWorkerDemand work_arity + -- | otherwise = topDmd wrap_rhs = wrap_fn work_id wrap_prag = mkStrWrapperInlinePrag fn_inl_prag fn_rules @@ -898,12 +899,10 @@ mkStrWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info }) ru {- Note [Demand on the worker] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - If the original function is called once, according to its demand info, then so is the worker. This is important so that the occurrence analyser can attach OneShot annotations to the worker’s lambda binders. - Example: -- Original function @@ -1033,8 +1032,8 @@ splitThunk :: WwOpts -> RecFlag -> Var -> Expr Var -> UniqSM [(Var, Expr Var)] splitThunk ww_opts is_rec x rhs = assert (not (isJoinId x)) $ do { let x' = localiseId x -- See comment above - ; (useful,_args, wrap_fn, fn_arg) - <- mkWWstr_one ww_opts x' NotMarkedCbv + ; (useful, _args, wrap_fn, fn_arg) + <- mkWWstr_one ww_opts x' NotMarkedCbv C_0N ; let res = [ (x, Let (NonRec x' rhs) (wrap_fn fn_arg)) ] ; if useful then assertPpr (isNonRec is_rec) (ppr x) -- The thunk must be non-recursive return res |