Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
eb2ab1e2
by Oleg Grenrus at 2025-08-29T11:00:53-04:00
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:
| ... | ... | @@ -16,7 +16,7 @@ module GHC.Core.Opt.Monad ( |
| 16 | 16 | mapDynFlagsCoreM, dropSimplCount,
|
| 17 | 17 | |
| 18 | 18 | -- ** Reading from the monad
|
| 19 | - getHscEnv, getModule,
|
|
| 19 | + getModule,
|
|
| 20 | 20 | initRuleEnv, getExternalRuleBase,
|
| 21 | 21 | getDynFlags, getPackageFamInstEnv,
|
| 22 | 22 | getInteractiveContext,
|
| ... | ... | @@ -243,8 +243,8 @@ liftIOWithCount what = liftIO what >>= (\(count, x) -> addSimplCount count >> re |
| 243 | 243 | ************************************************************************
|
| 244 | 244 | -}
|
| 245 | 245 | |
| 246 | -getHscEnv :: CoreM HscEnv
|
|
| 247 | -getHscEnv = read cr_hsc_env
|
|
| 246 | +instance HasHscEnv CoreM where
|
|
| 247 | + getHscEnv = read cr_hsc_env
|
|
| 248 | 248 | |
| 249 | 249 | getHomeRuleBase :: CoreM RuleBase
|
| 250 | 250 | getHomeRuleBase = read cr_rule_base
|
| ... | ... | @@ -2,6 +2,7 @@ |
| 2 | 2 | module GHC.Driver.Env
|
| 3 | 3 | ( Hsc(..)
|
| 4 | 4 | , HscEnv (..)
|
| 5 | + , HasHscEnv (..)
|
|
| 5 | 6 | , hsc_mod_graph
|
| 6 | 7 | , setModuleGraph
|
| 7 | 8 | , hscUpdateFlags
|
| ... | ... | @@ -49,7 +50,7 @@ import GHC.Driver.Errors ( printOrThrowDiagnostics ) |
| 49 | 50 | import GHC.Driver.Errors.Types ( GhcMessage )
|
| 50 | 51 | import GHC.Driver.Config.Logger (initLogFlags)
|
| 51 | 52 | import GHC.Driver.Config.Diagnostic (initDiagOpts, initPrintConfig)
|
| 52 | -import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..) )
|
|
| 53 | +import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..), HasHscEnv (..) )
|
|
| 53 | 54 | |
| 54 | 55 | import GHC.Runtime.Context
|
| 55 | 56 | import GHC.Runtime.Interpreter.Types (Interp)
|
| ... | ... | @@ -3,6 +3,7 @@ |
| 3 | 3 | module GHC.Driver.Env.Types
|
| 4 | 4 | ( Hsc(..)
|
| 5 | 5 | , HscEnv(..)
|
| 6 | + , HasHscEnv(..)
|
|
| 6 | 7 | ) where
|
| 7 | 8 | |
| 8 | 9 | import GHC.Driver.Errors.Types ( GhcMessage )
|
| ... | ... | @@ -34,6 +35,9 @@ newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage |
| 34 | 35 | deriving (Functor, Applicative, Monad, MonadIO)
|
| 35 | 36 | via ReaderT HscEnv (StateT (Messages GhcMessage) IO)
|
| 36 | 37 | |
| 38 | +instance HasHscEnv Hsc where
|
|
| 39 | + getHscEnv = Hsc $ \e w -> return (e, w)
|
|
| 40 | + |
|
| 37 | 41 | instance HasDynFlags Hsc where
|
| 38 | 42 | getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w)
|
| 39 | 43 | |
| ... | ... | @@ -109,3 +113,5 @@ data HscEnv |
| 109 | 113 | -- ^ LLVM configuration cache.
|
| 110 | 114 | }
|
| 111 | 115 | |
| 116 | +class HasHscEnv m where
|
|
| 117 | + getHscEnv :: m HscEnv |
| ... | ... | @@ -368,9 +368,6 @@ clearDiagnostics = Hsc $ \_ _ -> return ((), emptyMessages) |
| 368 | 368 | logDiagnostics :: Messages GhcMessage -> Hsc ()
|
| 369 | 369 | logDiagnostics w = Hsc $ \_ w0 -> return ((), w0 `unionMessages` w)
|
| 370 | 370 | |
| 371 | -getHscEnv :: Hsc HscEnv
|
|
| 372 | -getHscEnv = Hsc $ \e w -> return (e, w)
|
|
| 373 | - |
|
| 374 | 371 | handleWarnings :: Hsc ()
|
| 375 | 372 | handleWarnings = do
|
| 376 | 373 | diag_opts <- initDiagOpts <$> getDynFlags
|
| ... | ... | @@ -143,7 +143,7 @@ import Data.Maybe |
| 143 | 143 | |
| 144 | 144 | import GHC.Iface.Env ( lookupNameCache )
|
| 145 | 145 | import GHC.Prelude
|
| 146 | -import GHC.Utils.Monad ( mapMaybeM )
|
|
| 146 | +import GHC.Utils.Monad ( MonadIO, mapMaybeM )
|
|
| 147 | 147 | import GHC.ThToHs ( thRdrNameGuesses )
|
| 148 | 148 | import GHC.Tc.Utils.Env ( lookupGlobal )
|
| 149 | 149 | import GHC.Types.Name.Cache ( NameCache )
|
| ... | ... | @@ -178,7 +178,22 @@ instance MonadThings CoreM where |
| 178 | 178 | -- exactly. Qualified or unqualified TH names will be dynamically bound
|
| 179 | 179 | -- to names in the module being compiled, if possible. Exact TH names
|
| 180 | 180 | -- will be bound to the name they represent, exactly.
|
| 181 | -thNameToGhcName :: TH.Name -> CoreM (Maybe Name)
|
|
| 181 | +--
|
|
| 182 | +-- 'thNameToGhcName' can be used in 'CoreM', 'Hsc' and 'TcM' monads.
|
|
| 183 | +--
|
|
| 184 | +-- 'thNameToGhcName' is recommended way to lookup 'Name's in GHC plugins.
|
|
| 185 | +--
|
|
| 186 | +-- @
|
|
| 187 | +-- {-# LANGUAGE TemplateHaskellQuotes #-}
|
|
| 188 | +--
|
|
| 189 | +-- getNames :: Hsc (Maybe Name, Maybe Name)
|
|
| 190 | +-- getNames = do
|
|
| 191 | +-- class_Eq <- thNameToGhcName ''Eq
|
|
| 192 | +-- fun_eq <- thNameToGhcName '(==)
|
|
| 193 | +-- return (classEq, fun_eq)
|
|
| 194 | +-- @
|
|
| 195 | +--
|
|
| 196 | +thNameToGhcName :: (MonadIO m, HasHscEnv m) => TH.Name -> m (Maybe Name)
|
|
| 182 | 197 | thNameToGhcName th_name = do
|
| 183 | 198 | hsc_env <- getHscEnv
|
| 184 | 199 | liftIO $ thNameToGhcNameIO (hsc_NC hsc_env) th_name
|
| ... | ... | @@ -2641,8 +2641,8 @@ runBc hsc_env this_mod mbs (BcM m) |
| 2641 | 2641 | instance HasDynFlags BcM where
|
| 2642 | 2642 | getDynFlags = hsc_dflags <$> getHscEnv
|
| 2643 | 2643 | |
| 2644 | -getHscEnv :: BcM HscEnv
|
|
| 2645 | -getHscEnv = BcM $ \env st -> return (bcm_hsc_env env, st)
|
|
| 2644 | +instance HasHscEnv BcM where
|
|
| 2645 | + getHscEnv = BcM $ \env st -> return (bcm_hsc_env env, st)
|
|
| 2646 | 2646 | |
| 2647 | 2647 | getProfile :: BcM Profile
|
| 2648 | 2648 | getProfile = targetProfile <$> getDynFlags
|