diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2019-05-18 18:08:57 +0200 |
---|---|---|
committer | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2019-05-18 18:47:06 +0200 |
commit | fb82da79aed65b076f881b852f2eb98b97859211 (patch) | |
tree | bf81437462648895aaaf0e06978e0e0983fd299f | |
parent | a5fdd185188fcda595fd712f90864ec7c20cdace (diff) | |
download | haskell-fb82da79aed65b076f881b852f2eb98b97859211.tar.gz |
Introduce HasHscEnv class, parallel to HasDynFlagswip/get-hscenv
-rw-r--r-- | compiler/ghci/ByteCodeGen.hs | 4 | ||||
-rw-r--r-- | compiler/main/HscMain.hs | 4 | ||||
-rw-r--r-- | compiler/main/HscTypes.hs | 8 | ||||
-rw-r--r-- | compiler/simplCore/CoreMonad.hs | 8 |
4 files changed, 14 insertions, 10 deletions
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index c4a08c4e40..6af9cdf77f 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -1906,8 +1906,8 @@ instance Monad BcM where instance HasDynFlags BcM where getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st)) -getHscEnv :: BcM HscEnv -getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st) +instance HasHscEnv BcM where + getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st) emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name) emitBc bco diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 911d52cbfd..7698b55ddc 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -73,7 +73,6 @@ module HscMain -- We want to make sure that we export enough to be able to redefine -- hscFileFrontEnd in client code , hscParse', hscSimplify', hscDesugar', tcRnModule' - , getHscEnv , hscSimpleIface', hscNormalIface' , oneShotMsg , hscFileFrontEnd, genericHscFrontend, dumpIfaceStats @@ -216,9 +215,6 @@ clearWarnings = Hsc $ \_ _ -> return ((), emptyBag) logWarnings :: WarningMessages -> Hsc () logWarnings w = Hsc $ \_ w0 -> return ((), w0 `unionBags` w) -getHscEnv :: Hsc HscEnv -getHscEnv = Hsc $ \e w -> return (e, w) - handleWarnings :: Hsc () handleWarnings = do dflags <- getDynFlags diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 8c41f9b9fc..cb1cc7e862 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -12,6 +12,7 @@ module HscTypes ( -- * compilation state HscEnv(..), hscEPS, + HasHscEnv(..), FinderCache, FindResult(..), InstalledFindResult(..), Target(..), TargetId(..), pprTarget, pprTargetId, HscStatus(..), @@ -246,6 +247,9 @@ instance Monad Hsc where instance MonadIO Hsc where liftIO io = Hsc $ \_ w -> do a <- io; return (a, w) +instance HasHscEnv Hsc where + getHscEnv = Hsc $ \e w -> return (e, w) + instance HasDynFlags Hsc where getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w) @@ -494,6 +498,10 @@ data IServ = IServ hscEPS :: HscEnv -> IO ExternalPackageState hscEPS hsc_env = readIORef (hsc_EPS hsc_env) + +class Monad m => HasHscEnv m where + getHscEnv :: m HscEnv + -- | A compilation target. -- -- A target may be supplied with the actual text of the diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 013b1414ee..dde4cb6c50 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -25,7 +25,7 @@ module CoreMonad ( CoreM, runCoreM, -- ** Reading from the monad - getHscEnv, getRuleBase, getModule, + getRuleBase, getModule, getDynFlags, getOrigNameCache, getPackageFamInstEnv, getVisibleOrphanMods, getPrintUnqualified, getSrcSpanM, @@ -685,9 +685,6 @@ liftIOWithCount what = liftIO what >>= (\(count, x) -> addSimplCount count >> re ************************************************************************ -} -getHscEnv :: CoreM HscEnv -getHscEnv = read cr_hsc_env - getRuleBase :: CoreM RuleBase getRuleBase = read cr_rule_base @@ -708,6 +705,9 @@ addSimplCount count = write (CoreWriter { cw_simpl_count = count }) instance HasDynFlags CoreM where getDynFlags = fmap hsc_dflags getHscEnv +instance HasHscEnv CoreM where + getHscEnv = read cr_hsc_env + instance HasModule CoreM where getModule = read cr_module |