- = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
- mapNF_Tc zonkPat pats `thenNF_Tc` \ new_pats ->
- returnNF_Tc (ListPat new_ty new_pats)
-
-zonkPat (TuplePat pats)
- = mapNF_Tc zonkPat pats `thenNF_Tc` \ new_pats ->
- returnNF_Tc (TuplePat new_pats)
+ = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
+ zonkPats pats `thenNF_Tc` \ (new_pats, ids) ->
+ returnNF_Tc (ListPat new_ty new_pats, ids)
+
+zonkPat (TuplePat pats boxed)
+ = zonkPats pats `thenNF_Tc` \ (new_pats, ids) ->
+ returnNF_Tc (TuplePat new_pats boxed, ids)
+
+zonkPat (ConPat n ty tvs dicts pats)
+ = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
+ mapNF_Tc zonkTcTyVarToTyVar tvs `thenNF_Tc` \ new_tvs ->
+ mapNF_Tc zonkIdBndr dicts `thenNF_Tc` \ new_dicts ->
+ tcExtendGlobalValEnv new_dicts $
+ zonkPats pats `thenNF_Tc` \ (new_pats, ids) ->
+ returnNF_Tc (ConPat n new_ty new_tvs new_dicts new_pats,
+ listToBag new_dicts `unionBags` ids)
+
+zonkPat (RecPat n ty tvs dicts rpats)
+ = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
+ mapNF_Tc zonkTcTyVarToTyVar tvs `thenNF_Tc` \ new_tvs ->
+ mapNF_Tc zonkIdBndr dicts `thenNF_Tc` \ new_dicts ->
+ tcExtendGlobalValEnv new_dicts $
+ mapAndUnzipNF_Tc zonk_rpat rpats `thenNF_Tc` \ (new_rpats, ids_s) ->
+ returnNF_Tc (RecPat n new_ty new_tvs new_dicts new_rpats,
+ listToBag new_dicts `unionBags` unionManyBags ids_s)
+ where
+ zonk_rpat (f, pat, pun)
+ = zonkPat pat `thenNF_Tc` \ (new_pat, ids) ->
+ returnNF_Tc ((f, new_pat, pun), ids)