-Constructors
-~~~~~~~~~~~~
-\begin{code}
-tcConDecl :: TyCon -> [TyVar] -> [(Class,Type)] -> RenamedConDecl -> TcM s Id
-
-tcConDecl tycon tyvars ctxt (ConDecl name btys src_loc)
- = tcDataCon tycon tyvars ctxt name btys src_loc
-
-tcConDecl tycon tyvars ctxt (ConOpDecl bty1 op bty2 src_loc)
- = tcDataCon tycon tyvars ctxt op [bty1,bty2] src_loc
-
-tcConDecl tycon tyvars ctxt (NewConDecl name ty src_loc)
- = tcAddSrcLoc src_loc $
- tcHsType ty `thenTc` \ arg_ty ->
- let
- data_con = mkDataCon (getName name)
- [NotMarkedStrict]
- [{- No labelled fields -}]
- tyvars
- ctxt
- [arg_ty]
- tycon
- -- nullSpecEnv
- in
- returnTc data_con
-
-tcConDecl tycon tyvars ctxt (RecConDecl name fields src_loc)
- = tcAddSrcLoc src_loc $
- mapTc tcField fields `thenTc` \ field_label_infos_s ->
- let
- field_label_infos = concat field_label_infos_s
- 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 ]
-
- data_con = mkDataCon (getName name)
- stricts
- field_labels
- tyvars
- (thinContext arg_tys ctxt)
- arg_tys
- tycon
- -- nullSpecEnv
- in
- returnTc data_con
-
-tcField (field_label_names, bty)
- = tcHsType (get_pty bty) `thenTc` \ field_ty ->
- returnTc [(name, field_ty, get_strictness bty) | name <- field_label_names]
-
-tcDataCon tycon tyvars ctxt name btys src_loc
- = tcAddSrcLoc src_loc $
- let
- stricts = map get_strictness btys
- tys = map get_pty btys
- in
- mapTc tcHsType tys `thenTc` \ arg_tys ->
- let
- data_con = mkDataCon (getName name)
- stricts
- [{- No field labels -}]
- tyvars
- (thinContext arg_tys ctxt)
- arg_tys
- tycon
- -- nullSpecEnv
- in
- returnTc 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,ty) = getTyVar "tcDataCon" ty `elementOfTyVarSet` arg_tyvars
-
-get_strictness (Banged _) = MarkedStrict
-get_strictness (Unbanged _) = NotMarkedStrict
-
-get_pty (Banged ty) = ty
-get_pty (Unbanged ty) = ty
-\end{code}
-
-