#include "HsVersions.h"
import CoreSyn
-import CoreUnfold ( Unfolding, certainlyWillInline )
-import CmdLineOpts ( opt_UF_CreationThreshold , opt_D_verbose_core2core,
- opt_D_dump_worker_wrapper
- )
-import CoreLint ( beginPass, endPass )
-import CoreUtils ( exprType, exprEtaExpandArity )
-import MkId ( mkWorkerId )
+import CoreUnfold ( certainlyWillInline )
+import CoreLint ( showPass, endPass )
+import CoreUtils ( exprType )
import Id ( Id, idType, idStrictness, idArity, isOneShotLambda,
- setIdStrictness, idInlinePragma,
+ setIdStrictness, idInlinePragma, mkWorkerId,
setIdWorkerInfo, idCprInfo, setInlinePragma )
-import Type ( Type, isNewType, splitForAllTys, splitFunTys )
+import Type ( Type, splitForAllTys, splitFunTys )
import IdInfo ( mkStrictnessInfo, noStrictnessInfo, StrictnessInfo(..),
- CprInfo(..), exactArity, InlinePragInfo(..), isNeverInlinePrag,
+ CprInfo(..), InlinePragInfo(..), isNeverInlinePrag,
WorkerInfo(..)
)
-import Demand ( Demand, wwLazy )
+import Demand ( Demand )
import UniqSupply ( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
+import CmdLineOpts
import WwLib
import Outputable
\end{code}
\begin{code}
-wwTopBinds :: UniqSupply
- -> [CoreBind]
- -> IO [CoreBind]
+wwTopBinds :: DynFlags
+ -> UniqSupply
+ -> [CoreBind]
+ -> IO [CoreBind]
-wwTopBinds us binds
+wwTopBinds dflags us binds
= do {
- beginPass "Worker Wrapper binds";
+ showPass dflags "Worker Wrapper binds";
-- Create worker/wrappers, and mark binders with their
-- "strictness info" [which encodes their worker/wrapper-ness]
let { binds' = workersAndWrappers us binds };
- endPass "Worker Wrapper binds" (opt_D_dump_worker_wrapper ||
- opt_D_verbose_core2core) binds'
+ endPass dflags "Worker Wrapper binds"
+ Opt_D_dump_worker_wrapper binds'
}
\end{code}
= -- Don't split things that will never be inlined
returnUs [ (fn_id, rhs) ]
- | non_rec && not do_coerce_ww && certainlyWillInline fn_id
+ | non_rec && certainlyWillInline fn_id
-- No point in worker/wrappering a function that is going to be
-- INLINEd wholesale anyway. If the strictness analyser is run
-- twice, this test also prevents wrappers (which are INLINEd)
-- from being re-done.
+ --
+ -- It's very important to refrain from w/w-ing an INLINE function
+ -- If we do so by mistake we transform
+ -- f = __inline (\x -> E)
+ -- into
+ -- f = __inline (\x -> case x of (a,b) -> fw E)
+ -- fw = \ab -> (__inline (\x -> E)) (a,b)
+ -- and the original __inline now vanishes, so E is no longer
+ -- inside its __inline wrapper. Death! Disaster!
--
- -- The do_coerce_ww test is so that
- -- a function with a coerce should w/w to get rid
- -- of the coerces, which can significantly improve its arity.
- -- Example: f [] = return [] :: IO [Int]
- -- f (x:xs) = return (x:xs)
- -- If we aren't careful we end up with
- -- f = \ x -> case x of {
- -- x:xs -> __coerce (IO [Int]) (\ s -> (# s, x:xs #)
- -- [] -> lvl_sJ8
- --
- --
- -- OUT OF DATE NOTE, kept for info:
- -- It's out of date because now wrappers look very cheap
- -- even when they are inlined.
+ -- OUT OF DATE NOTE:
+ -- [Out of date because the size calculation in CoreUnfold now
+ -- makes wrappers look very cheap even when they are inlined.]
-- In this case we add an INLINE pragma to the RHS. Why?
-- Because consider
-- f = \x -> g x x
-- So f doesn't get inlined, but it is strict and we have failed to w/w it.
= returnUs [ (fn_id, rhs) ]
- | not (do_strict_ww || do_cpr_ww || do_coerce_ww)
+ | not (do_strict_ww || do_cpr_ww)
= returnUs [ (fn_id, rhs) ]
| otherwise -- Do w/w split
other -> False
-------------------------------------------------------------
- do_coerce_ww = check_for_coerce arity fun_ty
- -- We are willing to do a w/w even if the arity is zero.
- -- x = coerce t E
- -- ==>
- -- x' = E
- -- x = coerce t x'
-
- -------------------------------------------------------------
one_shots = get_one_shots rhs
--- See if there's a Coerce before we run out of arity;
--- if so, it's worth trying a w/w split. Reason: we find
--- functions like f = coerce (\s -> e)
--- and g = \x -> coerce (\s -> e)
--- and they may have no useful strictness or cpr info, but if we
--- do the w/w thing we get rid of the coerces.
-
-check_for_coerce arity ty
- = length arg_tys <= arity && isNewType res_ty
- -- Don't look further than arity args,
- -- but if there are arity or fewer, see if there's
- -- a newtype in the corner
- where
- (_, tau) = splitForAllTys ty
- (arg_tys, res_ty) = splitFunTys tau
-
-- If the original function has one-shot arguments, it is important to
-- make the wrapper and worker have corresponding one-shot arguments too.
-- Otherwise we spuriously float stuff out of case-expression join points,
projects / ghc-hetmet.git / blobdiff