diff options
Diffstat (limited to 'compiler/GHC/Tc/Utils/Env.hs')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Env.hs | 24 |
1 files changed, 20 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 43263450ac..52bf245dc5 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -22,6 +22,7 @@ module GHC.Tc.Utils.Env( tcLookupLocatedGlobal, tcLookupGlobal, tcLookupGlobalOnly, tcLookupTyCon, tcLookupClass, tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, + tcLookupRecSelParent, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupAxiom, lookupGlobal, lookupGlobal_maybe, ioLookupDataCon, @@ -74,6 +75,7 @@ module GHC.Tc.Utils.Env( import GHC.Prelude import GHC.Driver.Env +import GHC.Driver.Env.KnotVars import GHC.Driver.Session import GHC.Builtin.Names @@ -96,7 +98,7 @@ import GHC.Tc.Types.Origin ( CtOrigin(UsageEnvironmentOf) ) import GHC.Core.UsageEnv import GHC.Core.InstEnv -import GHC.Core.DataCon ( DataCon, flSelector ) +import GHC.Core.DataCon ( DataCon, dataConTyCon, flSelector ) import GHC.Core.PatSyn ( PatSyn ) import GHC.Core.ConLike import GHC.Core.TyCon @@ -104,6 +106,7 @@ import GHC.Core.Type import GHC.Core.Coercion.Axiom import GHC.Core.Class + import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.External @@ -126,17 +129,18 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env import GHC.Types.Id +import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Name.Reader import GHC.Types.TyThing +import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import qualified GHC.LanguageExtensions as LangExt import GHC.Tc.Errors.Ppr (pprTyThingUsedWrong) import Data.IORef -import Data.List (intercalate) +import Data.List ( intercalate ) import Control.Monad -import GHC.Driver.Env.KnotVars {- ********************************************************************* * * @@ -292,6 +296,17 @@ tcLookupConLike name = do AConLike cl -> return cl _ -> wrongThingErr WrongThingConLike (AGlobal thing) name +tcLookupRecSelParent :: HsRecUpdParent GhcRn -> TcM RecSelParent +tcLookupRecSelParent (RnRecUpdParent { rnRecUpdCons = cons }) + = case any_con of + PatSynName ps -> + RecSelPatSyn <$> tcLookupPatSyn ps + DataConName dc -> + RecSelData . dataConTyCon <$> tcLookupDataCon dc + where + any_con = head $ nonDetEltsUniqSet cons + -- Any constructor will give the same result here. + tcLookupClass :: Name -> TcM Class tcLookupClass name = do thing <- tcLookupGlobal name @@ -508,6 +523,7 @@ tcLookupTcTyCon name = do ATcTyCon tc -> return tc _ -> pprPanic "tcLookupTcTyCon" (ppr name) + getInLocalScope :: TcM (Name -> Bool) getInLocalScope = do { lcl_env <- getLclTypeEnv ; return (`elemNameEnv` lcl_env) } @@ -1064,7 +1080,7 @@ newDFunName clas tys loc = do { is_boot <- tcIsHsBootOrSig ; mod <- getModule ; let info_string = occNameString (getOccName clas) ++ - concatMap (occNameString.getDFunTyKey) tys + concatMap (occNameString . getDFunTyKey) tys ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot) ; newGlobalBinder mod dfun_occ loc } |