diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2019-08-30 13:43:24 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2019-09-20 10:50:21 +0100 |
| commit | 0dad81ca5fd1f63bf8a3b6ad09787559e8bd05c0 (patch) | |
| tree | 8759889c9a5bfe5f59dda0f809c2bfc1b8fab3f1 /compiler/basicTypes | |
| parent | 1755424806839d57a0c5672922a4b65b838f7d17 (diff) | |
| download | haskell-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/basicTypes')
| -rw-r--r-- | compiler/basicTypes/MkId.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 741b48e58b..bc7d0f57c9 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -48,7 +48,7 @@ import FamInstEnv import Coercion import TcType import MkCore -import CoreUtils ( exprType, mkCast ) +import CoreUtils ( mkCast, mkDefaultCase ) import CoreUnfold import Literal import TyCon @@ -463,8 +463,8 @@ mkDictSelRhs clas val_index rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars) (Var dict_id) - | otherwise = Case (Var dict_id) dict_id (idType the_arg_id) - [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)] + | otherwise = mkSingleAltCase (Var dict_id) dict_id (DataAlt data_con) + arg_ids (varToCoreExpr the_arg_id) -- varToCoreExpr needed for equality superclass selectors -- sel a b d = case x of { MkC _ (g:a~b) _ -> CO g } @@ -987,7 +987,7 @@ wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty ------------------------ seqUnboxer :: Unboxer -seqUnboxer v = return ([v], \e -> Case (Var v) v (exprType e) [(DEFAULT, [], e)]) +seqUnboxer v = return ([v], mkDefaultCase (Var v) v) unitUnboxer :: Unboxer unitUnboxer v = return ([v], \e -> e) @@ -1014,8 +1014,8 @@ dataConArgUnpack arg_ty ,( \ arg_id -> do { rep_ids <- mapM newLocal rep_tys ; let unbox_fn body - = Case (Var arg_id) arg_id (exprType body) - [(DataAlt con, rep_ids, body)] + = mkSingleAltCase (Var arg_id) arg_id + (DataAlt con) rep_ids body ; return (rep_ids, unbox_fn) } , Boxer $ \ subst -> do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys |