Fix exprIsHNF (Trac #11248)

Blimey!  CoreUtils.exprIsHNFlike had not one but two bugs.

 * is_hnf_like treated coercion args like type args
   (result: exprIsHNF might wrongly say True)

 * app_is_value treated type args like value args
   (result: exprIsHNF might wrongly say False)

Bizarre.  This goes back to at least 2012. It's amazing that it
hasn't caused more trouble.

It was discovered by a Lint error when compiling Trac #11248 with -O.

2 files changed, 20 insertions, 14 deletions

diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 3664d8e032..eaccb33e91 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -1459,22 +1459,25 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like
     is_hnf_like (Tick tickish e) = not (tickishCounts tickish)
                                       && is_hnf_like e
                                       -- See Note [exprIsHNF Tick]
-    is_hnf_like (Cast e _)           = is_hnf_like e
-    is_hnf_like (App e (Type _))     = is_hnf_like e
-    is_hnf_like (App e (Coercion _)) = is_hnf_like e
-    is_hnf_like (App e a)            = app_is_value e [a]
-    is_hnf_like (Let _ e)            = is_hnf_like e  -- Lazy let(rec)s don't affect us
-    is_hnf_like _                    = False
+    is_hnf_like (Cast e _)       = is_hnf_like e
+    is_hnf_like (App e a)
+      | isValArg a               = app_is_value e 1
+      | otherwise                = is_hnf_like e
+    is_hnf_like (Let _ e)        = is_hnf_like e  -- Lazy let(rec)s don't affect us
+    is_hnf_like _                = False
 
     -- There is at least one value argument
-    app_is_value :: CoreExpr -> [CoreArg] -> Bool
-    app_is_value (Var fun) args
-      = idArity fun > valArgCount args    -- Under-applied function
-        || is_con fun                     --  or constructor-like
-    app_is_value (Tick _ f) as = app_is_value f as
-    app_is_value (Cast f _) as = app_is_value f as
-    app_is_value (App f a)  as = app_is_value f (a:as)
-    app_is_value _          _  = False
+    -- 'n' is number of value args to which the expression is applied
+    app_is_value :: CoreExpr -> Int -> Bool
+    app_is_value (Var fun) n_val_args
+      = idArity fun > n_val_args    -- Under-applied function
+        || is_con fun               --  or constructor-like
+    app_is_value (Tick _ f) nva = app_is_value f nva
+    app_is_value (Cast f _) nva = app_is_value f nva
+    app_is_value (App f a)  nva
+      | isValArg a              = app_is_value f (nva + 1)
+      | otherwise               = app_is_value f nva
+    app_is_value _ _ = False
 
 {-
 Note [exprIsHNF Tick]
diff --git a/testsuite/tests/polykinds/T11248.hs b/testsuite/tests/polykinds/T11248.hs
index e1c8fcc1b8..b3a32e3097 100644
--- a/testsuite/tests/polykinds/T11248.hs
+++ b/testsuite/tests/polykinds/T11248.hs
@@ -1,3 +1,6 @@
+{-# OPTIONS_GHC -O #-}
+  -- Trac #11248, comment:6 showed that this tests failed with -O
+
 {-# LANGUAGE DataKinds, TypeOperators, TypeFamilies,
              KindSignatures, ConstraintKinds #-}