diff options
Diffstat (limited to 'compiler/GHC/Tc/Utils/Env.hs')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Env.hs | 22 |
1 files changed, 20 insertions, 2 deletions
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 65785fc822..ad74d919ab 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -18,7 +18,7 @@ module GHC.Tc.Utils.Env( -- Global environment tcExtendGlobalEnv, tcExtendTyConEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv, - tcExtendGlobalValEnv, + tcExtendGlobalValEnv, tcTyThBinders, tcLookupLocatedGlobal, tcLookupGlobal, tcLookupGlobalOnly, tcLookupTyCon, tcLookupClass, tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, @@ -95,7 +95,7 @@ import GHC.Tc.Types.Origin ( CtOrigin(UsageEnvironmentOf) ) import GHC.Core.UsageEnv import GHC.Core.InstEnv -import GHC.Core.DataCon ( DataCon ) +import GHC.Core.DataCon ( DataCon, flSelector ) import GHC.Core.PatSyn ( PatSyn ) import GHC.Core.ConLike import GHC.Core.TyCon @@ -402,6 +402,24 @@ tcExtendTyConEnv tycons thing_inside tcExtendGlobalEnvImplicit (map ATyCon tycons) thing_inside } +-- Given a [TyThing] of "non-value" bindings coming from type decls +-- (constructors, field selectors, class methods) return their +-- TH binding levels (to be added to a LclEnv). +-- See GHC ticket #17820 . +tcTyThBinders :: [TyThing] -> TcM ThBindEnv +tcTyThBinders implicit_things = do + stage <- getStage + let th_lvl = thLevel stage + th_bndrs = mkNameEnv + [ ( n , (TopLevel, th_lvl) ) | n <- names ] + return th_bndrs + where + names = concatMap get_names implicit_things + get_names (AConLike acl) = + conLikeName acl : map flSelector (conLikeFieldLabels acl) + get_names (AnId i) = [idName i] + get_names _ = [] + tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a -- Same deal as tcExtendGlobalEnv, but for Ids tcExtendGlobalValEnv ids thing_inside |