-zonkPat :: TcPat s -> NF_TcM s TypecheckedPat
-
-zonkPat (WildPat ty)
- = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
- returnNF_Tc (WildPat new_ty)
-
-zonkPat (VarPat v)
- = zonkId v `thenNF_Tc` \ new_v ->
- returnNF_Tc (VarPat new_v)
-
-zonkPat (LazyPat pat)
- = zonkPat pat `thenNF_Tc` \ new_pat ->
- returnNF_Tc (LazyPat new_pat)
-
-zonkPat (AsPat n pat)
- = zonkId n `thenNF_Tc` \ new_n ->
- zonkPat pat `thenNF_Tc` \ new_pat ->
- returnNF_Tc (AsPat new_n new_pat)
-
-zonkPat (ConPat n ty pats)
- = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
- mapNF_Tc zonkPat pats `thenNF_Tc` \ new_pats ->
- returnNF_Tc (ConPat n new_ty new_pats)
-
-zonkPat (ConOpPat pat1 op pat2 ty)
- = zonkPat pat1 `thenNF_Tc` \ new_pat1 ->
- zonkPat pat2 `thenNF_Tc` \ new_pat2 ->
- zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
- returnNF_Tc (ConOpPat new_pat1 op new_pat2 new_ty)
-
-zonkPat (ListPat ty pats)
- = 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)
-
-zonkPat (LitPat lit ty)
- = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
- returnNF_Tc (LitPat lit new_ty)
-
-zonkPat (NPat lit ty expr)
- = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (NPat lit new_ty new_expr)
-
-zonkPat (DictPat ds ms)
- = mapNF_Tc zonkId ds `thenNF_Tc` \ new_ds ->
- mapNF_Tc zonkId ms `thenNF_Tc` \ new_ms ->
- returnNF_Tc (DictPat new_ds new_ms)
+zonkPat :: TyVarEnv Type
+ -> TcPat s -> NF_TcM s (TypecheckedPat, Bag TyVar, Bag Id)
+
+zonkPat te (WildPat ty)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ returnNF_Tc (WildPat new_ty, emptyBag, emptyBag)
+
+zonkPat te (VarPat v)
+ = zonkIdBndr te v `thenNF_Tc` \ new_v ->
+ returnNF_Tc (VarPat new_v, emptyBag, unitBag new_v)
+
+zonkPat te (LazyPat pat)
+ = zonkPat te pat `thenNF_Tc` \ (new_pat, tvs, ids) ->
+ returnNF_Tc (LazyPat new_pat, tvs, ids)
+
+zonkPat te (AsPat n pat)
+ = zonkIdBndr te n `thenNF_Tc` \ new_n ->
+ zonkPat te pat `thenNF_Tc` \ (new_pat, tvs, ids) ->
+ returnNF_Tc (AsPat new_n new_pat, tvs, new_n `consBag` ids)
+
+zonkPat te (ListPat ty pats)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ zonkPats te pats `thenNF_Tc` \ (new_pats, tvs, ids) ->
+ returnNF_Tc (ListPat new_ty new_pats, tvs, ids)
+
+zonkPat te (TuplePat pats boxed)
+ = zonkPats te pats `thenNF_Tc` \ (new_pats, tvs, ids) ->
+ returnNF_Tc (TuplePat new_pats boxed, tvs, ids)
+
+zonkPat te (ConPat n ty tvs dicts pats)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ mapNF_Tc zonkTcTyVarToTyVar tvs `thenNF_Tc` \ new_tvs ->
+ let
+ new_te = extend_te te new_tvs
+ in
+ mapNF_Tc (zonkIdBndr new_te) dicts `thenNF_Tc` \ new_dicts ->
+ tcExtendGlobalValEnv new_dicts $
+
+ zonkPats new_te pats `thenNF_Tc` \ (new_pats, tvs, ids) ->
+
+ returnNF_Tc (ConPat n new_ty new_tvs new_dicts new_pats,
+ listToBag new_tvs `unionBags` tvs,
+ listToBag new_dicts `unionBags` ids)
+
+zonkPat te (RecPat n ty tvs dicts rpats)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ mapNF_Tc zonkTcTyVarToTyVar tvs `thenNF_Tc` \ new_tvs ->
+ let
+ new_te = extend_te te new_tvs
+ in
+ mapNF_Tc (zonkIdBndr new_te) dicts `thenNF_Tc` \ new_dicts ->
+ tcExtendGlobalValEnv new_dicts $
+ mapNF_Tc (zonk_rpat new_te) rpats `thenNF_Tc` \ stuff ->
+ let
+ (new_rpats, tvs_s, ids_s) = unzip3 stuff
+ in
+ returnNF_Tc (RecPat n new_ty new_tvs new_dicts new_rpats,
+ listToBag new_tvs `unionBags` unionManyBags tvs_s,
+ listToBag new_dicts `unionBags` unionManyBags ids_s)
+ where
+ zonk_rpat te (f, pat, pun)
+ = zonkPat te pat `thenNF_Tc` \ (new_pat, tvs, ids) ->
+ returnNF_Tc ((f, new_pat, pun), tvs, ids)
+
+zonkPat te (LitPat lit ty)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ returnNF_Tc (LitPat lit new_ty, emptyBag, emptyBag)
+
+zonkPat te (NPat lit ty expr)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ zonkExpr te expr `thenNF_Tc` \ new_expr ->
+ returnNF_Tc (NPat lit new_ty new_expr, emptyBag, emptyBag)
+
+zonkPat te (NPlusKPat n k ty e1 e2)
+ = zonkIdBndr te n `thenNF_Tc` \ new_n ->
+ zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ zonkExpr te e1 `thenNF_Tc` \ new_e1 ->
+ zonkExpr te e2 `thenNF_Tc` \ new_e2 ->
+ returnNF_Tc (NPlusKPat new_n k new_ty new_e1 new_e2, emptyBag, unitBag new_n)
+
+zonkPat te (DictPat ds ms)
+ = mapNF_Tc (zonkIdBndr te) ds `thenNF_Tc` \ new_ds ->
+ mapNF_Tc (zonkIdBndr te) ms `thenNF_Tc` \ new_ms ->
+ returnNF_Tc (DictPat new_ds new_ms, emptyBag,
+ listToBag new_ds `unionBags` listToBag new_ms)
+
+
+zonkPats te []
+ = returnNF_Tc ([], emptyBag, emptyBag)
+
+zonkPats te (pat:pats)
+ = zonkPat te pat `thenNF_Tc` \ (pat', tvs1, ids1) ->
+ zonkPats te pats `thenNF_Tc` \ (pats', tvs2, ids2) ->
+ returnNF_Tc (pat':pats', tvs1 `unionBags` tvs2, ids1 `unionBags` ids2)