- ; setEnvs (mkDsEnvs this_mod rdr_env type_env msg_var) thing_inside }
-
-mkDsEnvs :: Module -> GlobalRdrEnv -> TypeEnv
- -> IORef Messages -> (DsGblEnv, DsLclEnv)
-mkDsEnvs mod rdr_env type_env msg_var
- = (gbl_env, lcl_env)
- where
- if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) }
- if_lenv = mkIfLclEnv mod (ptext SLIT("GHC error in desugarer lookup in") <+> ppr mod)
- gbl_env = DsGblEnv { ds_mod = mod,
- ds_if_env = (if_genv, if_lenv),
- ds_unqual = mkPrintUnqualified rdr_env,
- ds_msgs = msg_var }
- lcl_env = DsLclEnv { ds_meta = emptyNameEnv,
- ds_loc = noSrcSpan }
+ ; ds_envs <- liftIO $ mkDsEnvs dflags this_mod rdr_env type_env msg_var
+ ; setEnvs ds_envs thing_inside }
+
+mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> IORef Messages -> IO (DsGblEnv, DsLclEnv)
+mkDsEnvs dflags mod rdr_env type_env msg_var
+ = do -- TODO: unnecessarily monadic
+ let if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) }
+ if_lenv = mkIfLclEnv mod (ptext (sLit "GHC error in desugarer lookup in") <+> ppr mod)
+ gbl_env = DsGblEnv { ds_mod = mod,
+ ds_if_env = (if_genv, if_lenv),
+ ds_unqual = mkPrintUnqualified dflags rdr_env,
+ ds_msgs = msg_var}
+ lcl_env = DsLclEnv { ds_meta = emptyNameEnv,
+ ds_loc = noSrcSpan }
+
+ return (gbl_env, lcl_env)