Skip to content
Snippets Groups Projects
Commit 29bbb9f5 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ian Lynagh
Browse files

An accidentally-omitted part of commit 8019bc2c, about promoting data constructors

parent 4b380f19
No related merge requests found
......@@ -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" }
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment