projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove unused functions (applyToPair, applyToFst, applyToSnd)
[ghc-hetmet.git]
/
compiler
/
stranal
/
WorkWrap.lhs
diff --git
a/compiler/stranal/WorkWrap.lhs
b/compiler/stranal/WorkWrap.lhs
index
456f2f0
..
a1b18a9
100644
(file)
--- a/
compiler/stranal/WorkWrap.lhs
+++ b/
compiler/stranal/WorkWrap.lhs
@@
-11,11
+11,11
@@
module WorkWrap ( wwTopBinds, mkWrapper ) where
import CoreSyn
import CoreUnfold ( certainlyWillInline )
import CoreLint ( showPass, endPass )
import CoreSyn
import CoreUnfold ( certainlyWillInline )
import CoreLint ( showPass, endPass )
-import CoreUtils ( exprType, exprIsHNF )
+import CoreUtils ( exprType, exprIsHNF, exprArity )
import Id ( Id, idType, isOneShotLambda,
setIdNewStrictness, mkWorkerId,
setIdWorkerInfo, setInlinePragma,
import Id ( Id, idType, isOneShotLambda,
setIdNewStrictness, mkWorkerId,
setIdWorkerInfo, setInlinePragma,
- idInfo )
+ setIdArity, idInfo )
import MkId ( lazyIdKey, lazyIdUnfolding )
import Type ( Type )
import IdInfo ( WorkerInfo(..), arityInfo,
import MkId ( lazyIdKey, lazyIdUnfolding )
import Type ( Type )
import IdInfo ( WorkerInfo(..), arityInfo,
@@
-26,7
+26,7
@@
import NewDemand ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..),
)
import UniqSupply ( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
import Unique ( hasKey )
)
import UniqSupply ( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
import Unique ( hasKey )
-import BasicTypes ( RecFlag(..), isNonRec )
+import BasicTypes ( RecFlag(..), isNonRec, isNeverActive )
import VarEnv ( isEmptyVarEnv )
import Maybes ( orElse )
import DynFlags
import VarEnv ( isEmptyVarEnv )
import Maybes ( orElse )
import DynFlags
@@
-215,6
+215,11
@@
tryWW is_rec fn_id rhs
-- fw = \ab -> (__inline (\x -> E)) (a,b)
-- and the original __inline now vanishes, so E is no longer
-- inside its __inline wrapper. Death! Disaster!
-- fw = \ab -> (__inline (\x -> E)) (a,b)
-- and the original __inline now vanishes, so E is no longer
-- inside its __inline wrapper. Death! Disaster!
+
+ || isNeverActive inline_prag
+ -- 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.
= returnUs [ (new_fn_id, rhs) ]
| is_thunk && worthSplittingThunk maybe_fn_dmd res_info
= returnUs [ (new_fn_id, rhs) ]
| is_thunk && worthSplittingThunk maybe_fn_dmd res_info
@@
-269,6
+274,9
@@
splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
`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
`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
+ `setIdArity` (exprArity work_rhs)
+ -- Set the arity so that the Core Lint check that the
+ -- arity is consistent with the demand type goes through
wrap_rhs = wrap_fn work_id
wrap_id = fn_id `setIdWorkerInfo` HasWorker work_id arity
wrap_rhs = wrap_fn work_id
wrap_id = fn_id `setIdWorkerInfo` HasWorker work_id arity