[commit: ghc] master: Disable -XRebindableSyntax when running internal GHCi expressions (e023e78)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e023e78bc13ffae168f00a52324fc406a146b40f/ghc

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

commit e023e78bc13ffae168f00a52324fc406a146b40f
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Oct 19 09:50:17 2017 -0400

    Disable -XRebindableSyntax when running internal GHCi expressions
    
    Summary:
    It's well known that `-XRebindableSyntax` doesn't play
    nicely with some of the internal expressions that GHCi runs. #13385
    was one example where this problem arose, which was fixed at the time
    by simply avoiding the use of `do`-notation in these internal GHCi
    expressions. That seemed to work, but it was a technique that proved
    not to scale, as #14342 demonstrated //another// example where
    `-XRebindableSyntax` can bite.
    
    Instead of delicately arranging the internal GHCi expressions to
    avoid anything that might be covered under `-XRebindableSyntax`,
    this patch takes the much more direct approach of disabling
    `-XRebindableSyntax` entirely when running any internal GHCi
    expression. This shouldn't hurt, since nothing internal to GHCi was
    taking advantage of the extension in the first place, and moreover,
    we can have greater confidence that some other obscure
    `-XRebindableSyntax` corner case won't pop up in the future. As an
    added bonus, this lets us once again use `do`-notation in the code
    that had to be changed when #13385 was (hackily) fixed before.
    
    Test Plan: make test TEST=T14342
    
    Reviewers: bgamari, austin
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14342
    
    Differential Revision: https://phabricator.haskell.org/D4086


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

e023e78bc13ffae168f00a52324fc406a146b40f
 ghc/GHCi/UI/Monad.hs                               | 33 +++++++++++++++-------
 .../tests/ghci/scripts/T14342.script               |  0
 testsuite/tests/ghci/scripts/all.T                 |  2 ++
 3 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 9233beb..45a5271 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -62,6 +62,7 @@ import qualified System.Console.Haskeline as Haskeline
 import Control.Monad.Trans.Class
 import Control.Monad.IO.Class
 import Data.Map.Strict (Map)
+import qualified GHC.LanguageExtensions as LangExt
 
 -----------------------------------------------------------------------------
 -- GHCi monad
@@ -421,15 +422,13 @@ foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
 -- | Compile "hFlush stdout; hFlush stderr" once, so we can use it repeatedly
 initInterpBuffering :: Ghc (ForeignHValue, ForeignHValue)
 initInterpBuffering = do
-  -- We take great care not to use do-notation in the expressions below, as
-  -- they are fragile in the presence of RebindableSyntax (Trac #13385).
-  nobuf <- GHC.compileExprRemote $
-   "                  System.IO.hSetBuffering System.IO.stdin  System.IO.NoBuffering" ++
-   "`GHC.Base.thenIO` System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
-   "`GHC.Base.thenIO` System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
-  flush <- GHC.compileExprRemote $
-   "                  System.IO.hFlush System.IO.stdout" ++
-   "`GHC.Base.thenIO` System.IO.hFlush System.IO.stderr"
+  nobuf <- compileGHCiExpr $
+   "do { System.IO.hSetBuffering System.IO.stdin System.IO.NoBuffering; " ++
+       " System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering; " ++
+       " System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering }"
+  flush <- compileGHCiExpr $
+   "do { System.IO.hFlush System.IO.stdout; " ++
+       " System.IO.hFlush System.IO.stderr }"
   return (nobuf, flush)
 
 -- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
@@ -452,6 +451,20 @@ turnOffBuffering_ fhv = do
 
 mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
 mkEvalWrapper progname args =
-  GHC.compileExprRemote $
+  compileGHCiExpr $
     "\\m -> System.Environment.withProgName " ++ show progname ++
     "(System.Environment.withArgs " ++ show args ++ " m)"
+
+compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
+compileGHCiExpr expr = do
+  hsc_env <- getSession
+  let dflags = hsc_dflags hsc_env
+      -- RebindableSyntax can wreak havoc with GHCi in several ways
+      -- (see #13385 and #14342 for examples), so we take care to disable it
+      -- for the duration of running expressions that are internal to GHCi.
+      no_rb_hsc_env =
+        hsc_env { hsc_dflags = xopt_unset dflags LangExt.RebindableSyntax }
+  setSession no_rb_hsc_env
+  res <- GHC.compileExprRemote expr
+  setSession hsc_env
+  pure res
diff --git a/libraries/ghc-compact/tests/compact_serialize.stderr b/testsuite/tests/ghci/scripts/T14342.script
similarity index 100%
copy from libraries/ghc-compact/tests/compact_serialize.stderr
copy to testsuite/tests/ghci/scripts/T14342.script
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 4eed55b..e453591 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -260,3 +260,5 @@ test('T13699', normal, ghci_script, ['T13699.script'])
 test('T13988', normal, ghci_script, ['T13988.script'])
 test('T13407', normal, ghci_script, ['T13407.script'])
 test('T13963', normal, ghci_script, ['T13963.script'])
+test('T14342', [extra_hc_opts("-XOverloadedStrings -XRebindableSyntax")],
+               ghci_script, ['T14342.script'])