[commit: ghc] wip/tc-plugins-amg: Trivial changes to clean up typechecker plugins diff (7a0e27f)
git at git.haskell.org
git at git.haskell.org
Tue Nov 18 12:16:16 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/tc-plugins-amg
Link : http://ghc.haskell.org/trac/ghc/changeset/7a0e27f930b0bfe4e76cd326e4e137fff482d738/ghc
>---------------------------------------------------------------
commit 7a0e27f930b0bfe4e76cd326e4e137fff482d738
Author: Adam Gundry <adam at well-typed.com>
Date: Tue Nov 18 10:09:34 2014 +0000
Trivial changes to clean up typechecker plugins diff
>---------------------------------------------------------------
7a0e27f930b0bfe4e76cd326e4e137fff482d738
compiler/ghc.mk | 1 +
compiler/ghci/RtClosureInspect.hs | 2 --
compiler/main/DynFlags.hs | 9 ++++-----
compiler/main/DynamicLoading.hs | 6 +++---
compiler/typecheck/TcRnDriver.lhs | 1 -
compiler/typecheck/TcRnMonad.lhs | 13 +------------
compiler/typecheck/TcRnTypes.lhs | 1 -
7 files changed, 9 insertions(+), 24 deletions(-)
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 69ab4fc..b5f5dbc 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -589,6 +589,7 @@ compiler_stage2_dll0_MODULES = \
Var \
VarEnv \
VarSet
+
ifeq "$(GhcWithInterpreter)" "YES"
# These files are reacheable from DynFlags
# only by GHCi-enabled code (see #9552)
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index a5bcf5d..1f751d1 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -568,8 +568,6 @@ runTR hsc_env thing = do
runTR_maybe :: HscEnv -> TR a -> IO (Maybe a)
runTR_maybe hsc_env thing_inside
- -- When we initialize the type checker we do not load any pluguns.
- -- Is that OK?
= do { (_errs, res) <- initTc hsc_env HsSrcFile False
(icInteractiveModule (hsc_IC hsc_env))
thing_inside
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index fbfd17e..0c6639a 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -719,7 +719,7 @@ data DynFlags = DynFlags {
-- Plugins
pluginModNames :: [ModuleName],
- pluginModNameOpts :: [(ModuleName, String)],
+ pluginModNameOpts :: [(ModuleName,String)],
-- GHC API hooks
hooks :: Hooks,
@@ -1880,8 +1880,7 @@ setSigOf :: String -> DynFlags -> DynFlags
setSigOf s d = d { sigOf = parseSigOf s }
addPluginModuleName :: String -> DynFlags -> DynFlags
-addPluginModuleName name d =
- d { pluginModNames = mkModuleName name : pluginModNames d }
+addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
addPluginModuleNameOption :: String -> DynFlags -> DynFlags
addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }
@@ -2455,8 +2454,8 @@ dynamic_flags = [
, Flag "w" (NoArg (upd (\dfs -> dfs {warningFlags = IntSet.empty})))
------ Plugin flags ------------------------------------------------
- , Flag "fplugin-opt" (hasArg addPluginModuleNameOption)
- , Flag "fplugin" (hasArg addPluginModuleName)
+ , Flag "fplugin-opt" (hasArg addPluginModuleNameOption)
+ , Flag "fplugin" (hasArg addPluginModuleName)
------ Optimisation flags ------------------------------------------
, Flag "O" (noArgM (setOptLevel 1))
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index 87b97f2..2356c23 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -25,7 +25,7 @@ module DynamicLoading (
import Linker ( linkModule, getHValue )
import SrcLoc ( noSrcSpan )
import Finder ( findImportedModule, cannotFindModule )
-import TcRnMonad ( initTcDynamic, initIfaceTcRn )
+import TcRnMonad ( initTcInteractive, initIfaceTcRn )
import LoadIface ( loadPluginInterface )
import RdrName ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(..)
, ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName
@@ -96,7 +96,7 @@ loadPlugin hsc_env mod_name
-- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
forceLoadModuleInterfaces :: HscEnv -> SDoc -> [Module] -> IO ()
forceLoadModuleInterfaces hsc_env doc modules
- = (initTcDynamic hsc_env $
+ = (initTcInteractive hsc_env $
initIfaceTcRn $
mapM_ (loadPluginInterface doc) modules)
>> return ()
@@ -198,7 +198,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
case found_module of
Found _ mod -> do
-- Find the exports of the module
- (_, mb_iface) <- initTcDynamic hsc_env $
+ (_, mb_iface) <- initTcInteractive hsc_env $
initIfaceTcRn $
loadPluginInterface doc mod
case mb_iface of
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index aed04c2..02d0026 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -377,7 +377,6 @@ implicitPreludeWarn
\end{code}
-
%************************************************************************
%* *
Import declarations
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index d3b3502..19bd602 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -72,7 +72,6 @@ import qualified Data.Map as Map
\begin{code}
-
-- | Setup the initial typechecking environment
initTc :: HscEnv
-> HscSource
@@ -207,22 +206,12 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
initTcInteractive :: HscEnv -> TcM a -> IO (Messages, Maybe a)
--- ^ Initialise the type checker monad for use in GHCi; the
--- thing_inside is responsible for loading plugins
+-- Initialise the type checker monad for use in GHCi
initTcInteractive hsc_env thing_inside
= initTc hsc_env HsSrcFile False
(icInteractiveModule (hsc_IC hsc_env))
thing_inside
-initTcDynamic :: HscEnv -> TcM a -> IO (Messages, Maybe a)
--- ^ Initialise the type checker for use in in dynamic loading; note
--- that plugins will not be loaded
-initTcDynamic hsc_env thing_inside
- = initTc hsc_env HsSrcFile False
- (icInteractiveModule (hsc_IC hsc_env))
- thing_inside
-
-
initTcForLookup :: HscEnv -> TcM a -> IO a
-- The thing_inside is just going to look up something
-- in the environment, so we don't need much setup
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 3e0c053..cc76c03 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -2031,4 +2031,3 @@ data TcPluginResult
-- the constraint solver.
\end{code}
-
More information about the ghc-commits
mailing list