X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=7afd9e8501433c369a26a8e4a9ef253a6cf6ce27;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hp=ff5c942149763e6f9aa48b1c042545091bd15964;hpb=67cb409159fa9136dff942b8baaec25909416022;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index ff5c942..7afd9e8 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -57,6 +57,22 @@ import SrcLoc import Util import Bag import Outputable +import FastString +\end{code} + +\begin{code} +-- XXX +thenM :: Monad a => a b -> (b -> a c) -> a c +thenM = (>>=) + +thenM_ :: Monad a => a b -> a c -> a c +thenM_ = (>>) + +returnM :: Monad m => a -> m a +returnM = return + +mappM :: (Monad m) => (a -> m b) -> [a] -> m [b] +mappM = mapM \end{code} @@ -313,11 +329,10 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts, mapM zonk_prag prags `thenM` \ new_prags -> returnM (tyvars, new_global, zonkIdOcc env local, new_prags) zonk_prag prag@(L _ (InlinePrag {})) = return prag - zonk_prag (L loc (SpecPrag expr ty ds inl)) + zonk_prag (L loc (SpecPrag expr ty inl)) = do { expr' <- zonkExpr env expr ; ty' <- zonkTcTypeToType env ty - ; let ds' = zonkIdOccs env ds - ; return (L loc (SpecPrag expr' ty' ds' inl)) } + ; return (L loc (SpecPrag expr' ty' inl)) } \end{code} %************************************************************************ @@ -550,7 +565,7 @@ zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1 ; return (env2, WpCompose c1' c2') } zonkCoFn env (WpCo co) = do { co' <- zonkTcTypeToType env co ; return (env, WpCo co') } -zonkCoFn env (WpLam id) = do { id' <- zonkIdBndr env id +zonkCoFn env (WpLam id) = do { id' <- zonkDictBndr env id ; let env1 = extendZonkEnv1 env id' ; return (env1, WpLam id') } zonkCoFn env (WpTyLam tv) = ASSERT( isImmutableTyVar tv ) @@ -776,7 +791,7 @@ zonk_pat env (TuplePat pats boxed ty) zonk_pat env p@(ConPatOut { pat_ty = ty, pat_dicts = dicts, pat_binds = binds, pat_args = args }) = ASSERT( all isImmutableTyVar (pat_tvs p) ) do { new_ty <- zonkTcTypeToType env ty - ; new_dicts <- zonkIdBndrs env dicts + ; new_dicts <- zonkDictBndrs env dicts ; let env1 = extendZonkEnv env new_dicts ; (env2, new_binds) <- zonkRecMonoBinds env1 binds ; (env', new_args) <- zonkConStuff env2 args @@ -860,7 +875,7 @@ zonkRules :: ZonkEnv -> [LRuleDecl TcId] -> TcM [LRuleDecl Id] zonkRules env rs = mappM (wrapLocM (zonkRule env)) rs zonkRule :: ZonkEnv -> RuleDecl TcId -> TcM (RuleDecl Id) -zonkRule env (HsRule name act (vars::[RuleBndr TcId]) lhs fv_lhs rhs fv_rhs) +zonkRule env (HsRule name act (vars{-::[RuleBndr TcId]-}) lhs fv_lhs rhs fv_rhs) = mappM zonk_bndr vars `thenM` \ new_bndrs -> newMutVar emptyVarSet `thenM` \ unbound_tv_set -> let