X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcHsSyn.lhs;h=880dc7aef094557ca0dd9ba11c7429cb739d01f9;hb=c048887754562e180e5efbc69c97cdcb24cd2121;hp=54d2b7a262153a4e5b29a17e645241db06223f85;hpb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs index 54d2b7a..880dc7a 100644 --- a/ghc/compiler/typecheck/TcHsSyn.lhs +++ b/ghc/compiler/typecheck/TcHsSyn.lhs @@ -10,55 +10,61 @@ checker. #include "HsVersions.h" module TcHsSyn ( - TcIdBndr(..), TcIdOcc(..), + SYN_IE(TcIdBndr), TcIdOcc(..), - TcMonoBinds(..), TcHsBinds(..), TcBind(..), TcPat(..), - TcExpr(..), TcGRHSsAndBinds(..), TcGRHS(..), TcMatch(..), - TcQual(..), TcStmt(..), TcArithSeqInfo(..), TcRecordBinds(..), - TcHsModule(..), + SYN_IE(TcMonoBinds), SYN_IE(TcHsBinds), SYN_IE(TcPat), + SYN_IE(TcExpr), SYN_IE(TcGRHSsAndBinds), SYN_IE(TcGRHS), SYN_IE(TcMatch), + SYN_IE(TcStmt), SYN_IE(TcArithSeqInfo), SYN_IE(TcRecordBinds), + SYN_IE(TcHsModule), SYN_IE(TcCoreExpr), SYN_IE(TcDictBinds), - TypecheckedHsBinds(..), TypecheckedBind(..), - TypecheckedMonoBinds(..), TypecheckedPat(..), - TypecheckedHsExpr(..), TypecheckedArithSeqInfo(..), - TypecheckedQual(..), TypecheckedStmt(..), - TypecheckedMatch(..), TypecheckedHsModule(..), - TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..), - TypecheckedRecordBinds(..), + SYN_IE(TypecheckedHsBinds), + SYN_IE(TypecheckedMonoBinds), SYN_IE(TypecheckedPat), + SYN_IE(TypecheckedHsExpr), SYN_IE(TypecheckedArithSeqInfo), + SYN_IE(TypecheckedStmt), + SYN_IE(TypecheckedMatch), SYN_IE(TypecheckedHsModule), + SYN_IE(TypecheckedGRHSsAndBinds), SYN_IE(TypecheckedGRHS), + SYN_IE(TypecheckedRecordBinds), SYN_IE(TypecheckedDictBinds), mkHsTyApp, mkHsDictApp, mkHsTyLam, mkHsDictLam, tcIdType, tcIdTyVars, - zonkBinds, - zonkDictBinds + zonkBinds, zonkMonoBinds ) where IMP_Ubiq(){-uitous-} -- friends: import HsSyn -- oodles of it -import Id ( GenId(..), IdDetails, PragmaInfo, -- Can meddle modestly with Ids - DictVar(..), idType, - IdEnv(..), growIdEnvList, lookupIdEnv +import Id ( GenId(..), IdDetails, -- Can meddle modestly with Ids + SYN_IE(DictVar), idType, + SYN_IE(IdEnv), growIdEnvList, lookupIdEnv, + SYN_IE(Id) ) -- others: -import Name ( Name{--O only-} ) -import TcMonad hiding ( rnMtoTcM ) -import TcType ( TcType(..), TcMaybe, TcTyVar(..), +import Name ( Name{--O only-}, NamedThing(..) ) +import TcMonad +import TcType ( SYN_IE(TcType), TcMaybe, SYN_IE(TcTyVar), zonkTcTypeToType, zonkTcTyVarToTyVar ) -import Usage ( UVar(..) ) -import Util ( zipEqual, panic, pprPanic, pprTrace ) +import Usage ( SYN_IE(UVar) ) +import Util ( zipEqual, panic, + pprPanic, pprTrace +#ifdef DEBUG + , assertPanic +#endif + ) import PprType ( GenType, GenTyVar ) -- instances -import Type ( mkTyVarTy, tyVarsOfType ) -import TyVar ( GenTyVar {- instances -}, - TyVarEnv(..), growTyVarEnvList, emptyTyVarSet ) -import TysWiredIn ( voidTy ) +import Type ( mkTyVarTy, tyVarsOfType, SYN_IE(Type) ) +import TyVar ( GenTyVar {- instances -}, SYN_IE(TyVar), + SYN_IE(TyVarEnv), growTyVarEnvList, emptyTyVarSet ) +import TysPrim ( voidTy ) +import CoreSyn ( GenCoreExpr ) import Unique ( Unique ) -- instances import UniqFM -import PprStyle +import Outputable import Pretty \end{code} @@ -79,26 +85,26 @@ data TcIdOcc s = TcId (TcIdBndr s) -- Bindees may be either | RealId Id type TcHsBinds s = HsBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s) -type TcBind s = Bind (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcMonoBinds s = MonoBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s) +type TcDictBinds s = TcMonoBinds s type TcPat s = OutPat (TcTyVar s) UVar (TcIdOcc s) type TcExpr s = HsExpr (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcGRHSsAndBinds s = GRHSsAndBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcGRHS s = GRHS (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcMatch s = Match (TcTyVar s) UVar (TcIdOcc s) (TcPat s) -type TcQual s = Qual (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcStmt s = Stmt (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcArithSeqInfo s = ArithSeqInfo (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcRecordBinds s = HsRecordBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s) type TcHsModule s = HsModule (TcTyVar s) UVar (TcIdOcc s) (TcPat s) +type TcCoreExpr s = GenCoreExpr (TcIdOcc s) (TcIdOcc s) (TcTyVar s) UVar + type TypecheckedPat = OutPat TyVar UVar Id type TypecheckedMonoBinds = MonoBinds TyVar UVar Id TypecheckedPat +type TypecheckedDictBinds = TypecheckedMonoBinds type TypecheckedHsBinds = HsBinds TyVar UVar Id TypecheckedPat -type TypecheckedBind = Bind TyVar UVar Id TypecheckedPat type TypecheckedHsExpr = HsExpr TyVar UVar Id TypecheckedPat type TypecheckedArithSeqInfo = ArithSeqInfo TyVar UVar Id TypecheckedPat -type TypecheckedQual = Qual TyVar UVar Id TypecheckedPat type TypecheckedStmt = Stmt TyVar UVar Id TypecheckedPat type TypecheckedMatch = Match TyVar UVar Id TypecheckedPat type TypecheckedGRHSsAndBinds = GRHSsAndBinds TyVar UVar Id TypecheckedPat @@ -185,26 +191,6 @@ extend_ve ve ids = growIdEnvList ve [(id,id) | id <- ids] extend_te te tyvars = growTyVarEnvList te [(tyvar, mkTyVarTy tyvar) | tyvar <- tyvars] \end{code} -\begin{code} - -- Implicitly mutually recursive, which is overkill, - -- but it means that later ones see earlier ones -zonkDictBinds te ve dbs - = fixNF_Tc (\ ~(_,new_ve) -> - zonkDictBindsLocal te new_ve dbs `thenNF_Tc` \ (new_binds, dict_ids) -> - returnNF_Tc (new_binds, extend_ve ve dict_ids) - ) - - -- The ..Local version assumes the caller has set up - -- a ve that contains all the things bound here -zonkDictBindsLocal te ve [] = returnNF_Tc ([], []) - -zonkDictBindsLocal te ve ((dict,rhs) : binds) - = zonkIdBndr te dict `thenNF_Tc` \ new_dict -> - zonkExpr te ve rhs `thenNF_Tc` \ new_rhs -> - zonkDictBindsLocal te ve binds `thenNF_Tc` \ (new_binds, dict_ids) -> - returnNF_Tc ((new_dict,new_rhs) : new_binds, - new_dict:dict_ids) -\end{code} \begin{code} zonkBinds :: TyVarEnv Type -> IdEnv Id @@ -217,53 +203,16 @@ zonkBinds te ve (ThenBinds binds1 binds2) zonkBinds te ve1 binds2 `thenNF_Tc` \ (new_binds2, ve2) -> returnNF_Tc (ThenBinds new_binds1 new_binds2, ve2) -zonkBinds te ve (SingleBind bind) - = fixNF_Tc (\ ~(_,new_ve) -> - zonkBind te new_ve bind `thenNF_Tc` \ (new_bind, new_ids) -> - returnNF_Tc (SingleBind new_bind, extend_ve ve new_ids) +zonkBinds te ve (MonoBind bind sigs is_rec) + = ASSERT( null sigs ) + fixNF_Tc (\ ~(_,new_ve) -> + zonkMonoBinds te new_ve bind `thenNF_Tc` \ (new_bind, new_ids) -> + returnNF_Tc (MonoBind new_bind [] is_rec, extend_ve ve new_ids) ) - -zonkBinds te ve (AbsBinds tyvars dicts locprs dict_binds val_bind) - = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars -> - let - new_te = extend_te te new_tyvars - in - mapNF_Tc (zonkIdBndr new_te) dicts `thenNF_Tc` \ new_dicts -> - mapNF_Tc (zonkIdBndr new_te) globals `thenNF_Tc` \ new_globals -> - let - ve1 = extend_ve ve new_globals - ve2 = extend_ve ve1 new_dicts - in - fixNF_Tc (\ ~(_, ve3) -> - zonkDictBindsLocal new_te ve3 dict_binds `thenNF_Tc` \ (new_dict_binds, ds) -> - zonkBind new_te ve3 val_bind `thenNF_Tc` \ (new_val_bind, ls) -> - let - new_locprs = zipEqual "zonkBinds" (map (zonkIdOcc ve3) locals) new_globals - in - returnNF_Tc (AbsBinds new_tyvars new_dicts new_locprs new_dict_binds new_val_bind, - extend_ve ve2 (ds++ls)) - ) `thenNF_Tc` \ (binds, _) -> - returnNF_Tc (binds, ve1) -- Yes, the "ve1" is right (SLPJ) - where - (locals, globals) = unzip locprs \end{code} \begin{code} ------------------------------------------------------------------------- -zonkBind :: TyVarEnv Type -> IdEnv Id - -> TcBind s -> NF_TcM s (TypecheckedBind, [Id]) - -zonkBind te ve EmptyBind = returnNF_Tc (EmptyBind, []) - -zonkBind te ve (NonRecBind mbinds) - = zonkMonoBinds te ve mbinds `thenNF_Tc` \ (new_mbinds, new_ids) -> - returnNF_Tc (NonRecBind new_mbinds, new_ids) - -zonkBind te ve (RecBind mbinds) - = zonkMonoBinds te ve mbinds `thenNF_Tc` \ (new_mbinds, new_ids) -> - returnNF_Tc (RecBind new_mbinds, new_ids) - -------------------------------------------------------------------------- zonkMonoBinds :: TyVarEnv Type -> IdEnv Id -> TcMonoBinds s -> NF_TcM s (TypecheckedMonoBinds, [Id]) @@ -284,10 +233,43 @@ zonkMonoBinds te ve (VarMonoBind var expr) zonkExpr te ve expr `thenNF_Tc` \ new_expr -> returnNF_Tc (VarMonoBind new_var new_expr, [new_var]) +zonkMonoBinds te ve (CoreMonoBind var core_expr) + = zonkIdBndr te var `thenNF_Tc` \ new_var -> + returnNF_Tc (CoreMonoBind new_var core_expr, [new_var]) + zonkMonoBinds te ve (FunMonoBind var inf ms locn) = zonkIdBndr te var `thenNF_Tc` \ new_var -> mapNF_Tc (zonkMatch te ve) ms `thenNF_Tc` \ new_ms -> returnNF_Tc (FunMonoBind new_var inf new_ms locn, [new_var]) + + +zonkMonoBinds te ve (AbsBinds tyvars dicts exports val_bind) + = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars -> + let + new_te = extend_te te new_tyvars + in + mapNF_Tc (zonkIdBndr new_te) dicts `thenNF_Tc` \ new_dicts -> + + let + ve1 = extend_ve ve new_dicts + in + fixNF_Tc (\ ~(_, _, ve2) -> + zonkMonoBinds new_te ve2 val_bind `thenNF_Tc` \ (new_val_bind, new_ids) -> + mapNF_Tc (zonkExport new_te ve2) exports `thenNF_Tc` \ new_exports -> + returnNF_Tc (new_val_bind, new_exports, extend_ve ve1 new_ids) + ) `thenNF_Tc ` \ (new_val_bind, new_exports, _) -> + + let + new_globals = [global | (_, global, local) <- new_exports] + in + returnNF_Tc (AbsBinds new_tyvars new_dicts new_exports new_val_bind, + new_globals) + + where + zonkExport te ve (tyvars, global, local) + = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars -> + zonkIdBndr te global `thenNF_Tc` \ new_global -> + returnNF_Tc (new_tyvars, new_global, zonkIdOcc ve local) \end{code} %************************************************************************ @@ -325,8 +307,8 @@ zonkGRHSsAndBinds te ve (GRHSsAndBindsOut grhss binds ty) = zonkBinds te ve binds `thenNF_Tc` \ (new_binds, new_ve) -> let zonk_grhs (GRHS guard expr locn) - = zonkExpr te new_ve guard `thenNF_Tc` \ new_guard -> - zonkExpr te new_ve expr `thenNF_Tc` \ new_expr -> + = zonkStmts te new_ve guard `thenNF_Tc` \ (new_guard, new_ve2) -> + zonkExpr te new_ve2 expr `thenNF_Tc` \ new_expr -> returnNF_Tc (GRHS new_guard new_expr locn) zonk_grhs (OtherwiseGRHS expr locn) @@ -345,9 +327,10 @@ zonkGRHSsAndBinds te ve (GRHSsAndBindsOut grhss binds ty) %************************************************************************ \begin{code} +{- zonkExpr :: TyVarEnv Type -> IdEnv Id -> TcExpr s -> NF_TcM s TypecheckedHsExpr - +-} zonkExpr te ve (HsVar name) = returnNF_Tc (HsVar (zonkIdOcc ve name)) @@ -366,11 +349,11 @@ zonkExpr te ve (HsApp e1 e2) zonkExpr te ve e2 `thenNF_Tc` \ new_e2 -> returnNF_Tc (HsApp new_e1 new_e2) -zonkExpr te ve (OpApp e1 op e2) +zonkExpr te ve (OpApp e1 op fixity e2) = zonkExpr te ve e1 `thenNF_Tc` \ new_e1 -> zonkExpr te ve op `thenNF_Tc` \ new_op -> zonkExpr te ve e2 `thenNF_Tc` \ new_e2 -> - returnNF_Tc (OpApp new_e1 new_op new_e2) + returnNF_Tc (OpApp new_e1 new_op fixity new_e2) zonkExpr te ve (NegApp _ _) = panic "zonkExpr te ve:NegApp" zonkExpr te ve (HsPar _) = panic "zonkExpr te ve:HsPar" @@ -401,16 +384,16 @@ zonkExpr te ve (HsLet binds expr) zonkExpr te new_ve expr `thenNF_Tc` \ new_expr -> returnNF_Tc (HsLet new_binds new_expr) -zonkExpr te ve (HsDo _ _) = panic "zonkExpr te ve:HsDo" +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 (HsDoOut do_or_lc stmts return_id then_id zero_id ty src_loc) + = zonkStmts te ve stmts `thenNF_Tc` \ (new_stmts, _) -> + zonkTcTypeToType te ty `thenNF_Tc` \ new_ty -> + returnNF_Tc (HsDoOut do_or_lc new_stmts + (zonkIdOcc ve return_id) + (zonkIdOcc ve then_id) + (zonkIdOcc ve zero_id) + new_ty src_loc) zonkExpr te ve (ExplicitList _) = panic "zonkExpr te ve:ExplicitList" @@ -430,10 +413,11 @@ zonkExpr te ve (RecordCon con rbinds) zonkExpr te ve (RecordUpd _ _) = panic "zonkExpr te ve:RecordUpd" -zonkExpr te ve (RecordUpdOut expr dicts rbinds) +zonkExpr te ve (RecordUpdOut expr ty dicts rbinds) = zonkExpr te ve expr `thenNF_Tc` \ new_expr -> + zonkTcTypeToType te ty `thenNF_Tc` \ new_ty -> zonkRbinds te ve rbinds `thenNF_Tc` \ new_rbinds -> - returnNF_Tc (RecordUpdOut new_expr new_dicts new_rbinds) + returnNF_Tc (RecordUpdOut new_expr new_ty new_dicts new_rbinds) where new_dicts = map (zonkIdOcc ve) dicts @@ -498,10 +482,6 @@ zonkExpr te ve (Dictionary dicts methods) zonkExpr te ve (SingleDict name) = returnNF_Tc (SingleDict (zonkIdOcc ve name)) -zonkExpr te ve (HsCon con tys vargs) - = mapNF_Tc (zonkTcTypeToType te) tys `thenNF_Tc` \ new_tys -> - mapNF_Tc (zonkExpr te ve) vargs `thenNF_Tc` \ new_vargs -> - returnNF_Tc (HsCon con new_tys new_vargs) ------------------------------------------------------------------------- zonkArithSeq :: TyVarEnv Type -> IdEnv Id @@ -528,63 +508,38 @@ zonkArithSeq te ve (FromThenTo e1 e2 e3) returnNF_Tc (FromThenTo new_e1 new_e2 new_e3) ------------------------------------------------------------------------- -zonkQuals :: TyVarEnv Type -> IdEnv Id - -> [TcQual s] -> NF_TcM s ([TypecheckedQual], IdEnv Id) - -zonkQuals te ve [] - = returnNF_Tc ([], ve) - -zonkQuals te ve (GeneratorQual pat expr : quals) - = zonkPat te ve pat `thenNF_Tc` \ (new_pat, ids) -> - zonkExpr te ve expr `thenNF_Tc` \ new_expr -> - let - new_ve = extend_ve ve ids - in - zonkQuals te new_ve quals `thenNF_Tc` \ (new_quals, final_ve) -> - returnNF_Tc (GeneratorQual new_pat new_expr : new_quals, final_ve) - -zonkQuals te ve (FilterQual expr : quals) - = zonkExpr te ve expr `thenNF_Tc` \ new_expr -> - zonkQuals te ve quals `thenNF_Tc` \ (new_quals, final_ve) -> - returnNF_Tc (FilterQual new_expr : new_quals, final_ve) - -zonkQuals te ve (LetQual binds : quals) - = zonkBinds te ve binds `thenNF_Tc` \ (new_binds, new_ve) -> - zonkQuals te new_ve quals `thenNF_Tc` \ (new_quals, final_ve) -> - returnNF_Tc (LetQual new_binds : new_quals, final_ve) - -------------------------------------------------------------------------- zonkStmts :: TyVarEnv Type -> IdEnv Id - -> [TcStmt s] -> NF_TcM s [TypecheckedStmt] + -> [TcStmt s] -> NF_TcM s ([TypecheckedStmt], IdEnv Id) + +zonkStmts te ve [] = returnNF_Tc ([], ve) -zonkStmts te ve [] = returnNF_Tc [] +zonkStmts te ve [ReturnStmt expr] + = zonkExpr te ve expr `thenNF_Tc` \ new_expr -> + returnNF_Tc ([ReturnStmt new_expr], ve) -zonkStmts te ve [ExprStmt expr locn] +zonkStmts te ve (ExprStmt expr locn : stmts) = zonkExpr te ve expr `thenNF_Tc` \ new_expr -> - returnNF_Tc [ExprStmt new_expr locn] + zonkStmts te ve stmts `thenNF_Tc` \ (new_stmts, new_ve) -> + returnNF_Tc (ExprStmt new_expr locn : new_stmts, new_ve) -zonkStmts te ve (ExprStmtOut expr locn a b : stmts) - = zonkExpr te ve expr `thenNF_Tc` \ new_expr -> - zonkTcTypeToType te a `thenNF_Tc` \ new_a -> - zonkTcTypeToType te b `thenNF_Tc` \ new_b -> - zonkStmts te ve stmts `thenNF_Tc` \ new_stmts -> - returnNF_Tc (ExprStmtOut new_expr locn new_a new_b : new_stmts) +zonkStmts te ve (GuardStmt expr locn : stmts) + = zonkExpr te ve expr `thenNF_Tc` \ new_expr -> + zonkStmts te ve stmts `thenNF_Tc` \ (new_stmts, new_ve) -> + returnNF_Tc (GuardStmt new_expr locn : new_stmts, new_ve) zonkStmts te ve (LetStmt binds : stmts) = zonkBinds te ve binds `thenNF_Tc` \ (new_binds, new_ve) -> - zonkStmts te new_ve stmts `thenNF_Tc` \ new_stmts -> - returnNF_Tc (LetStmt new_binds : new_stmts) + zonkStmts te new_ve stmts `thenNF_Tc` \ (new_stmts, new_ve2) -> + returnNF_Tc (LetStmt new_binds : new_stmts, new_ve2) -zonkStmts te ve (BindStmtOut pat expr locn a b : stmts) +zonkStmts te ve (BindStmt pat expr locn : stmts) = zonkPat te ve pat `thenNF_Tc` \ (new_pat, ids) -> zonkExpr te ve expr `thenNF_Tc` \ new_expr -> - zonkTcTypeToType te a `thenNF_Tc` \ new_a -> - zonkTcTypeToType te b `thenNF_Tc` \ new_b -> let new_ve = extend_ve ve ids in - zonkStmts te new_ve stmts `thenNF_Tc` \ new_stmts -> - returnNF_Tc (BindStmtOut new_pat new_expr locn new_a new_b : new_stmts) + zonkStmts te new_ve stmts `thenNF_Tc` \ (new_stmts, new_ve2) -> + returnNF_Tc (BindStmt new_pat new_expr locn : new_stmts, new_ve2) @@ -607,9 +562,10 @@ zonkRbinds te ve rbinds %************************************************************************ \begin{code} +{- zonkPat :: TyVarEnv Type -> IdEnv Id -> TcPat s -> NF_TcM s (TypecheckedPat, [Id]) - +-} zonkPat te ve (WildPat ty) = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty -> returnNF_Tc (WildPat new_ty, []) @@ -665,6 +621,13 @@ zonkPat te ve (NPat lit ty expr) zonkExpr te ve expr `thenNF_Tc` \ new_expr -> returnNF_Tc (NPat lit new_ty new_expr, []) +zonkPat te ve (NPlusKPat n k ty e1 e2) + = zonkIdBndr te n `thenNF_Tc` \ new_n -> + zonkTcTypeToType te ty `thenNF_Tc` \ new_ty -> + zonkExpr te ve e1 `thenNF_Tc` \ new_e1 -> + zonkExpr te ve e2 `thenNF_Tc` \ new_e2 -> + returnNF_Tc (NPlusKPat new_n k new_ty new_e1 new_e2, [new_n]) + zonkPat te ve (DictPat ds ms) = mapNF_Tc (zonkIdBndr te) ds `thenNF_Tc` \ new_ds -> mapNF_Tc (zonkIdBndr te) ms `thenNF_Tc` \ new_ms ->