Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: eb2ab1e2 by Oleg Grenrus at 2025-08-29T11:00:53-04:00 Generalise thNameToGhcName by adding HasHscEnv There were multiple single monad-specific `getHscEnv` across codebase. HasHscEnv is modelled on HasDynFlags. My first idea was to simply add thNameToGhcNameHsc and thNameToGhcNameTc, but those would been exactly the same as thNameToGhcName already. Also add an usage example to thNameToGhcName and mention that it's recommended way of looking up names in GHC plugins - - - - - 6 changed files: - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Plugins.hs - compiler/GHC/StgToByteCode.hs Changes: ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -16,7 +16,7 @@ module GHC.Core.Opt.Monad ( mapDynFlagsCoreM, dropSimplCount, -- ** Reading from the monad - getHscEnv, getModule, + getModule, initRuleEnv, getExternalRuleBase, getDynFlags, getPackageFamInstEnv, getInteractiveContext, @@ -243,8 +243,8 @@ liftIOWithCount what = liftIO what >>= (\(count, x) -> addSimplCount count >> re ************************************************************************ -} -getHscEnv :: CoreM HscEnv -getHscEnv = read cr_hsc_env +instance HasHscEnv CoreM where + getHscEnv = read cr_hsc_env getHomeRuleBase :: CoreM RuleBase getHomeRuleBase = read cr_rule_base ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Env ( Hsc(..) , HscEnv (..) + , HasHscEnv (..) , hsc_mod_graph , setModuleGraph , hscUpdateFlags @@ -49,7 +50,7 @@ import GHC.Driver.Errors ( printOrThrowDiagnostics ) import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Diagnostic (initDiagOpts, initPrintConfig) -import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..) ) +import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..), HasHscEnv (..) ) import GHC.Runtime.Context import GHC.Runtime.Interpreter.Types (Interp) ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -3,6 +3,7 @@ module GHC.Driver.Env.Types ( Hsc(..) , HscEnv(..) + , HasHscEnv(..) ) where import GHC.Driver.Errors.Types ( GhcMessage ) @@ -34,6 +35,9 @@ newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage deriving (Functor, Applicative, Monad, MonadIO) via ReaderT HscEnv (StateT (Messages GhcMessage) IO) +instance HasHscEnv Hsc where + getHscEnv = Hsc $ \e w -> return (e, w) + instance HasDynFlags Hsc where getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w) @@ -109,3 +113,5 @@ data HscEnv -- ^ LLVM configuration cache. } +class HasHscEnv m where + getHscEnv :: m HscEnv ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -368,9 +368,6 @@ clearDiagnostics = Hsc $ \_ _ -> return ((), emptyMessages) logDiagnostics :: Messages GhcMessage -> Hsc () logDiagnostics w = Hsc $ \_ w0 -> return ((), w0 `unionMessages` w) -getHscEnv :: Hsc HscEnv -getHscEnv = Hsc $ \e w -> return (e, w) - handleWarnings :: Hsc () handleWarnings = do diag_opts <- initDiagOpts <$> getDynFlags ===================================== compiler/GHC/Plugins.hs ===================================== @@ -143,7 +143,7 @@ import Data.Maybe import GHC.Iface.Env ( lookupNameCache ) import GHC.Prelude -import GHC.Utils.Monad ( mapMaybeM ) +import GHC.Utils.Monad ( MonadIO, mapMaybeM ) import GHC.ThToHs ( thRdrNameGuesses ) import GHC.Tc.Utils.Env ( lookupGlobal ) import GHC.Types.Name.Cache ( NameCache ) @@ -178,7 +178,22 @@ instance MonadThings CoreM where -- exactly. Qualified or unqualified TH names will be dynamically bound -- to names in the module being compiled, if possible. Exact TH names -- will be bound to the name they represent, exactly. -thNameToGhcName :: TH.Name -> CoreM (Maybe Name) +-- +-- 'thNameToGhcName' can be used in 'CoreM', 'Hsc' and 'TcM' monads. +-- +-- 'thNameToGhcName' is recommended way to lookup 'Name's in GHC plugins. +-- +-- @ +-- {-# LANGUAGE TemplateHaskellQuotes #-} +-- +-- getNames :: Hsc (Maybe Name, Maybe Name) +-- getNames = do +-- class_Eq <- thNameToGhcName ''Eq +-- fun_eq <- thNameToGhcName '(==) +-- return (classEq, fun_eq) +-- @ +-- +thNameToGhcName :: (MonadIO m, HasHscEnv m) => TH.Name -> m (Maybe Name) thNameToGhcName th_name = do hsc_env <- getHscEnv liftIO $ thNameToGhcNameIO (hsc_NC hsc_env) th_name ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -2641,8 +2641,8 @@ runBc hsc_env this_mod mbs (BcM m) instance HasDynFlags BcM where getDynFlags = hsc_dflags <$> getHscEnv -getHscEnv :: BcM HscEnv -getHscEnv = BcM $ \env st -> return (bcm_hsc_env env, st) +instance HasHscEnv BcM where + getHscEnv = BcM $ \env st -> return (bcm_hsc_env env, st) getProfile :: BcM Profile getProfile = targetProfile <$> getDynFlags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb2ab1e2cadde93c330330ca7fdc64b3... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb2ab1e2cadde93c330330ca7fdc64b3... You're receiving this email because of your account on gitlab.haskell.org.