diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-11-03 16:14:47 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2021-11-03 16:14:47 +0000 |
| commit | e774dcc35ceb370a8d7d8010e9904868b993cf01 (patch) | |
| tree | 6020cb75c32878ff10b7a027f9a97521f7ea8c04 | |
| parent | a7e1be3d84d2b7d0515f909175cdfa5dcf0dc55c (diff) | |
| download | haskell-wip/T20612.tar.gz | |
Make exprIsWorkFree only work for single-alt caseswip/T20612
See #20612
| -rw-r--r-- | compiler/GHC/Core/Utils.hs | 30 |
1 files changed, 15 insertions, 15 deletions
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index 6b7eb3bf11..5b5526e44d 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -1285,21 +1285,21 @@ exprIsCheapX ok_app e ok e = go 0 e -- n is the number of value arguments - go n (Var v) = ok_app v n - go _ (Lit {}) = True - go _ (Type {}) = True - go _ (Coercion {}) = True - go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && - and [ go n rhs | Alt _ _ rhs <- alts ] - go n (Tick t e) | tickishCounts t = False - | otherwise = go n e - go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e - | otherwise = go n e - go n (App f e) | isRuntimeArg e = go (n+1) f && ok e - | otherwise = go n f - go n (Let (NonRec _ r) e) = go n e && ok r - go n (Let (Rec prs) e) = go n e && all (ok . snd) prs + go n (Var v) = ok_app v n + go _ (Lit {}) = True + go _ (Type {}) = True + go _ (Coercion {}) = True + go n (Cast e _) = go n e + go n (Case scrut _ _ [Alt _ _ rhs]) = ok scrut && go n rhs + go _ (Case {}) = False + go n (Tick t e) | tickishCounts t = False + | otherwise = go n e + go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e + | otherwise = go n e + go n (App f e) | isRuntimeArg e = go (n+1) f && ok e + | otherwise = go n f + go n (Let (NonRec _ r) e) = go n e && ok r + go n (Let (Rec prs) e) = go n e && all (ok . snd) prs -- Case: see Note [Case expressions are work-free] -- App, Let: see Note [Arguments and let-bindings exprIsCheapX] |