-zonkExpr (HsLam match)
- = zonkMatch match `thenNF_Tc` \ new_match ->
- returnNF_Tc (HsLam new_match)
-
-zonkExpr (HsApp e1 e2)
- = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
- zonkExpr e2 `thenNF_Tc` \ new_e2 ->
- returnNF_Tc (HsApp new_e1 new_e2)
-
-zonkExpr (OpApp e1 op fixity e2)
- = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
- zonkExpr op `thenNF_Tc` \ new_op ->
- zonkExpr e2 `thenNF_Tc` \ new_e2 ->
- returnNF_Tc (OpApp new_e1 new_op fixity new_e2)
-
-zonkExpr (NegApp _ _) = panic "zonkExpr: NegApp"
-zonkExpr (HsPar _) = panic "zonkExpr: HsPar"
-
-zonkExpr (SectionL expr op)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- zonkExpr op `thenNF_Tc` \ new_op ->
- returnNF_Tc (SectionL new_expr new_op)
-
-zonkExpr (SectionR op expr)
- = zonkExpr op `thenNF_Tc` \ new_op ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (SectionR new_op new_expr)
-
-zonkExpr (HsCase expr ms src_loc)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- mapNF_Tc zonkMatch ms `thenNF_Tc` \ new_ms ->
- returnNF_Tc (HsCase new_expr new_ms src_loc)
-
-zonkExpr (HsIf e1 e2 e3 src_loc)
- = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
- zonkExpr e2 `thenNF_Tc` \ new_e2 ->
- zonkExpr e3 `thenNF_Tc` \ new_e3 ->
- returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
-
-zonkExpr (HsLet binds expr)
- = zonkBinds binds `thenNF_Tc` \ (new_binds, new_env) ->
- tcSetEnv new_env $
- zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (HsLet new_binds new_expr)
-
-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 ->
- returnNF_Tc (ArithSeqOut new_expr new_info)
-
-zonkExpr (HsCCall fun args may_gc is_casm result_ty)
- = mapNF_Tc zonkExpr args `thenNF_Tc` \ new_args ->
- zonkTcTypeToType result_ty `thenNF_Tc` \ new_result_ty ->
- returnNF_Tc (HsCCall fun new_args may_gc is_casm new_result_ty)
-
-zonkExpr (HsSCC lbl expr)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (HsSCC lbl new_expr)
-
-zonkExpr (TyLam tyvars expr)
- = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
+zonkExpr env (HsLam match)
+ = zonkMatch env match `thenM` \ new_match ->
+ returnM (HsLam new_match)
+
+zonkExpr env (HsApp e1 e2)
+ = zonkLExpr env e1 `thenM` \ new_e1 ->
+ zonkLExpr env e2 `thenM` \ new_e2 ->
+ returnM (HsApp new_e1 new_e2)
+
+zonkExpr env (HsBracketOut body bs)
+ = mappM zonk_b bs `thenM` \ bs' ->
+ returnM (HsBracketOut body bs')
+ where
+ zonk_b (n,e) = zonkLExpr env e `thenM` \ e' ->
+ returnM (n,e')
+
+zonkExpr env (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
+ returnM (HsSpliceE s)
+
+zonkExpr env (OpApp e1 op fixity e2)
+ = zonkLExpr env e1 `thenM` \ new_e1 ->
+ zonkLExpr env op `thenM` \ new_op ->
+ zonkLExpr env e2 `thenM` \ new_e2 ->
+ returnM (OpApp new_e1 new_op fixity new_e2)
+
+zonkExpr env (NegApp _ _) = panic "zonkExpr env: NegApp"
+
+zonkExpr env (HsPar e)
+ = zonkLExpr env e `thenM` \new_e ->
+ returnM (HsPar new_e)
+
+zonkExpr env (SectionL expr op)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ zonkLExpr env op `thenM` \ new_op ->
+ returnM (SectionL new_expr new_op)
+
+zonkExpr env (SectionR op expr)
+ = zonkLExpr env op `thenM` \ new_op ->
+ zonkLExpr env expr `thenM` \ new_expr ->
+ returnM (SectionR new_op new_expr)
+
+zonkExpr env (HsCase expr ms)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ mappM (zonkMatch env) ms `thenM` \ new_ms ->
+ returnM (HsCase new_expr new_ms)
+
+zonkExpr env (HsIf e1 e2 e3)
+ = zonkLExpr env e1 `thenM` \ new_e1 ->
+ zonkLExpr env e2 `thenM` \ new_e2 ->
+ zonkLExpr env e3 `thenM` \ new_e3 ->
+ returnM (HsIf new_e1 new_e2 new_e3)
+
+zonkExpr env (HsLet binds expr)
+ = zonkNestedBinds env binds `thenM` \ (new_env, new_binds) ->
+ zonkLExpr new_env expr `thenM` \ new_expr ->
+ returnM (HsLet new_binds new_expr)
+
+zonkExpr env (HsDo do_or_lc stmts ids ty)
+ = zonkStmts env stmts `thenM` \ new_stmts ->
+ zonkTcTypeToType env ty `thenM` \ new_ty ->
+ zonkReboundNames env ids `thenM` \ new_ids ->
+ returnM (HsDo do_or_lc new_stmts new_ids new_ty)
+
+zonkExpr env (ExplicitList ty exprs)
+ = zonkTcTypeToType env ty `thenM` \ new_ty ->
+ zonkLExprs env exprs `thenM` \ new_exprs ->
+ returnM (ExplicitList new_ty new_exprs)
+
+zonkExpr env (ExplicitPArr ty exprs)
+ = zonkTcTypeToType env ty `thenM` \ new_ty ->
+ zonkLExprs env exprs `thenM` \ new_exprs ->
+ returnM (ExplicitPArr new_ty new_exprs)
+
+zonkExpr env (ExplicitTuple exprs boxed)
+ = zonkLExprs env exprs `thenM` \ new_exprs ->
+ returnM (ExplicitTuple new_exprs boxed)
+
+zonkExpr env (RecordConOut data_con con_expr rbinds)
+ = zonkLExpr env con_expr `thenM` \ new_con_expr ->
+ zonkRbinds env rbinds `thenM` \ new_rbinds ->
+ returnM (RecordConOut data_con new_con_expr new_rbinds)
+
+zonkExpr env (RecordUpd _ _) = panic "zonkExpr env:RecordUpd"
+
+zonkExpr env (RecordUpdOut expr in_ty out_ty rbinds)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ zonkTcTypeToType env in_ty `thenM` \ new_in_ty ->
+ zonkTcTypeToType env out_ty `thenM` \ new_out_ty ->
+ zonkRbinds env rbinds `thenM` \ new_rbinds ->
+ returnM (RecordUpdOut new_expr new_in_ty new_out_ty new_rbinds)
+
+zonkExpr env (ExprWithTySig _ _) = panic "zonkExpr env:ExprWithTySig"
+zonkExpr env (ArithSeqIn _) = panic "zonkExpr env:ArithSeqIn"
+zonkExpr env (PArrSeqIn _) = panic "zonkExpr env:PArrSeqIn"
+
+zonkExpr env (ArithSeqOut expr info)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ zonkArithSeq env info `thenM` \ new_info ->
+ returnM (ArithSeqOut new_expr new_info)
+
+zonkExpr env (PArrSeqOut expr info)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ zonkArithSeq env info `thenM` \ new_info ->
+ returnM (PArrSeqOut new_expr new_info)
+
+zonkExpr env (HsSCC lbl expr)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ returnM (HsSCC lbl new_expr)
+
+-- hdaume: core annotations
+zonkExpr env (HsCoreAnn lbl expr)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ returnM (HsCoreAnn lbl new_expr)
+
+zonkExpr env (TyLam tyvars expr)
+ = mappM zonkTcTyVarToTyVar tyvars `thenM` \ new_tyvars ->