Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/29bbb9f538db07ecbc412879f357f16607b2ad65 >--------------------------------------------------------------- commit 29bbb9f538db07ecbc412879f357f16607b2ad65 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 41412a9..147ce75 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 @@ -603,12 +603,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 @@ -1429,7 +1427,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" } _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
