[commit: ghc] wip/tdammers/disable-defer-type-errors-ghci: Disable error deferring in interactive statements (425d8ac)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/tdammers/disable-defer-type-errors-ghci
Link       : http://ghc.haskell.org/trac/ghc/changeset/425d8ac50f17b404d6f704b5096aef6fc1e65414/ghc

>---------------------------------------------------------------

commit 425d8ac50f17b404d6f704b5096aef6fc1e65414
Author: Tobias Dammers <tdammers at gmail.com>
Date:   Tue Jun 12 10:01:26 2018 +0200

    Disable error deferring in interactive statements
    
    The `-fdefer-type-errors` flag, as well as `-fdefer-typed-holes` and
    `-fdefer-out-of-scope-variables` (which are implied by
    `-fdefer-type-errors`) currently cause GHCi to crash on perfectly
    well-typed programs (see Trac:#14963).
    
    Rather than fixing the underlying problem, we provide a workaround by
    simply disabling the three offending extensions while running
    interactive statements.


>---------------------------------------------------------------

425d8ac50f17b404d6f704b5096aef6fc1e65414
 ghc/GHCi/UI.hs       | 37 ++++++++++++++++++++++++-------------
 ghc/GHCi/UI/Monad.hs | 14 ++++++++++++++
 2 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 3ed1c7f..6e22d9e 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1078,19 +1078,30 @@ enqueueCommands cmds = do
 -- The return value True indicates success, as in `runOneCommand`.
 runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult)
 runStmt stmt step = do
-  dflags <- GHC.getInteractiveDynFlags
-  if | GHC.isStmt dflags stmt    -> run_stmt
-     | GHC.isImport dflags stmt  -> run_import
-     -- Every import declaration should be handled by `run_import`. As GHCi
-     -- in general only accepts one command at a time, we simply throw an
-     -- exception when the input contains multiple commands of which at least
-     -- one is an import command (see #10663).
-     | GHC.hasImport dflags stmt -> throwGhcException
-       (CmdLineError "error: expecting a single import declaration")
-     -- Note: `GHC.isDecl` returns False on input like
-     -- `data Infix a b = a :@: b; infixl 4 :@:`
-     -- and should therefore not be used here.
-     | otherwise                 -> run_decl
+  sdflags <- GHC.getSessionDynFlags
+  let sdflags' =
+        sdflags
+          `gopt_unset` Opt_DeferTypeErrors
+          `gopt_unset` Opt_DeferTypedHoles
+          `gopt_unset` Opt_DeferOutOfScopeVariables
+          `wopt_unset` Opt_WarnDeferredTypeErrors
+  bracketGHCi_
+    (GHC.setSessionDynFlags sdflags')
+    (GHC.setSessionDynFlags sdflags)
+    $ do
+        dflags <- GHC.getInteractiveDynFlags
+        if | GHC.isStmt dflags stmt    -> run_stmt
+           | GHC.isImport dflags stmt  -> run_import
+           -- Every import declaration should be handled by `run_import`. As GHCi
+           -- in general only accepts one command at a time, we simply throw an
+           -- exception when the input contains multiple commands of which at least
+           -- one is an import command (see #10663).
+           | GHC.hasImport dflags stmt -> throwGhcException
+             (CmdLineError "error: expecting a single import declaration")
+           -- Note: `GHC.isDecl` returns False on input like
+           -- `data Infix a b = a :@: b; infixl 4 :@:`
+           -- and should therefore not be used here.
+           | otherwise                 -> run_decl
 
   where
     run_import = do
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 45a5271..83af305 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -12,6 +12,7 @@
 
 module GHCi.UI.Monad (
         GHCi(..), startGHCi,
+        bracketGHCi, bracketGHCi_,
         GHCiState(..), setGHCiState, getGHCiState, modifyGHCiState,
         GHCiOption(..), isOptionSet, setOption, unsetOption,
         Command(..),
@@ -225,6 +226,19 @@ reifyGHCi f = GHCi f'
     -- f'' :: IORef GHCiState -> Session -> IO a
     f'' gs s = f (s, gs)
 
+bracketGHCi :: GHCi a -> (a -> GHCi c) -> (a -> GHCi b) -> GHCi b
+bracketGHCi acquire release run =
+  GHCi (\gs ->
+    Ghc (\s ->
+      bracket
+        (reflectGHCi (s, gs) acquire)
+        (\a -> reflectGHCi (s, gs) (release a))
+        (\a -> reflectGHCi (s, gs) (run a))))
+
+bracketGHCi_ :: GHCi a -> GHCi c -> GHCi b -> GHCi b
+bracketGHCi_ acquire release run =
+  bracketGHCi acquire (const release) (const run)
+
 startGHCi :: GHCi a -> GHCiState -> Ghc a
 startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref