summaryrefslogtreecommitdiff
path: root/compiler/stranal
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/stranal
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/stranal')
-rw-r--r--compiler/stranal/WwLib.hs12
1 files changed, 7 insertions, 5 deletions
diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs
index f346324f4d..5e4d22857a 100644
--- a/compiler/stranal/WwLib.hs
+++ b/compiler/stranal/WwLib.hs
@@ -16,7 +16,7 @@ module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs
import GhcPrelude
import CoreSyn
-import CoreUtils ( exprType, mkCast )
+import CoreUtils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase )
import Id
import IdInfo ( JoinArity )
import DataCon
@@ -1027,7 +1027,7 @@ mkWWcpr_help (data_con, inst_tys, arg_tys, co)
con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co
; return ( True
- , \ wkr_call -> Case wkr_call arg (exprType con_app) [(DEFAULT, [], con_app)]
+ , \ wkr_call -> mkDefaultCase wkr_call arg con_app
, \ body -> mkUnpackCase body co work_uniq data_con [arg] (varToCoreExpr arg)
-- varToCoreExpr important here: arg can be a coercion
-- Lacking this caused #10658
@@ -1042,9 +1042,11 @@ mkWWcpr_help (data_con, inst_tys, arg_tys, co)
ubx_tup_ty = exprType ubx_tup_app
ubx_tup_app = mkCoreUbxTup (map fst arg_tys) (map varToCoreExpr args)
con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co
+ tup_con = tupleDataCon Unboxed (length arg_tys)
; return (True
- , \ wkr_call -> Case wkr_call wrap_wild (exprType con_app) [(DataAlt (tupleDataCon Unboxed (length arg_tys)), args, con_app)]
+ , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild
+ (DataAlt tup_con) args con_app
, \ body -> mkUnpackCase body co work_uniq data_con args ubx_tup_app
, ubx_tup_ty ) }
@@ -1056,8 +1058,8 @@ mkUnpackCase :: CoreExpr -> Coercion -> Unique -> DataCon -> [Id] -> CoreExpr -
mkUnpackCase (Tick tickish e) co uniq con args body -- See Note [Profiling and unpacking]
= Tick tickish (mkUnpackCase e co uniq con args body)
mkUnpackCase scrut co uniq boxing_con unpk_args body
- = Case casted_scrut bndr (exprType body)
- [(DataAlt boxing_con, unpk_args, body)]
+ = mkSingleAltCase casted_scrut bndr
+ (DataAlt boxing_con) unpk_args body
where
casted_scrut = scrut `mkCast` co
bndr = mk_ww_local uniq (exprType casted_scrut, MarkedStrict)