+\begin{code}
+tcConDecl :: TyCon -> [TyVar] -> ThetaType -> RenamedConDecl -> TcM s DataCon
+
+tcConDecl tycon tyvars ctxt (ConDecl name ex_tvs ex_ctxt details src_loc)
+ = tcAddSrcLoc src_loc $
+ tcExtendTyVarScope ex_tvs $ \ ex_tyvars ->
+ tcContext ex_ctxt `thenTc` \ ex_theta ->
+ tc_con_decl_help tycon tyvars ctxt name ex_tyvars ex_theta details
+
+tc_con_decl_help tycon tyvars ctxt name ex_tyvars ex_theta details
+ = case details of
+ VanillaCon btys -> tc_datacon btys
+ InfixCon bty1 bty2 -> tc_datacon [bty1,bty2]
+ NewCon ty -> tc_newcon ty
+ RecCon fields -> tc_rec_con fields
+ where
+ tc_datacon btys
+ = let
+ arg_stricts = map get_strictness btys
+ tys = map get_pty btys
+ in
+ mapTc tcHsTopType tys `thenTc` \ arg_tys ->
+ mk_data_con arg_stricts arg_tys []
+
+ tc_newcon ty
+ = tcHsTopBoxedType ty `thenTc` \ arg_ty ->
+ -- can't allow an unboxed type here, because we're effectively
+ -- going to remove the constructor while coercing it to a boxed type.
+ mk_data_con [NotMarkedStrict] [arg_ty] []
+
+ tc_rec_con fields
+ = checkTc (null ex_tyvars) (exRecConErr name) `thenTc_`
+ mapTc tc_field fields `thenTc` \ field_label_infos_s ->
+ let
+ field_label_infos = concat field_label_infos_s
+ arg_stricts = [strict | (_, _, strict) <- field_label_infos]
+ arg_tys = [ty | (_, ty, _) <- field_label_infos]
+
+ field_labels = [ mkFieldLabel (getName name) ty tag
+ | ((name, ty, _), tag) <- field_label_infos `zip` allFieldLabelTags ]
+ in
+ mk_data_con arg_stricts arg_tys field_labels
+
+ tc_field (field_label_names, bty)
+ = tcHsTopType (get_pty bty) `thenTc` \ field_ty ->
+ returnTc [(name, field_ty, get_strictness bty) | name <- field_label_names]
+
+ mk_data_con arg_stricts arg_tys fields
+ = -- Now we've checked all the field types we must
+ -- zonk the existential tyvars to finish the kind
+ -- inference on their kinds, and commit them to being
+ -- immutable type variables. (The top-level tyvars are
+ -- already fixed, by the preceding kind-inference pass.)
+ mapNF_Tc zonkTcTyVarToTyVar ex_tyvars `thenNF_Tc` \ ex_tyvars' ->
+ zonkTcThetaType ex_theta `thenNF_Tc` \ ex_theta' ->
+ let
+ data_con = mkDataCon name arg_stricts fields
+ tyvars (thinContext arg_tys ctxt)
+ ex_tyvars' ex_theta'
+ arg_tys
+ tycon data_con_id
+ data_con_id = mkDataConId data_con
+ in
+ returnNF_Tc data_con
+
+-- The context for a data constructor should be limited to
+-- the type variables mentioned in the arg_tys
+thinContext arg_tys ctxt
+ = filter in_arg_tys ctxt
+ where
+ arg_tyvars = tyVarsOfTypes arg_tys
+ in_arg_tys (clas,tys) = not $ isEmptyVarSet $
+ tyVarsOfTypes tys `intersectVarSet` arg_tyvars
+
+get_strictness (Banged _) = MarkedStrict
+get_strictness (Unbanged _) = NotMarkedStrict
+
+get_pty (Banged ty) = ty
+get_pty (Unbanged ty) = ty