diff options
| -rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 31 | ||||
| -rw-r--r-- | testsuite/tests/polykinds/T11248.hs | 3 |
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 #-} |