diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-01-25 11:16:18 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-01-25 11:32:32 +0000 |
commit | 3c060f36f6eb4d359f252168e2f97b573d017080 (patch) | |
tree | 3f015279a2dcdcf8656353e24c54ee9c24cade67 /compiler/coreSyn | |
parent | f7e0e5f957f1b061eda057282504fca3de061220 (diff) | |
download | haskell-3c060f36f6eb4d359f252168e2f97b573d017080.tar.gz |
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.
Diffstat (limited to 'compiler/coreSyn')
-rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 31 |
1 files changed, 17 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] |