X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=84b5aee1158694fddc22b6f21c955e915a97960e;hp=64b40f60b2592e4f21a02c5de8b7c102167bcce6;hb=2eb04ca0f8d0ec72b417cddc60672c696b4a3daa;hpb=74b27e20425336403d80e942ee3faf00f8c36ef8 diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 64b40f6..84b5aee 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -84,12 +84,13 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this | otherwise = Nothing ; gbl_env = TcGblEnv { - tcg_mod = mod, - tcg_src = hsc_src, - tcg_rdr_env = hsc_global_rdr_env hsc_env, - tcg_fix_env = emptyNameEnv, - tcg_default = Nothing, - tcg_type_env = hsc_global_type_env hsc_env, + tcg_mod = mod, + tcg_src = hsc_src, + tcg_rdr_env = hsc_global_rdr_env hsc_env, + tcg_fix_env = emptyNameEnv, + tcg_field_env = emptyNameEnv, + tcg_default = Nothing, + tcg_type_env = hsc_global_type_env hsc_env, tcg_type_env_var = type_env_var, tcg_inst_env = emptyInstEnv, tcg_fam_inst_env = emptyFamInstEnv, @@ -403,6 +404,14 @@ extendFixityEnv new_bit = updGblEnv (\env@(TcGblEnv { tcg_fix_env = old_fix_env }) -> env {tcg_fix_env = extendNameEnvList old_fix_env new_bit}) +getRecFieldEnv :: TcRn RecFieldEnv +getRecFieldEnv = do { env <- getGblEnv; return (tcg_field_env env) } + +extendRecFieldEnv :: RecFieldEnv -> RnM a -> RnM a +extendRecFieldEnv new_bit + = updGblEnv (\env@(TcGblEnv { tcg_field_env = old_env }) -> + env {tcg_field_env = old_env `plusNameEnv` new_bit}) + getDeclaredDefaultTys :: TcRn (Maybe [Type]) getDeclaredDefaultTys = do { env <- getGblEnv; return (tcg_default env) } \end{code}