diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2014-01-10 13:45:39 +0000 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-02-04 11:05:02 +0000 |
| commit | be339119cf15cb7ec6da88d777c7b3d42aebd18a (patch) | |
| tree | 46105c006f0ceb74d1b43a9d7d32a2b41df4878c | |
| parent | 9343ce5c71da6672e056245505ba8ec659aa144d (diff) | |
| download | haskell-be339119cf15cb7ec6da88d777c7b3d42aebd18a.tar.gz | |
Mark the scrunitee of a multi-way-case as converging
| -rw-r--r-- | compiler/stranal/DmdAnal.lhs | 4 |
1 files changed, 3 insertions, 1 deletions
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 9e19e8fcc3..358b081738 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -276,7 +276,9 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)]) dmdAnal env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives - (alt_tys, alts') = mapAndUnzip (dmdAnalAlt env dmd) alts + case_bndr_sig = convergeSig nopSig + env_alt = extendAnalEnv NotTopLevel env case_bndr case_bndr_sig + (alt_tys, alts') = mapAndUnzip (dmdAnalAlt env_alt dmd) alts (scrut_ty, scrut') = dmdAnal env cleanEvalDmd scrut (alt_ty, case_bndr') = annotateBndr env (lubDmdTypes alt_tys) case_bndr res_ty = alt_ty `bothDmdType` toBothDmdArg scrut_ty |