X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=7bb1d5e38da7d342a68659e4212fd8d0949a9405;hp=ff5c942149763e6f9aa48b1c042545091bd15964;hb=6c7b41cc2b24f533697a62bf1843507ae043fc97;hpb=67cb409159fa9136dff942b8baaec25909416022 diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index ff5c942..7bb1d5e 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -59,6 +59,21 @@ import Bag import Outputable \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 +328,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 +564,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 +790,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 +874,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