X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=56c98dc13990e0a7205c2217cd79a18c7963b53b;hb=940524aec90652b5ef81789c9a453c57c0e42cc9;hp=c6d428b307cd0b70fe83f8f2b3a68ec1ba3a2bb4;hpb=102b73a3f2a2f63d3835726be625dca8053dd88c;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index c6d428b..56c98dc 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -35,12 +35,10 @@ import Id import TcRnMonad import Type import TcType -import qualified Type import TcMType import TysPrim import TysWiredIn import TyCon -import {- Kind parts of -} Type import Name import Var import VarSet @@ -304,11 +302,12 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts, = zonkIdBndr env global `thenM` \ new_global -> mapM zonk_prag prags `thenM` \ new_prags -> returnM (tyvars, new_global, zonkIdOcc env local, new_prags) - zonk_prag prag@(InlinePrag {}) = return prag - zonk_prag (SpecPrag expr ty ds inl) = do { expr' <- zonkExpr env expr - ; ty' <- zonkTcTypeToType env ty - ; let ds' = zonkIdOccs env ds - ; return (SpecPrag expr' ty' ds' inl) } + zonk_prag prag@(L _ (InlinePrag {})) = return prag + zonk_prag (L loc (SpecPrag expr ty ds inl)) + = do { expr' <- zonkExpr env expr + ; ty' <- zonkTcTypeToType env ty + ; let ds' = zonkIdOccs env ds + ; return (L loc (SpecPrag expr' ty' ds' inl)) } \end{code} %************************************************************************ @@ -462,12 +461,12 @@ zonkExpr env (RecordCon data_con con_expr rbinds) zonkRbinds env rbinds `thenM` \ new_rbinds -> returnM (RecordCon data_con new_con_expr new_rbinds) -zonkExpr env (RecordUpd expr rbinds in_ty out_ty) - = 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 (RecordUpd new_expr new_rbinds new_in_ty new_out_ty) +zonkExpr env (RecordUpd expr rbinds cons in_tys out_tys) + = zonkLExpr env expr `thenM` \ new_expr -> + mapM (zonkTcTypeToType env) in_tys `thenM` \ new_in_tys -> + mapM (zonkTcTypeToType env) out_tys `thenM` \ new_out_tys -> + zonkRbinds env rbinds `thenM` \ new_rbinds -> + returnM (RecordUpd new_expr new_rbinds cons new_in_tys new_out_tys) zonkExpr env (ExprWithTySigOut e ty) = do { e' <- zonkLExpr env e