checker.
\begin{code}
+#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(TcBind), 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),
- TypecheckedHsBinds(..), TypecheckedBind(..),
- TypecheckedMonoBinds(..), TypecheckedPat(..),
- TypecheckedHsExpr(..), TypecheckedArithSeqInfo(..),
- TypecheckedQual(..), TypecheckedStmt(..),
- TypecheckedMatch(..), TypecheckedHsModule(..),
- TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
- TypecheckedRecordBinds(..),
+ SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedBind),
+ 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),
mkHsTyApp, mkHsDictApp,
mkHsTyLam, mkHsDictLam,
- tcIdType,
+ tcIdType, tcIdTyVars,
zonkBinds,
- zonkInst,
- zonkId, -- TcIdBndr s -> NF_TcM s Id
- unZonkId -- Id -> NF_TcM s (TcIdBndr s)
+ zonkDictBinds
) where
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
-- friends:
import HsSyn -- oodles of it
-import Id ( GenId(..), IdDetails, PragmaInfo, -- Can meddle modestly with Ids
- DictVar(..), idType
+import Id ( GenId(..), IdDetails, -- Can meddle modestly with Ids
+ SYN_IE(DictVar), idType,
+ SYN_IE(IdEnv), growIdEnvList, lookupIdEnv
)
-- others:
+import Name ( Name{--O only-} )
import TcMonad
-import TcType ( TcType(..), TcMaybe, TcTyVar(..),
- zonkTcTypeToType, zonkTcTyVarToTyVar,
- tcInstType
+import TcType ( SYN_IE(TcType), TcMaybe, SYN_IE(TcTyVar),
+ zonkTcTypeToType, zonkTcTyVarToTyVar
)
-import Usage ( UVar(..) )
-import Util ( panic )
+import Usage ( SYN_IE(UVar) )
+import Util ( zipEqual, panic, pprPanic, pprTrace )
import PprType ( GenType, GenTyVar ) -- instances
-import TyVar ( GenTyVar ) -- instances
+import Type ( mkTyVarTy, tyVarsOfType )
+import TyVar ( GenTyVar {- instances -},
+ SYN_IE(TyVarEnv), growTyVarEnvList, emptyTyVarSet )
+import TysPrim ( voidTy )
+import CoreSyn ( GenCoreExpr )
import Unique ( Unique ) -- instances
+import UniqFM
+import PprStyle
+import Pretty
\end{code}
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 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
mkHsDictLam dicts expr = DictLam dicts expr
tcIdType :: TcIdOcc s -> TcType s
-tcIdType (TcId id) = idType id
-tcIdType other = panic "tcIdType"
-\end{code}
-
+tcIdType (TcId id) = idType id
+tcIdType (RealId id) = pprPanic "tcIdType:" (ppr PprDebug id)
+tcIdTyVars (TcId id) = tyVarsOfType (idType id)
+tcIdTyVars (RealId _) = emptyTyVarSet -- Top level Ids have no free type variables
+\end{code}
\begin{code}
instance Eq (TcIdOcc s) where
(TcId id1) == (TcId id2) = id1 == id2
(RealId id1) == (RealId id2) = id1 == id2
+ _ == _ = False
instance Outputable (TcIdOcc s) where
ppr sty (TcId id) = ppr sty id
%* *
%************************************************************************
-\begin{code}
-zonkId :: TcIdOcc s -> NF_TcM s Id
-unZonkId :: Id -> NF_TcM s (TcIdBndr s)
+This zonking pass runs over the bindings
+
+ a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
+ b) convert unbound TcTyVar to Void
-zonkId (RealId id) = returnNF_Tc id
+We pass an environment around so that
+ a) we know which TyVars are unbound
+ b) we maintain sharing; eg an Id is zonked at its binding site and they
+ all occurrences of that Id point to the common zonked copy
-zonkId (TcId (Id u ty details prags info))
- = zonkTcTypeToType ty `thenNF_Tc` \ ty' ->
- returnNF_Tc (Id u ty' details prags info)
+It's all pretty boring stuff, because HsSyn is such a large type, and
+the environment manipulation is tiresome.
-unZonkId (Id u ty details prags info)
- = tcInstType [] ty `thenNF_Tc` \ ty' ->
- returnNF_Tc (Id u ty' details prags info)
+
+\begin{code}
+zonkIdBndr :: TyVarEnv Type -> TcIdOcc s -> NF_TcM s Id
+zonkIdBndr te (TcId (Id u n ty details prags info))
+ = zonkTcTypeToType te ty `thenNF_Tc` \ ty' ->
+ returnNF_Tc (Id u n ty' details prags info)
+
+zonkIdBndr te (RealId id) = returnNF_Tc id
+
+zonkIdOcc :: IdEnv Id -> TcIdOcc s -> Id
+zonkIdOcc ve (RealId id) = id
+zonkIdOcc ve (TcId id) = case (lookupIdEnv ve id) of
+ Just id' -> id'
+ Nothing -> pprTrace "zonkIdOcc: " (ppr PprDebug id) $
+ Id u n voidTy details prags info
+ where
+ Id u n _ details prags info = id
+
+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}
-zonkInst :: (TcIdOcc s, TcExpr s) -> NF_TcM s (Id, TypecheckedHsExpr)
-zonkInst (id, expr)
- = zonkId id `thenNF_Tc` \ id' ->
- zonkExpr expr `thenNF_Tc` \ expr' ->
- returnNF_Tc (id', expr')
+ -- 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 :: TcHsBinds s -> NF_TcM s TypecheckedHsBinds
+zonkBinds :: TyVarEnv Type -> IdEnv Id
+ -> TcHsBinds s -> NF_TcM s (TypecheckedHsBinds, IdEnv Id)
-zonkBinds EmptyBinds = returnNF_Tc EmptyBinds
+zonkBinds te ve EmptyBinds = returnNF_Tc (EmptyBinds, ve)
-zonkBinds (ThenBinds binds1 binds2)
- = zonkBinds binds1 `thenNF_Tc` \ new_binds1 ->
- zonkBinds binds2 `thenNF_Tc` \ new_binds2 ->
- returnNF_Tc (ThenBinds new_binds1 new_binds2)
+zonkBinds te ve (ThenBinds binds1 binds2)
+ = zonkBinds te ve binds1 `thenNF_Tc` \ (new_binds1, ve1) ->
+ zonkBinds te ve1 binds2 `thenNF_Tc` \ (new_binds2, ve2) ->
+ returnNF_Tc (ThenBinds new_binds1 new_binds2, ve2)
-zonkBinds (SingleBind bind)
- = zonkBind bind `thenNF_Tc` \ new_bind ->
- returnNF_Tc (SingleBind new_bind)
+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 (AbsBinds tyvars dicts locprs dict_binds val_bind)
+zonkBinds te ve (AbsBinds tyvars dicts locprs dict_binds val_bind)
= mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
- mapNF_Tc zonkId dicts `thenNF_Tc` \ new_dicts ->
- mapNF_Tc subst_pair locprs `thenNF_Tc` \ new_locprs ->
- mapNF_Tc subst_bind dict_binds `thenNF_Tc` \ new_dict_binds ->
- zonkBind val_bind `thenNF_Tc` \ new_val_bind ->
- returnNF_Tc (AbsBinds new_tyvars new_dicts new_locprs new_dict_binds new_val_bind)
+ 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
- subst_pair (l, g)
- = zonkId l `thenNF_Tc` \ new_l ->
- zonkId g `thenNF_Tc` \ new_g ->
- returnNF_Tc (new_l, new_g)
-
- subst_bind (v, e)
- = zonkId v `thenNF_Tc` \ new_v ->
- zonkExpr e `thenNF_Tc` \ new_e ->
- returnNF_Tc (new_v, new_e)
+ (locals, globals) = unzip locprs
\end{code}
\begin{code}
-------------------------------------------------------------------------
-zonkBind :: TcBind s -> NF_TcM s TypecheckedBind
+zonkBind :: TyVarEnv Type -> IdEnv Id
+ -> TcBind s -> NF_TcM s (TypecheckedBind, [Id])
-zonkBind EmptyBind = returnNF_Tc EmptyBind
+zonkBind te ve EmptyBind = returnNF_Tc (EmptyBind, [])
-zonkBind (NonRecBind mbinds)
- = zonkMonoBinds mbinds `thenNF_Tc` \ new_mbinds ->
- returnNF_Tc (NonRecBind new_mbinds)
+zonkBind te ve (NonRecBind mbinds)
+ = zonkMonoBinds te ve mbinds `thenNF_Tc` \ (new_mbinds, new_ids) ->
+ returnNF_Tc (NonRecBind new_mbinds, new_ids)
-zonkBind (RecBind mbinds)
- = zonkMonoBinds mbinds `thenNF_Tc` \ new_mbinds ->
- returnNF_Tc (RecBind new_mbinds)
+zonkBind te ve (RecBind mbinds)
+ = zonkMonoBinds te ve mbinds `thenNF_Tc` \ (new_mbinds, new_ids) ->
+ returnNF_Tc (RecBind new_mbinds, new_ids)
-------------------------------------------------------------------------
-zonkMonoBinds :: TcMonoBinds s -> NF_TcM s TypecheckedMonoBinds
-
-zonkMonoBinds EmptyMonoBinds = returnNF_Tc EmptyMonoBinds
-
-zonkMonoBinds (AndMonoBinds mbinds1 mbinds2)
- = zonkMonoBinds mbinds1 `thenNF_Tc` \ new_mbinds1 ->
- zonkMonoBinds mbinds2 `thenNF_Tc` \ new_mbinds2 ->
- returnNF_Tc (AndMonoBinds new_mbinds1 new_mbinds2)
-
-zonkMonoBinds (PatMonoBind pat grhss_w_binds locn)
- = zonkPat pat `thenNF_Tc` \ new_pat ->
- zonkGRHSsAndBinds grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
- returnNF_Tc (PatMonoBind new_pat new_grhss_w_binds locn)
-
-zonkMonoBinds (VarMonoBind var expr)
- = zonkId var `thenNF_Tc` \ new_var ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (VarMonoBind new_var new_expr)
-
-zonkMonoBinds (FunMonoBind name inf ms locn)
- = zonkId name `thenNF_Tc` \ new_name ->
- mapNF_Tc zonkMatch ms `thenNF_Tc` \ new_ms ->
- returnNF_Tc (FunMonoBind new_name inf new_ms locn)
+zonkMonoBinds :: TyVarEnv Type -> IdEnv Id
+ -> TcMonoBinds s -> NF_TcM s (TypecheckedMonoBinds, [Id])
+
+zonkMonoBinds te ve EmptyMonoBinds = returnNF_Tc (EmptyMonoBinds, [])
+
+zonkMonoBinds te ve (AndMonoBinds mbinds1 mbinds2)
+ = zonkMonoBinds te ve mbinds1 `thenNF_Tc` \ (new_mbinds1, ids1) ->
+ zonkMonoBinds te ve mbinds2 `thenNF_Tc` \ (new_mbinds2, ids2) ->
+ returnNF_Tc (AndMonoBinds new_mbinds1 new_mbinds2, ids1 ++ ids2)
+
+zonkMonoBinds te ve (PatMonoBind pat grhss_w_binds locn)
+ = zonkPat te ve pat `thenNF_Tc` \ (new_pat, ids) ->
+ zonkGRHSsAndBinds te ve grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
+ returnNF_Tc (PatMonoBind new_pat new_grhss_w_binds locn, ids)
+
+zonkMonoBinds te ve (VarMonoBind var expr)
+ = zonkIdBndr te var `thenNF_Tc` \ new_var ->
+ 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])
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-zonkMatch :: TcMatch s -> NF_TcM s TypecheckedMatch
-
-zonkMatch (PatMatch pat match)
- = zonkPat pat `thenNF_Tc` \ new_pat ->
- zonkMatch match `thenNF_Tc` \ new_match ->
+zonkMatch :: TyVarEnv Type -> IdEnv Id
+ -> TcMatch s -> NF_TcM s TypecheckedMatch
+
+zonkMatch te ve (PatMatch pat match)
+ = zonkPat te ve pat `thenNF_Tc` \ (new_pat, ids) ->
+ let
+ new_ve = extend_ve ve ids
+ in
+ zonkMatch te new_ve match `thenNF_Tc` \ new_match ->
returnNF_Tc (PatMatch new_pat new_match)
-zonkMatch (GRHSMatch grhss_w_binds)
- = zonkGRHSsAndBinds grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
+zonkMatch te ve (GRHSMatch grhss_w_binds)
+ = zonkGRHSsAndBinds te ve grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
returnNF_Tc (GRHSMatch new_grhss_w_binds)
-zonkMatch (SimpleMatch expr)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
+zonkMatch te ve (SimpleMatch expr)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (SimpleMatch new_expr)
-------------------------------------------------------------------------
-zonkGRHSsAndBinds :: TcGRHSsAndBinds s
- -> NF_TcM s TypecheckedGRHSsAndBinds
-
-zonkGRHSsAndBinds (GRHSsAndBindsOut grhss binds ty)
- = mapNF_Tc zonk_grhs grhss `thenNF_Tc` \ new_grhss ->
- zonkBinds binds `thenNF_Tc` \ new_binds ->
- zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
+zonkGRHSsAndBinds :: TyVarEnv Type -> IdEnv Id
+ -> TcGRHSsAndBinds s
+ -> NF_TcM s TypecheckedGRHSsAndBinds
+
+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 ->
+ returnNF_Tc (GRHS new_guard new_expr locn)
+
+ zonk_grhs (OtherwiseGRHS expr locn)
+ = zonkExpr te new_ve expr `thenNF_Tc` \ new_expr ->
+ returnNF_Tc (OtherwiseGRHS new_expr locn)
+ in
+ mapNF_Tc zonk_grhs grhss `thenNF_Tc` \ new_grhss ->
+ zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
returnNF_Tc (GRHSsAndBindsOut new_grhss new_binds new_ty)
- where
- zonk_grhs (GRHS guard expr locn)
- = zonkExpr guard `thenNF_Tc` \ new_guard ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (GRHS new_guard new_expr locn)
-
- zonk_grhs (OtherwiseGRHS expr locn)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (OtherwiseGRHS new_expr locn)
\end{code}
%************************************************************************
%* *
%************************************************************************
-ToDo: panic on things that can't be in @TypecheckedHsExpr@.
-
\begin{code}
-zonkExpr :: TcExpr s -> NF_TcM s TypecheckedHsExpr
+zonkExpr :: TyVarEnv Type -> IdEnv Id
+ -> TcExpr s -> NF_TcM s TypecheckedHsExpr
+
+zonkExpr te ve (HsVar name)
+ = returnNF_Tc (HsVar (zonkIdOcc ve name))
-zonkExpr (HsVar name)
- = zonkId name `thenNF_Tc` \ new_name ->
- returnNF_Tc (HsVar new_name)
+zonkExpr te ve (HsLit _) = panic "zonkExpr te ve:HsLit"
-zonkExpr (HsLitOut lit ty)
- = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
+zonkExpr te ve (HsLitOut lit ty)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
returnNF_Tc (HsLitOut lit new_ty)
-zonkExpr (HsLam match)
- = zonkMatch match `thenNF_Tc` \ new_match ->
+zonkExpr te ve (HsLam match)
+ = zonkMatch te ve 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 ->
+zonkExpr te ve (HsApp e1 e2)
+ = zonkExpr te ve e1 `thenNF_Tc` \ new_e1 ->
+ zonkExpr te ve e2 `thenNF_Tc` \ new_e2 ->
returnNF_Tc (HsApp new_e1 new_e2)
-zonkExpr (OpApp e1 op 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 new_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 fixity new_e2)
-zonkExpr (NegApp _) = panic "zonkExpr:NegApp"
-zonkExpr (HsPar _) = panic "zonkExpr:HsPar"
+zonkExpr te ve (NegApp _ _) = panic "zonkExpr te ve:NegApp"
+zonkExpr te ve (HsPar _) = panic "zonkExpr te ve:HsPar"
-zonkExpr (SectionL expr op)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- zonkExpr op `thenNF_Tc` \ new_op ->
+zonkExpr te ve (SectionL expr op)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
+ zonkExpr te ve 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 ->
+zonkExpr te ve (SectionR op expr)
+ = zonkExpr te ve op `thenNF_Tc` \ new_op ->
+ zonkExpr te ve 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 ->
+zonkExpr te ve (HsCase expr ms src_loc)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
+ mapNF_Tc (zonkMatch te ve) 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 ->
+zonkExpr te ve (HsIf e1 e2 e3 src_loc)
+ = zonkExpr te ve e1 `thenNF_Tc` \ new_e1 ->
+ zonkExpr te ve e2 `thenNF_Tc` \ new_e2 ->
+ zonkExpr te ve 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 ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
+zonkExpr te ve (HsLet binds expr)
+ = zonkBinds te ve binds `thenNF_Tc` \ (new_binds, new_ve) ->
+ zonkExpr te new_ve expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (HsLet new_binds new_expr)
-zonkExpr (HsDo _ _) = panic "zonkExpr:HsDo"
-
-zonkExpr (HsDoOut stmts m_id mz_id src_loc)
- = zonkStmts stmts `thenNF_Tc` \ new_stmts ->
- zonkId m_id `thenNF_Tc` \ m_new ->
- zonkId mz_id `thenNF_Tc` \ mz_new ->
- returnNF_Tc (HsDoOut new_stmts m_new mz_new src_loc)
+zonkExpr te ve (HsDo _ _ _) = panic "zonkExpr te ve:HsDo"
-zonkExpr (ListComp expr quals)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- zonkQuals quals `thenNF_Tc` \ new_quals ->
- 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 (ExplicitList _) = panic "zonkExpr:ExplicitList"
+zonkExpr te ve (ExplicitList _) = panic "zonkExpr te ve:ExplicitList"
-zonkExpr (ExplicitListOut ty exprs)
- = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
- mapNF_Tc zonkExpr exprs `thenNF_Tc` \ new_exprs ->
+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 (ExplicitTuple exprs)
- = mapNF_Tc zonkExpr exprs `thenNF_Tc` \ new_exprs ->
+zonkExpr te ve (ExplicitTuple exprs)
+ = mapNF_Tc (zonkExpr te ve) exprs `thenNF_Tc` \ new_exprs ->
returnNF_Tc (ExplicitTuple new_exprs)
-zonkExpr (RecordCon con rbinds)
- = panic "zonkExpr:RecordCon"
-zonkExpr (RecordUpd exp rbinds)
- = panic "zonkExpr:RecordUpd"
-zonkExpr (RecordUpdOut exp ids rbinds)
- = panic "zonkExpr:RecordUpdOut"
+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 (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
-zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
+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 (ArithSeqOut expr info)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- zonkArithSeq info `thenNF_Tc` \ new_info ->
+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 ->
returnNF_Tc (ArithSeqOut new_expr new_info)
-zonkExpr (CCall fun args may_gc is_casm result_ty)
- = mapNF_Tc zonkExpr args `thenNF_Tc` \ new_args ->
- zonkTcTypeToType result_ty `thenNF_Tc` \ new_result_ty ->
+zonkExpr te ve (CCall fun args may_gc is_casm result_ty)
+ = mapNF_Tc (zonkExpr te ve) args `thenNF_Tc` \ new_args ->
+ zonkTcTypeToType te result_ty `thenNF_Tc` \ new_result_ty ->
returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
-zonkExpr (HsSCC label expr)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
+zonkExpr te ve (HsSCC label expr)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (HsSCC label new_expr)
-zonkExpr (TyLam tyvars expr)
+zonkExpr te ve (TyLam tyvars expr)
= mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
+ let
+ new_te = extend_te te new_tyvars
+ in
+ zonkExpr new_te ve expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (TyLam new_tyvars new_expr)
-zonkExpr (TyApp expr tys)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys ->
+zonkExpr te ve (TyApp expr tys)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
+ mapNF_Tc (zonkTcTypeToType te) tys `thenNF_Tc` \ new_tys ->
returnNF_Tc (TyApp new_expr new_tys)
-zonkExpr (DictLam dicts expr)
- = mapNF_Tc zonkId dicts `thenNF_Tc` \ new_dicts ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
+zonkExpr te ve (DictLam dicts expr)
+ = mapNF_Tc (zonkIdBndr te) dicts `thenNF_Tc` \ new_dicts ->
+ let
+ new_ve = extend_ve ve new_dicts
+ in
+ zonkExpr te new_ve expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (DictLam new_dicts new_expr)
-zonkExpr (DictApp expr dicts)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- mapNF_Tc zonkId dicts `thenNF_Tc` \ new_dicts ->
+zonkExpr te ve (DictApp expr dicts)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (DictApp new_expr new_dicts)
+ where
+ new_dicts = map (zonkIdOcc ve) dicts
-zonkExpr (ClassDictLam dicts methods expr)
- = mapNF_Tc zonkId dicts `thenNF_Tc` \ new_dicts ->
- mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
+zonkExpr te ve (ClassDictLam dicts methods expr)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (ClassDictLam new_dicts new_methods new_expr)
+ where
+ new_dicts = map (zonkIdOcc ve) dicts
+ new_methods = map (zonkIdOcc ve) methods
+
-zonkExpr (Dictionary dicts methods)
- = mapNF_Tc zonkId dicts `thenNF_Tc` \ new_dicts ->
- mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
- returnNF_Tc (Dictionary new_dicts new_methods)
+zonkExpr te ve (Dictionary dicts methods)
+ = returnNF_Tc (Dictionary new_dicts new_methods)
+ where
+ new_dicts = map (zonkIdOcc ve) dicts
+ new_methods = map (zonkIdOcc ve) methods
-zonkExpr (SingleDict name)
- = zonkId name `thenNF_Tc` \ new_name ->
- returnNF_Tc (SingleDict new_name)
+zonkExpr te ve (SingleDict name)
+ = returnNF_Tc (SingleDict (zonkIdOcc ve name))
-zonkExpr (HsCon con tys vargs)
- = mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys ->
- mapNF_Tc zonkExpr vargs `thenNF_Tc` \ new_vargs ->
- returnNF_Tc (HsCon con new_tys new_vargs)
-------------------------------------------------------------------------
-zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
+zonkArithSeq :: TyVarEnv Type -> IdEnv Id
+ -> TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
-zonkArithSeq (From e)
- = zonkExpr e `thenNF_Tc` \ new_e ->
+zonkArithSeq te ve (From e)
+ = zonkExpr te ve e `thenNF_Tc` \ new_e ->
returnNF_Tc (From new_e)
-zonkArithSeq (FromThen e1 e2)
- = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
- zonkExpr e2 `thenNF_Tc` \ new_e2 ->
+zonkArithSeq te ve (FromThen e1 e2)
+ = zonkExpr te ve e1 `thenNF_Tc` \ new_e1 ->
+ zonkExpr te ve e2 `thenNF_Tc` \ new_e2 ->
returnNF_Tc (FromThen new_e1 new_e2)
-zonkArithSeq (FromTo e1 e2)
- = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
- zonkExpr e2 `thenNF_Tc` \ new_e2 ->
+zonkArithSeq te ve (FromTo e1 e2)
+ = zonkExpr te ve e1 `thenNF_Tc` \ new_e1 ->
+ zonkExpr te ve e2 `thenNF_Tc` \ new_e2 ->
returnNF_Tc (FromTo new_e1 new_e2)
-zonkArithSeq (FromThenTo e1 e2 e3)
- = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
- zonkExpr e2 `thenNF_Tc` \ new_e2 ->
- zonkExpr e3 `thenNF_Tc` \ new_e3 ->
+zonkArithSeq te ve (FromThenTo e1 e2 e3)
+ = zonkExpr te ve e1 `thenNF_Tc` \ new_e1 ->
+ zonkExpr te ve e2 `thenNF_Tc` \ new_e2 ->
+ zonkExpr te ve e3 `thenNF_Tc` \ new_e3 ->
returnNF_Tc (FromThenTo new_e1 new_e2 new_e3)
-------------------------------------------------------------------------
-zonkQuals :: [TcQual s] -> NF_TcM s [TypecheckedQual]
+zonkStmts :: TyVarEnv Type -> IdEnv Id
+ -> [TcStmt s] -> NF_TcM s [TypecheckedStmt]
-zonkQuals quals
- = mapNF_Tc zonk_qual quals
- where
- zonk_qual (GeneratorQual pat expr)
- = zonkPat pat `thenNF_Tc` \ new_pat ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (GeneratorQual new_pat new_expr)
+zonkStmts te ve [] = returnNF_Tc []
+
+zonkStmts te ve [ReturnStmt expr]
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
+ returnNF_Tc [ReturnStmt new_expr]
+
+zonkStmts te ve (ExprStmt expr locn : stmts)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
+ zonkStmts te ve stmts `thenNF_Tc` \ new_stmts ->
+ returnNF_Tc (ExprStmt new_expr locn : 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 ->
+ returnNF_Tc (GuardStmt new_expr locn : new_stmts)
+
+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 ve (BindStmt pat expr locn : stmts)
+ = 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
+ zonkStmts te new_ve stmts `thenNF_Tc` \ new_stmts ->
+ returnNF_Tc (BindStmt new_pat new_expr locn : new_stmts)
- zonk_qual (FilterQual expr)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (FilterQual new_expr)
- zonk_qual (LetQual binds)
- = zonkBinds binds `thenNF_Tc` \ new_binds ->
- returnNF_Tc (LetQual new_binds)
-------------------------------------------------------------------------
-zonkStmts :: [TcStmt s] -> NF_TcM s [TypecheckedStmt]
+zonkRbinds :: TyVarEnv Type -> IdEnv Id
+ -> TcRecordBinds s -> NF_TcM s TypecheckedRecordBinds
-zonkStmts stmts
- = mapNF_Tc zonk_stmt stmts
+zonkRbinds te ve rbinds
+ = mapNF_Tc zonk_rbind rbinds
where
- zonk_stmt (BindStmt pat expr src_loc)
- = zonkPat pat `thenNF_Tc` \ new_pat ->
- zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (BindStmt new_pat new_expr src_loc)
-
- zonk_stmt (ExprStmt expr src_loc)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (ExprStmt new_expr src_loc)
-
- zonk_stmt (LetStmt binds)
- = zonkBinds binds `thenNF_Tc` \ new_binds ->
- returnNF_Tc (LetStmt new_binds)
+ zonk_rbind (field, expr, pun)
+ = zonkExpr te ve expr `thenNF_Tc` \ new_expr ->
+ returnNF_Tc (zonkIdOcc ve field, new_expr, pun)
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-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 -> 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, [])
+
+zonkPat te ve (VarPat v)
+ = zonkIdBndr te v `thenNF_Tc` \ new_v ->
+ returnNF_Tc (VarPat new_v, [new_v])
+
+zonkPat te ve (LazyPat pat)
+ = zonkPat te ve pat `thenNF_Tc` \ (new_pat, ids) ->
+ returnNF_Tc (LazyPat new_pat, ids)
+
+zonkPat te ve (AsPat n pat)
+ = zonkIdBndr te n `thenNF_Tc` \ new_n ->
+ zonkPat te ve pat `thenNF_Tc` \ (new_pat, ids) ->
+ returnNF_Tc (AsPat new_n new_pat, new_n:ids)
+
+zonkPat te ve (ConPat n ty pats)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ zonkPats te ve pats `thenNF_Tc` \ (new_pats, ids) ->
+ returnNF_Tc (ConPat n new_ty new_pats, ids)
+
+zonkPat te ve (ConOpPat pat1 op pat2 ty)
+ = zonkPat te ve pat1 `thenNF_Tc` \ (new_pat1, ids1) ->
+ zonkPat te ve pat2 `thenNF_Tc` \ (new_pat2, ids2) ->
+ zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ returnNF_Tc (ConOpPat new_pat1 op new_pat2 new_ty, ids1 ++ ids2)
+
+zonkPat te ve (ListPat ty pats)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ zonkPats te ve pats `thenNF_Tc` \ (new_pats, ids) ->
+ returnNF_Tc (ListPat new_ty new_pats, ids)
+
+zonkPat te ve (TuplePat pats)
+ = zonkPats te ve pats `thenNF_Tc` \ (new_pats, ids) ->
+ returnNF_Tc (TuplePat new_pats, ids)
+
+zonkPat te ve (RecPat n ty rpats)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ mapAndUnzipNF_Tc zonk_rpat rpats `thenNF_Tc` \ (new_rpats, ids_s) ->
+ returnNF_Tc (RecPat n new_ty new_rpats, concat ids_s)
+ where
+ zonk_rpat (f, pat, pun)
+ = zonkPat te ve pat `thenNF_Tc` \ (new_pat, ids) ->
+ returnNF_Tc ((f, new_pat, pun), ids)
+
+zonkPat te ve (LitPat lit ty)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ returnNF_Tc (LitPat lit new_ty, [])
+
+zonkPat te ve (NPat lit ty expr)
+ = zonkTcTypeToType te ty `thenNF_Tc` \ new_ty ->
+ 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 ->
+ returnNF_Tc (DictPat new_ds new_ms, new_ds ++ new_ms)
+
+
+zonkPats te ve []
+ = returnNF_Tc ([], [])
+zonkPats te ve (pat:pats)
+ = zonkPat te ve pat `thenNF_Tc` \ (pat', ids1) ->
+ zonkPats te ve pats `thenNF_Tc` \ (pats', ids2) ->
+ returnNF_Tc (pat':pats', ids1 ++ ids2)
+
\end{code}
projects / ghc-hetmet.git / blobdiff