[Git][ghc/ghc][ghc-8.10] Backport: Fix for #18955 to GHC 8.10 #18955

[Ben Gamari]

Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC


Commits:
65ed2fdc by Roland Senn at 2020-11-30T14:26:58+01:00
Backport: Fix for #18955 to GHC 8.10 #18955

Since MR !554 (#15454) GHCi automatically enabled the flag `-fobject-code` on
any module using the UnboxedTuples or UnboxedSum extensions.

MR !1553 (#16876) allowed to inhibit the automatic compiling to object-code
of these modules by setting the `fbyte-code` flag. However, it assigned 2
different semantics to this flag and introduced the regression described in
issue #18955.

This MR fixes this regression by unsetting the internal flag
`Opt_ByteCodeIfUnboxed` before it's copied to DynFlags local to the module.
In GHC 9.0.1 the issue is solved by introducing a new flag
`-f(no-)object-code-if-unboxed`.

- - - - -


7 changed files:

- compiler/main/DynFlags.hs
- compiler/main/GhcMake.hs
- ghc/GHCi/UI.hs
- + testsuite/tests/ghci/scripts/T18955.hs
- + testsuite/tests/ghci/scripts/T18955.script
- + testsuite/tests/ghci/scripts/T18955.stdout
- testsuite/tests/ghci/scripts/all.T


Changes:

=====================================
compiler/main/DynFlags.hs
=====================================
@@ -658,7 +658,7 @@ data GeneralFlag
    | Opt_SingleLibFolder
    | Opt_KeepCAFs
    | Opt_KeepGoing
-   | Opt_ByteCode
+   | Opt_ByteCodeIfUnboxed
 
    -- output style opts
    | Opt_ErrorSpans -- Include full span info in error messages,
@@ -3781,10 +3781,10 @@ dynamic_flags_deps = [
 
   , make_ord_flag defFlag "fno-code"         (NoArg ((upd $ \d ->
                   d { ghcLink=NoLink }) >> setTarget HscNothing))
-  , make_ord_flag defFlag "fbyte-code"
-      (noArgM $ \dflags -> do
-        setTarget HscInterpreted
-        pure $ gopt_set dflags Opt_ByteCode)
+  , make_ord_flag defFlag "fbyte-code"       (NoArg ((upd $ \d ->
+      -- Enabling Opt_ByteCodeIfUnboxed is a workaround for #18955.
+      -- See the comments for resetOptByteCodeIfUnboxed for more details.
+      gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted))
   , make_ord_flag defFlag "fobject-code"     $ NoArg $ do
       dflags <- liftEwM getCmdLineState
       setTarget $ defaultObjectTarget dflags


=====================================
compiler/main/GhcMake.hs
=====================================
@@ -2185,7 +2185,7 @@ enableCodeGenForUnboxedTuplesOrSums =
   where
     condition ms =
       unboxed_tuples_or_sums (ms_hspp_opts ms) &&
-      not (gopt Opt_ByteCode (ms_hspp_opts ms)) &&
+      not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) &&
       not (isBootSummary ms)
     unboxed_tuples_or_sums d =
       xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d


=====================================
ghc/GHCi/UI.hs
=====================================
@@ -1935,6 +1935,7 @@ reloadModuleDefer = wrapDeferTypeErrors . reloadModule
 -- sessions.
 doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
 doLoadAndCollectInfo retain_context howmuch = do
+  resetOptByteCodeIfUnboxed                               -- #18955
   doCollectInfo <- isOptionSet CollectInfo
 
   doLoad retain_context howmuch >>= \case
@@ -1947,6 +1948,25 @@ doLoadAndCollectInfo retain_context howmuch = do
       return Succeeded
     flag -> return flag
 
+-- An `OPTIONS_GHC -fbyte-code` pragma at the beginning of a module sets the
+-- flag `Opt_ByteCodeIfUnboxed` locally for this module. This stops automatic
+-- compilation of this module to object code, if the module uses (or depends
+-- on a module using) the UnboxedSums/Tuples extensions.
+-- However a GHCi `:set -fbyte-code` command sets the flag Opt_ByteCodeIfUnboxed
+-- globally to all modules. This triggered #18955. This function unsets the
+-- flag from the global DynFlags before they are copied to the module-specific
+-- DynFlags.
+-- This is a temporary workaround until GHC 9.0.1, which allows disabling
+-- this feature at a finer-grained level by way of the
+-- -fno-object-code-if-unboxed flag. See !4531.
+resetOptByteCodeIfUnboxed :: GhciMonad m => m ()
+resetOptByteCodeIfUnboxed = do
+  dflags <- getDynFlags
+  when (gopt Opt_ByteCodeIfUnboxed dflags) $ do
+    _ <- GHC.setProgramDynFlags $ gopt_unset dflags Opt_ByteCodeIfUnboxed
+    pure ()
+  pure ()
+
 doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
 doLoad retain_context howmuch = do
   -- turn off breakpoints before we load: we can't turn them off later, because


=====================================
testsuite/tests/ghci/scripts/T18955.hs
=====================================
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Hello World"


=====================================
testsuite/tests/ghci/scripts/T18955.script
=====================================
@@ -0,0 +1,3 @@
+:set -v1
+:set -fbyte-code
+:l T18955


=====================================
testsuite/tests/ghci/scripts/T18955.stdout
=====================================
@@ -0,0 +1,2 @@
+[1 of 1] Compiling Main             ( T18955.hs, interpreted )
+Ok, one module loaded.


=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -311,3 +311,4 @@ test('T17345', normal, ghci_script, ['T17345.script'])
 test('T17384', normal, ghci_script, ['T17384.script'])
 test('T17403', normal, ghci_script, ['T17403.script'])
 test('T17431', normal, ghci_script, ['T17431.script'])
+test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65ed2fdca2e0d0e8f3535b31f94dcdc1424e5cf2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65ed2fdca2e0d0e8f3535b31f94dcdc1424e5cf2
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/20201201/d300ba93/attachment-0001.html>