-zonkExpr te ve (HsDo _ _) = panic "zonkExpr te ve:HsDo"
-
-zonkExpr te ve (HsDoOut stmts then_id zero_id src_loc)
- = zonkStmts te ve stmts `thenNF_Tc` \ new_stmts ->
- returnNF_Tc (HsDoOut new_stmts (zonkIdOcc ve then_id) (zonkIdOcc ve zero_id) src_loc)
-
-zonkExpr te ve (ListComp expr quals)
- = zonkQuals te ve quals `thenNF_Tc` \ (new_quals, new_ve) ->
- zonkExpr te new_ve expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (ListComp new_expr new_quals)
-
-zonkExpr te ve (ExplicitList _) = panic "zonkExpr te ve:ExplicitList"
-
-zonkExpr te ve (ExplicitListOut ty exprs)
- = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
- mapNF_Tc (zonkExpr te ve) exprs `thenNF_Tc` \ new_exprs ->
- returnNF_Tc (ExplicitListOut new_ty new_exprs)
-
-zonkExpr te ve (ExplicitTuple exprs)
- = mapNF_Tc (zonkExpr te ve) exprs `thenNF_Tc` \ new_exprs ->
- returnNF_Tc (ExplicitTuple new_exprs)
-
-zonkExpr te ve (RecordCon con rbinds)
- = zonkExpr te ve con `thenNF_Tc` \ new_con ->
- zonkRbinds te ve rbinds `thenNF_Tc` \ new_rbinds ->
- returnNF_Tc (RecordCon new_con new_rbinds)
-
-zonkExpr te ve (RecordUpd _ _) = panic "zonkExpr te ve:RecordUpd"
-
-zonkExpr te ve (RecordUpdOut expr dicts rbinds)
- = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
- zonkRbinds te ve rbinds `thenNF_Tc` \ new_rbinds ->
- returnNF_Tc (RecordUpdOut new_expr new_dicts new_rbinds)
- where
- new_dicts = map (zonkIdOcc ve) dicts
-
-zonkExpr te ve (ExprWithTySig _ _) = panic "zonkExpr te ve:ExprWithTySig"
-zonkExpr te ve (ArithSeqIn _) = panic "zonkExpr te ve:ArithSeqIn"
-
-zonkExpr te ve (ArithSeqOut expr info)
- = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
- zonkArithSeq te ve info `thenNF_Tc` \ new_info ->
+zonkExpr (HsWith expr binds)
+ = zonkIPBinds binds `thenNF_Tc` \ new_binds ->
+ tcExtendGlobalValEnv (map fst new_binds) $
+ zonkExpr expr `thenNF_Tc` \ new_expr ->
+ returnNF_Tc (HsWith new_expr new_binds)
+ where
+ zonkIPBinds = mapNF_Tc zonkIPBind
+ zonkIPBind (n, e) =
+ zonkIdBndr n `thenNF_Tc` \ n' ->
+ zonkExpr e `thenNF_Tc` \ e' ->
+ returnNF_Tc (n', e')
+
+zonkExpr (HsDo _ _ _) = panic "zonkExpr:HsDo"
+
+zonkExpr (HsDoOut do_or_lc stmts return_id then_id zero_id ty src_loc)
+ = zonkStmts stmts `thenNF_Tc` \ new_stmts ->
+ zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
+ zonkIdOcc return_id `thenNF_Tc` \ new_return_id ->
+ zonkIdOcc then_id `thenNF_Tc` \ new_then_id ->
+ zonkIdOcc zero_id `thenNF_Tc` \ new_zero_id ->
+ returnNF_Tc (HsDoOut do_or_lc new_stmts new_return_id new_then_id new_zero_id
+ new_ty src_loc)
+
+zonkExpr (ExplicitList ty exprs)
+ = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
+ mapNF_Tc zonkExpr exprs `thenNF_Tc` \ new_exprs ->
+ returnNF_Tc (ExplicitList new_ty new_exprs)
+
+zonkExpr (ExplicitTuple exprs boxed)
+ = mapNF_Tc zonkExpr exprs `thenNF_Tc` \ new_exprs ->
+ returnNF_Tc (ExplicitTuple new_exprs boxed)
+
+zonkExpr (RecordConOut data_con con_expr rbinds)
+ = zonkExpr con_expr `thenNF_Tc` \ new_con_expr ->
+ zonkRbinds rbinds `thenNF_Tc` \ new_rbinds ->
+ returnNF_Tc (RecordConOut data_con new_con_expr new_rbinds)
+
+zonkExpr (RecordUpd _ _) = panic "zonkExpr:RecordUpd"
+
+zonkExpr (RecordUpdOut expr in_ty out_ty dicts rbinds)
+ = zonkExpr expr `thenNF_Tc` \ new_expr ->
+ zonkTcTypeToType in_ty `thenNF_Tc` \ new_in_ty ->
+ zonkTcTypeToType out_ty `thenNF_Tc` \ new_out_ty ->
+ mapNF_Tc zonkIdOcc dicts `thenNF_Tc` \ new_dicts ->
+ zonkRbinds rbinds `thenNF_Tc` \ new_rbinds ->
+ returnNF_Tc (RecordUpdOut new_expr new_in_ty new_out_ty new_dicts new_rbinds)
+
+zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
+zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
+
+zonkExpr (ArithSeqOut expr info)
+ = zonkExpr expr `thenNF_Tc` \ new_expr ->
+ zonkArithSeq info `thenNF_Tc` \ new_info ->