Disable -XRebindableSyntax when running internal GHCi expressions
authorRyan Scott <ryan.gl.scott@gmail.com>
Thu, 19 Oct 2017 13:50:17 +0000 (09:50 -0400)
committerRyan Scott <ryan.gl.scott@gmail.com>
Thu, 19 Oct 2017 13:50:17 +0000 (09:50 -0400)
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

ghc/GHCi/UI/Monad.hs
testsuite/tests/ghci/scripts/T14342.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T

index 9233beb..45a5271 100644 (file)
@@ -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/testsuite/tests/ghci/scripts/T14342.script b/testsuite/tests/ghci/scripts/T14342.script
new file mode 100644 (file)
index 0000000..e69de29
index 4eed55b..e453591 100755 (executable)
@@ -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'])