[Git][ghc/ghc][wip/get-hscenv] Introduce HasHscEnv class, parallel to HasDynFlags

[Krzysztof Gogolewski]

Krzysztof Gogolewski pushed to branch wip/get-hscenv at Glasgow Haskell Compiler / GHC


Commits:
fb82da79 by Krzysztof Gogolewski at 2019-05-18T16:47:06Z
Introduce HasHscEnv class, parallel to HasDynFlags

- - - - -


4 changed files:

- compiler/ghci/ByteCodeGen.hs
- compiler/main/HscMain.hs
- compiler/main/HscTypes.hs
- compiler/simplCore/CoreMonad.hs


Changes:

=====================================
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


=====================================
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


=====================================
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


=====================================
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
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb82da79aed65b076f881b852f2eb98b97859211

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb82da79aed65b076f881b852f2eb98b97859211
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190518/619d6343/attachment-0001.html>