stranal: Propagate strictness through noinline

Ticket #16588 noticed that 'noinline f x' would hide the strictness of
'f' from the demand analyser. Fix this.

2 files changed, 13 insertions, 0 deletions

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 741b48e..068c1f1 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 14fd46a..c6f8aa7 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