#7347: Existential data constructors should not be promoted
---------------------------------+------------------------------------------
Reporter: simonpj | Owner:
Type: bug | Status: merge
Priority: normal | Milestone:
Component: Compiler | Version: 7.6.1
Keywords: | Os: Unknown/Multiple
Architecture: Unknown/Multiple | Failure: None/Unknown
Difficulty: Unknown | Testcase: polykinds/T7347
Blockedby: | Blocking:
Related: |
---------------------------------+------------------------------------------
Comment(by simonpj):
Also needs this:
{{{
commit 1152f9491517ca22ed796bfacbbfb7413dde1bcf
Author: Simon Peyton Jones <simo...@microsoft.com>
Date: Fri Oct 19 20:29:06 2012 +0100
An accidentally-omitted part of commit 8019bc2c, about promoting data
constructors
>---------------------------------------------------------------
compiler/typecheck/TcHsType.lhs | 14 ++++++--------
1 files changed, 6 insertions(+), 8 deletions(-)
diff --git a/compiler/typecheck/TcHsType.lhs
b/compiler/typecheck/TcHsType.lhs index bbfc673..60cf544 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -427,8 +427,8 @@ tc_hs_type hs_ty@(HsExplicitListTy _k tys) exp_kind
; checkExpectedKind hs_ty (mkPromotedListTy kind) exp_kind
; return (foldr (mk_cons kind) (mk_nil kind) taus) }
where
- mk_cons k a b = mkTyConApp (buildPromotedDataCon consDataCon) [k, a,
b]
- mk_nil k = mkTyConApp (buildPromotedDataCon nilDataCon) [k]
+ mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b]
+ mk_nil k = mkTyConApp (promoteDataCon nilDataCon) [k]
tc_hs_type hs_ty@(HsExplicitTupleTy _ tys) exp_kind
= do { tks <- mapM tc_infer_lhs_type tys
@@ -607,12 +607,10 @@ tcTyVar name -- Could be a tyvar, a tycon,
or a datacon
AGlobal (ATyCon tc) -> inst_tycon (mkTyConApp tc) (tyConKind
tc)
AGlobal (ADataCon dc)
- | isPromotableType ty -> inst_tycon (mkTyConApp tc)
(tyConKind tc)
+ | Just tc <- promoteDataCon_maybe dc
+ -> inst_tycon (mkTyConApp tc) (tyConKind tc)
| otherwise -> failWithTc (quotes (ppr dc) <+> ptext (sLit
"of type")
- <+> quotes (ppr ty) <+> ptext (sLit "is not
promotable"))
- where
- ty = dataConUserType dc
- tc = buildPromotedDataCon dc
+ <+> quotes (ppr (dataConUserType dc)) <+>
+ ptext (sLit "is not promotable"))
APromotionErr err -> promotionErr name err
@@ -1465,7 +1463,7 @@ tc_kind_var_app name arg_kis
; unless data_kinds $ addErr (dataKindsErr name)
; case isPromotableTyCon tc of
Just n | n == length arg_kis ->
- return (mkTyConApp (buildPromotedTyCon tc)
arg_kis)
+ return (mkTyConApp (promoteTyCon tc) arg_kis)
Just _ -> tycon_err tc "is not fully applied"
Nothing -> tycon_err tc "is not promotable" }
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/7347#comment:10>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
