summaryrefslogtreecommitdiff
path: root/compiler/deSugar
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2019-08-30 13:43:24 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2019-09-20 10:50:21 +0100
commit0dad81ca5fd1f63bf8a3b6ad09787559e8bd05c0 (patch)
tree8759889c9a5bfe5f59dda0f809c2bfc1b8fab3f1 /compiler/deSugar
parent1755424806839d57a0c5672922a4b65b838f7d17 (diff)
downloadhaskell-0dad81ca5fd1f63bf8a3b6ad09787559e8bd05c0.tar.gz
Fix bogus type of case expressionwip/T17056
Issue #17056 revealed that we were sometimes building a case expression whose type field (in the Case constructor) was bogus. Consider a phantom type synonym type S a = Int and we want to form the case expression case x of K (a::*) -> (e :: S a) We must not make the type field of the Case constructor be (S a) because 'a' isn't in scope. We must instead expand the synonym. Changes in this patch: * Expand synonyms in the new function CoreUtils.mkSingleAltCase. * Use mkSingleAltCase in MkCore.wrapFloat, which was the proximate source of the bug (when called by exprIsConApp_maybe) * Use mkSingleAltCase elsewhere * Documentation CoreSyn new invariant (6) in Note [Case expression invariants] CoreSyn Note [Why does Case have a 'Type' field?] CoreUtils Note [Care with the type of a case expression] * I improved Core Lint's error reporting, which was pretty confusing in this case, because it didn't mention that the offending type was the return type of a case expression. * A little bit of cosmetic refactoring in CoreUtils
Diffstat (limited to 'compiler/deSugar')
-rw-r--r--compiler/deSugar/DsUtils.hs3
1 files changed, 1 insertions, 2 deletions
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index 7d39b4a3c6..14dab29b30 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -243,8 +243,7 @@ wrapBind new old body -- NB: this function must deal with term
| otherwise = Let (NonRec new (varToCoreExpr old)) body
seqVar :: Var -> CoreExpr -> CoreExpr
-seqVar var body = Case (Var var) var (exprType body)
- [(DEFAULT, [], body)]
+seqVar var body = mkDefaultCase (Var var) var body
mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
mkCoLetMatchResult bind = adjustMatchResult (mkCoreLet bind)