diff options
author | Ben Gamari <ben@smart-cactus.org> | 2019-09-16 11:35:57 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2019-09-19 09:33:04 -0400 |
commit | b21d653577e01c3c06f5214e2a97ffa28e5339c8 (patch) | |
tree | 06687f26bf623381369a83e61cf8d8b3a1e70b61 | |
parent | c77fc3b20e93ba3215791d8d087a096853c4dd67 (diff) | |
download | haskell-b21d653577e01c3c06f5214e2a97ffa28e5339c8.tar.gz |
stranal: Propagate strictness through noinline
Ticket #16588 noticed that 'noinline f x' would hide the strictness of
'f' from the demand analyser. Fix this.
-rw-r--r-- | compiler/basicTypes/MkId.hs | 6 | ||||
-rw-r--r-- | compiler/stranal/DmdAnal.hs | 7 |
2 files changed, 13 insertions, 0 deletions
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 741b48e58b..068c1f1619 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1595,6 +1595,12 @@ running the simplifier. when we serialize an expression to the interface format. See Note [Inlining and hs-boot files] in ToIface +In addition, the demand analyser has a special case for 'noinline' to ensure +that 'noinline f x' has the same demand characteristics as 'f x'. This special +case arose from #16588, where we noticed that 'noinline' applications arising +from hs-boot files (see Note [Inlining and hs-boot files] in ToIface) would +prevent us from taking advantage of strictness signatures + Note [The oneShot function] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the context of making left-folds fuse somewhat okish (see ticket #7994 diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 14fd46a6a3..c6f8aa7dcb 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -39,6 +39,8 @@ import ErrUtils ( dumpIfSet_dyn ) import Name ( getName, stableNameCmp ) import Data.Function ( on ) import UniqSet +import Unique ( hasKey ) +import PrelNames ( noinlineIdKey ) {- ************************************************************************ @@ -179,6 +181,11 @@ dmdAnal' env dmd (Tick t e) where (dmd_ty, e') = dmdAnal env dmd e +-- See Note [noinlineId magic] in MkId. +dmdAnal' env dmd (App (App (Var fun) _ty) arg) + | fun `hasKey` noinlineIdKey + = dmdAnal env dmd arg + dmdAnal' env dmd (App fun (Type ty)) = (fun_ty, App fun' (Type ty)) where |