diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-03-17 16:25:41 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-03-17 16:31:13 +0000 |
| commit | a7dbafe9292212f3cbc21be42eb326ab0701db7e (patch) | |
| tree | 491cefd34aa9c60948e161469eaa7fccd592d051 /compiler/specialise | |
| parent | 567bc6bd194836233ce1576acd7a62b1867f6607 (diff) | |
| download | haskell-a7dbafe9292212f3cbc21be42eb326ab0701db7e.tar.gz | |
No join-point from an INLINE function with wrong arity
The main payload of this patch is NOT to make a join-point
from a function with an INLINE pragma and the wrong arity;
see Note [Join points and INLINE pragmas] in CoreOpt.
This is what caused Trac #13413.
But we must do the exact same thing in simpleOptExpr,
which drove me to the following refactoring:
* Move simpleOptExpr and simpleOptPgm from CoreSubst to a new
module CoreOpt along with a few others (exprIsConApp_maybe,
pushCoArg, etc)
This eliminates a module loop altogether (delete
CoreArity.hs-boot), and stops CoreSubst getting too huge.
* Rename Simplify.matchOrConvertToJoinPoint
to joinPointBinding_maybe
Move it to the new CoreOpt
Use it in simpleOptExpr as well as in Simplify
* Define CoreArity.joinRhsArity and use it
Diffstat (limited to 'compiler/specialise')
| -rw-r--r-- | compiler/specialise/Rules.hs | 1 | ||||
| -rw-r--r-- | compiler/specialise/Specialise.hs | 3 |
2 files changed, 3 insertions, 1 deletions
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 47193c66bc..192b6bb212 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -31,6 +31,7 @@ module Rules ( import CoreSyn -- All of it import Module ( Module, ModuleSet, elemModuleSet ) import CoreSubst +import CoreOpt ( exprIsLambda_maybe ) import CoreFVs ( exprFreeVars, exprsFreeVars, bindFreeVars , rulesFreeVarsDSet, exprsOrphNames, exprFreeVarsList ) import CoreUtils ( exprType, eqExpr, mkTick, mkTicks, diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index bd1c7aecf0..0dd295d695 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -21,6 +21,7 @@ import VarSet import VarEnv import CoreSyn import Rules +import CoreOpt ( collectBindersPushingCo ) import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) import CoreFVs ( exprFreeVars, exprsFreeVars, idFreeVars, exprsFreeIdsList ) import CoreArity ( etaExpandToJoinPointRule ) @@ -1194,7 +1195,7 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs -- Figure out whether the function has an INLINE pragma -- See Note [Inline specialisations] - (rhs_bndrs, rhs_body) = CoreSubst.collectBindersPushingCo rhs + (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1 |