[Git][ghc/ghc][wip/backports-9.0] 6 commits: Backport: Fix for #18955 to GHC 9.0
Ben Gamari
gitlab at gitlab.haskell.org
Fri Dec 18 02:34:03 UTC 2020
Ben Gamari pushed to branch wip/backports-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.
- - - - -
3a1af9bf by Ben Gamari at 2020-12-14T10:31:58-05:00
Bump Cabal submodule to 3.4.0.0-rc5
- - - - -
f081501e by Andreas Klebinger at 2020-12-14T10:31:58-05:00
RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill
Fixes #18994
Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com>
(cherry picked from commit 3e3555cc9c2a9f5246895f151259fd2a81621f38)
- - - - -
ca506ea7 by Shayne Fletcher at 2020-12-14T10:31:58-05:00
Fix bad span calculations of post qualified imports
(cherry picked from commit 4a437bc19d2026845948356a932b2cac2417eb12)
- - - - -
48896a5a by Adam Sandberg Ericsson at 2020-12-17T21:33:25-05:00
hadrian: correctly copy the docs dir into the bindist #18669
(cherry picked from commit c647763954717d9853d08ff04eece7f1ddeae15c)
- - - - -
0b1a82db by Adam Sandberg Ericsson at 2020-12-17T21:33:25-05:00
mkDocs: support hadrian bindists #18973
(cherry picked from commit e033dd0512443140dcca5b3c90b84022d8caf942)
- - - - -
17 changed files:
- compiler/GHC/CmmToAsm/Reg/Graph.hs
- compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Parser.y
- distrib/mkDocs/mkDocs
- ghc/GHCi/UI.hs
- hadrian/src/Rules/BinaryDist.hs
- libraries/Cabal
- + testsuite/tests/ghci/scripts/T18955.hs
- + testsuite/tests/ghci/scripts/T18955.script
- + testsuite/tests/ghci/scripts/T18955.stdout
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/module/all.T
- + testsuite/tests/module/mod185.hs
- + testsuite/tests/module/mod185.stderr
Changes:
=====================================
compiler/GHC/CmmToAsm/Reg/Graph.hs
=====================================
@@ -278,7 +278,8 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap
, raCoalesced = rmCoalesce
, raSpillStats = spillStats
, raSpillCosts = spillCosts
- , raSpilled = code_spilled }
+ , raSpilled = code_spilled
+ , raPlatform = platform }
-- Bundle up all the register allocator statistics.
-- .. but make sure to drop them on the floor if they're not
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
=====================================
@@ -73,7 +73,11 @@ data RegAllocStats statics instr
, raSpillCosts :: SpillCostInfo
-- | Code with spill instructions added.
- , raSpilled :: [LiveCmmDecl statics instr] }
+ , raSpilled :: [LiveCmmDecl statics instr]
+
+ -- | Target platform
+ , raPlatform :: !Platform
+ }
-- a successful coloring
=====================================
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
=====================================
compiler/GHC/Parser.y
=====================================
@@ -967,18 +967,20 @@ importdecls_semi
importdecl :: { LImportDecl GhcPs }
: 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec
{% do {
- ; checkImportDecl $4 $7
- ; ams (L (comb4 $1 $6 (snd $8) $9) $
+ ; let { ; mPreQual = unLoc $4
+ ; mPostQual = unLoc $7 }
+ ; checkImportDecl mPreQual mPostQual
+ ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $
ImportDecl { ideclExt = noExtField
, ideclSourceSrc = snd $ fst $2
, ideclName = $6, ideclPkgQual = snd $5
, ideclSource = snd $2, ideclSafe = snd $3
- , ideclQualified = importDeclQualifiedStyle $4 $7
+ , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual
, ideclImplicit = False
, ideclAs = unLoc (snd $8)
, ideclHiding = unLoc $9 })
- (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4)
- ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8)
+ (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual)
+ ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8)
}
}
@@ -1002,9 +1004,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } }
| {- empty -} { ([],Nothing) }
-optqualified :: { Maybe (Located Token) }
- : 'qualified' { Just $1 }
- | {- empty -} { Nothing }
+optqualified :: { Located (Maybe (Located Token)) }
+ : 'qualified' { sL1 $1 (Just $1) }
+ | {- empty -} { noLoc Nothing }
maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
: 'as' modid { ([mj AnnAs $1]
@@ -3754,6 +3756,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
(combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
combineSrcSpans (getLoc c) (getLoc d))
+comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan
+comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq`
+ (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
+ combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e))
+
-- strict constructor version:
{-# INLINE sL #-}
sL :: SrcSpan -> a -> Located a
=====================================
distrib/mkDocs/mkDocs
=====================================
@@ -31,7 +31,9 @@ cd ..
tar -Jxf "$WINDOWS_BINDIST"
mv ghc* windows
cd inst/share/doc/ghc*/html/libraries
-mv ../../../../../../windows/doc/html/libraries/Win32-* .
+mv ../../../../../../windows/doc/html/libraries/Win32-* . || \ # make binary distribution
+ mv ../../../../../../windows/docs/html/libraries/Win32 . || \ # hadrian binary distribution
+ die "failed to find the Win32 package documentation"
sh gen_contents_index
cd ..
for i in haddock libraries users_guide
=====================================
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
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -12,6 +12,7 @@ import Settings
import Settings.Program (programContext)
import Target
import Utilities
+import qualified System.Directory.Extra as IO
{-
Note [Binary distributions]
@@ -136,13 +137,20 @@ bindistRules = do
copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir
copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir
copyDirectory (rtsIncludeDir) bindistFilesDir
+
unless cross $ need ["docs"]
+
-- TODO: we should only embed the docs that have been generated
-- depending on the current settings (flavours' "ghcDocs" field and
-- "--docs=.." command-line flag)
-- Currently we embed the "docs" directory if it exists but it may
-- contain outdated or even invalid data.
- whenM (doesDirectoryExist (root -/- "docs")) $ do
+
+ -- Use the IO version of doesDirectoryExist because the Shake Action
+ -- version should not be used for directories the build system can
+ -- create. Using the Action version caused documentation to not be
+ -- included in the bindist in the past (part of the problem in #18669).
+ whenM (liftIO (IO.doesDirectoryExist (root -/- "docs"))) $ do
copyDirectory (root -/- "docs") bindistFilesDir
when windowsHost $ do
copyDirectory (root -/- "mingw") bindistFilesDir
=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f
+Subproject commit 7907a676ada3a5944cfa3b45e23deda7496767cf
=====================================
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'])
=====================================
testsuite/tests/module/all.T
=====================================
@@ -268,6 +268,7 @@ test('mod181', normal, compile, [''])
test('mod182', normal, compile_fail, [''])
test('mod183', normal, compile_fail, [''])
test('mod184', normal, compile, ['-Wprepositive-qualified-module'])
+test('mod185', normal, compile, ['-ddump-parsed-ast'])
test('T1148', normal, compile, [''])
test('T1074', normal, compile, [''])
=====================================
testsuite/tests/module/mod185.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+-- The span of the import decl should include the 'qualified' keyword.
+import Prelude qualified
+
+main = Prelude.undefined
=====================================
testsuite/tests/module/mod185.stderr
=====================================
@@ -0,0 +1,62 @@
+==================== Parser AST ====================
+
+({ mod185.hs:1:1 }
+ (HsModule
+ (VirtualBraces
+ (1))
+ (Nothing)
+ (Nothing)
+ [({ mod185.hs:3:1-24 }
+ (ImportDecl
+ (NoExtField)
+ (NoSourceText)
+ ({ mod185.hs:3:8-14 }
+ {ModuleName: Prelude})
+ (Nothing)
+ (NotBoot)
+ (False)
+ (QualifiedPost)
+ (False)
+ (Nothing)
+ (Nothing)))]
+ [({ mod185.hs:5:1-24 }
+ (ValD
+ (NoExtField)
+ (FunBind
+ (NoExtField)
+ ({ mod185.hs:5:1-4 }
+ (Unqual
+ {OccName: main}))
+ (MG
+ (NoExtField)
+ ({ mod185.hs:5:1-24 }
+ [({ mod185.hs:5:1-24 }
+ (Match
+ (NoExtField)
+ (FunRhs
+ ({ mod185.hs:5:1-4 }
+ (Unqual
+ {OccName: main}))
+ (Prefix)
+ (NoSrcStrict))
+ []
+ (GRHSs
+ (NoExtField)
+ [({ mod185.hs:5:6-24 }
+ (GRHS
+ (NoExtField)
+ []
+ ({ mod185.hs:5:8-24 }
+ (HsVar
+ (NoExtField)
+ ({ mod185.hs:5:8-24 }
+ (Qual
+ {ModuleName: Prelude}
+ {OccName: undefined}))))))]
+ ({ <no location info> }
+ (EmptyLocalBinds
+ (NoExtField))))))])
+ (FromSource))
+ [])))]
+ (Nothing)
+ (Nothing)))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd6769a1a85481e5e3578a658351061bdc56436...0b1a82db05356ac446c54c5a8c94e6e8cdb0cbe1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd6769a1a85481e5e3578a658351061bdc56436...0b1a82db05356ac446c54c5a8c94e6e8cdb0cbe1
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/20201217/7b13076f/attachment-0001.html>
More information about the ghc-commits
mailing list