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

[Ben Gamari]

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


Commits:
00f07ca5 by Roland Senn at 2020-12-08T20:16:09+01:00
Backport: Fix for #18955 to GHC 9.0

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.

- - - - -


8 changed files:

- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.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/GHC/Driver/Flags.hs
=====================================
@@ -273,7 +273,7 @@ data GeneralFlag
    | Opt_SingleLibFolder
    | Opt_KeepCAFs
    | Opt_KeepGoing
-   | Opt_ByteCode
+   | Opt_ByteCodeIfUnboxed
    | Opt_LinkRts
 
    -- output style opts


=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -2230,7 +2230,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)) &&
       (isBootSummary ms == NotBoot)
     unboxed_tuples_or_sums d =
       xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3091,10 +3091,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


=====================================
ghc/GHCi/UI.hs
=====================================
@@ -1941,6 +1941,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
@@ -1953,6 +1954,24 @@ 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 GHCi will support unboxed tuples and
+-- unboxed sums.
+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
=====================================
@@ -318,3 +318,4 @@ test('T17403', normal, ghci_script, ['T17403.script'])
 test('T17431', normal, ghci_script, ['T17431.script'])
 test('T17549', normal, ghci_script, ['T17549.script'])
 test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script'])
+test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00f07ca5a7f6b51fd94508a8da3a4cbf1ee3b73c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00f07ca5a7f6b51fd94508a8da3a4cbf1ee3b73c
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/20201214/e09a56a2/attachment-0001.html>