[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Turn on -XMonoLocalBinds by default (#18430)
Marge Bot
gitlab at gitlab.haskell.org
Thu Sep 3 16:31:51 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00
Turn on -XMonoLocalBinds by default (#18430)
And fix the resulting type errors.
Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com>
Metric Decrease:
parsing001
- - - - -
c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00
Remove potential space leak from Data.List.transpose
Previously, `transpose` produced a list of heads
and a list of tails independently. This meant that
a function using only some heads, and only some tails,
could potentially leak space. Use `unzip` to work
around the problem by producing pairs and selector
thunks instead. Time and allocation behavior will
be worse, but there should be no more leak potential.
- - - - -
ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00
Remove outdated note
- - - - -
85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00
Bignum: add missing compat import/export functions
- - - - -
63c66c41 by Ben Gamari at 2020-09-03T12:31:42-04:00
configure: Work around Raspbian's silly packaging decisions
See #17856.
- - - - -
b86cf1a8 by Kathryn Spiers at 2020-09-03T12:31:43-04:00
expected-undocumented-flags remove kill flags
It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7
and can safely be removed here
- - - - -
12 changed files:
- aclocal.m4
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Runtime/Linker.hs
- compiler/GHC/SysTools.hs
- compiler/ghc.cabal.in
- docs/users_guide/expected-undocumented-flags.txt
- libraries/base/Data/OldList.hs
- libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
Changes:
=====================================
aclocal.m4
=====================================
@@ -447,25 +447,40 @@ AC_DEFUN([GET_ARM_ISA],
#endif]
)],
[AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7])
- ARM_ISA=ARMv6
- AC_COMPILE_IFELSE([
- AC_LANG_PROGRAM(
- [],
- [#if defined(__VFP_FP__)
- return 0;
- #else
- no vfp
- #endif]
- )],
- [changequote(, )dnl
- ARM_ISA_EXT="[VFPv2]"
- changequote([, ])dnl
- ],
- [changequote(, )dnl
- ARM_ISA_EXT="[]"
- changequote([, ])dnl
- ]
- )],
+ if grep -q Raspbian /etc/issue && uname -m | grep -q armv7; then
+ # Raspbian unfortunately makes some extremely questionable
+ # packaging decisions, configuring gcc to compile for ARMv6
+ # despite the fact that the RPi4 is ARMv8. As ARMv8 doesn't
+ # support all instructions supported by ARMv6 this can
+ # break. Work around this by checking uname to verify
+ # that we aren't running on armv7.
+ # See #17856.
+ AC_MSG_NOTICE([Found compiler which claims to target ARMv6 running on ARMv7, assuming this is ARMv7 on Raspbian (see T17856)])
+ ARM_ISA=ARMv7
+ changequote(, )dnl
+ ARM_ISA_EXT="[VFPv2]"
+ changequote([, ])dnl
+ else
+ ARM_ISA=ARMv6
+ AC_COMPILE_IFELSE([
+ AC_LANG_PROGRAM(
+ [],
+ [#if defined(__VFP_FP__)
+ return 0;
+ #else
+ no vfp
+ #endif]
+ )],
+ [changequote(, )dnl
+ ARM_ISA_EXT="[VFPv2]"
+ changequote([, ])dnl
+ ],
+ [changequote(, )dnl
+ ARM_ISA_EXT="[]"
+ changequote([, ])dnl
+ ]
+ )
+ fi],
[changequote(, )dnl
ARM_ISA=ARMv7
ARM_ISA_EXT="[VFPv3,NEON]"
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -116,35 +116,6 @@ known keys. See
Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)
in GHC.Builtin.Types.
-Note [The integer library]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Clearly, we need to know the names of various definitions of the integer
-library, e.g. the type itself, `mkInteger` etc. But there are two possible
-implementations of the integer library:
-
- * integer-gmp (fast, but uses libgmp, which may not be available on all
- targets and is GPL licensed)
- * integer-simple (slow, but pure Haskell and BSD-licensed)
-
-We want the compiler to work with either one. The way we achieve this is:
-
- * When compiling the integer-{gmp,simple} library, we pass
- -this-unit-id integer-wired-in
- to GHC (see the cabal file libraries/integer-{gmp,simple}.
- * This way, GHC can use just this UnitID (see Module.integerUnitId) when
- generating code, and the linker will succeed.
-
-Unfortuately, the abstraction is not complete: When using integer-gmp, we
-really want to use the S# constructor directly. This is controlled by
-the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use
-this constructor directly (see CorePrep.lookupIntegerSDataConName)
-
-When GHC reads the package data base, it (internally only) pretends it has UnitId
-`integer-wired-in` instead of the actual UnitId (which includes the version
-number); just like for `base` and other packages, as described in
-Note [Wired-in units] in GHC.Unit.Module. This is done in
-GHC.Unit.State.findWiredInUnits.
-}
{-# LANGUAGE CPP #-}
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -205,7 +205,7 @@ regAlloc _ (CmmProc _ _ _ _)
-- an entry in the block map or it is the first block.
--
linearRegAlloc
- :: Instruction instr
+ :: forall instr. Instruction instr
=> NCGConfig
-> [BlockId] -- ^ entry points
-> BlockMap RegSet
@@ -231,6 +231,8 @@ linearRegAlloc config entry_ids block_live sccs
ArchJavaScript -> panic "linearRegAlloc ArchJavaScript"
ArchUnknown -> panic "linearRegAlloc ArchUnknown"
where
+ go :: (FR regs, Outputable regs)
+ => regs -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)
go f = linearRegAlloc' config f entry_ids block_live sccs
platform = ncgPlatform config
@@ -973,4 +975,3 @@ loadTemp vreg (ReadMem slot) hreg spills
loadTemp _ _ _ spills =
return spills
-
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -2290,6 +2290,7 @@ lintCoercion this@(AxiomRuleCo ax cos)
Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ]
Just _ -> return (AxiomRuleCo ax cos') }
where
+ err :: forall a. String -> [SDoc] -> LintM a
err m xs = failWithL $
hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs)
=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -1909,7 +1909,7 @@ completeCall env var cont
log_inlining $
sep [text "Inlining done:", nest 4 (ppr var)]
| otherwise
- = liftIO $ log_inlining $
+ = log_inlining $
sep [text "Inlining done: " <> ppr var,
nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding),
text "Cont: " <+> ppr cont])]
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1373,7 +1373,8 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup
--
-- There better had not be any cyclic groups here -- we check for them.
upsweep
- :: GhcMonad m
+ :: forall m
+ . GhcMonad m
=> Maybe Messager
-> HomePackageTable -- ^ HPT from last time round (pruned)
-> StableModules -- ^ stable modules (see checkStability)
@@ -1415,8 +1416,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
return (Failed, done')
upsweep'
- :: GhcMonad m
- => HomePackageTable
+ :: HomePackageTable
-> ModuleGraph
-> [SCC ModSummary]
-> Int
=====================================
compiler/GHC/Runtime/Linker.hs
=====================================
@@ -1134,6 +1134,7 @@ unload_wkr hsc_env keep_linkables pls at PersistentLinkerState{..} = do
-- Note that we want to remove all *local*
-- (i.e. non-isExternal) names too (these are the
-- temporary bindings from the command line).
+ keep_name :: (Name, a) -> Bool
keep_name (n,_) = isExternalName n &&
nameModule n `elemModuleSet` bcos_retained
=====================================
compiler/GHC/SysTools.hs
=====================================
@@ -138,15 +138,17 @@ lazyInitLlvmConfig :: String
-> IO LlvmConfig
lazyInitLlvmConfig top_dir
= unsafeInterleaveIO $ do -- see Note [LLVM configuration]
- targets <- readAndParse "llvm-targets" mkLlvmTarget
- passes <- readAndParse "llvm-passes" id
- return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes }
+ targets <- readAndParse "llvm-targets"
+ passes <- readAndParse "llvm-passes"
+ return $ LlvmConfig { llvmTargets = fmap mkLlvmTarget <$> targets,
+ llvmPasses = passes }
where
- readAndParse name builder =
+ readAndParse :: Read a => String -> IO a
+ readAndParse name =
do let llvmConfigFile = top_dir </> name
llvmConfigStr <- readFile llvmConfigFile
case maybeReadFuzzy llvmConfigStr of
- Just s -> return (fmap builder <$> s)
+ Just s -> return s
Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile)
mkLlvmTarget :: (String, String, String) -> LlvmTarget
=====================================
compiler/ghc.cabal.in
=====================================
@@ -153,6 +153,7 @@ Library
NoImplicitPrelude
,BangPatterns
,ScopedTypeVariables
+ ,MonoLocalBinds
Exposed-Modules:
GHC.Iface.Ext.Types
=====================================
docs/users_guide/expected-undocumented-flags.txt
=====================================
@@ -101,8 +101,6 @@
-fimplicit-params
-fimplicit-prelude
-firrefutable-tuples
--fkill-absence
--fkill-one-shot
-fmax-errors
-fmax-pmcheck-iterations
-fmono-pat-binds
=====================================
libraries/base/Data/OldList.hs
=====================================
@@ -550,7 +550,13 @@ intercalate xs xss = concat (intersperse xs xss)
transpose :: [[a]] -> [[a]]
transpose [] = []
transpose ([] : xss) = transpose xss
-transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
+transpose ((x:xs) : xss) = (x : hds) : transpose (xs : tls)
+ where
+ -- We tie the calculations of heads and tails together
+ -- to prevent heads from leaking into tails and vice versa.
+ -- unzip makes the selector thunk arrangements we need to
+ -- ensure everything gets cleaned up properly.
+ (hds, tls) = unzip [(hd, tl) | (hd:tl) <- xss]
-- | The 'partition' function takes a predicate a list and returns
=====================================
libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
=====================================
@@ -57,9 +57,6 @@ module GHC.Integer.GMP.Internals
, bigNatToInt
, bigNatToWord
, indexBigNat#
- , importBigNatFromByteArray
- , exportBigNatToMutableByteArray
-
-- ** 'BigNat' arithmetic operations
, plusBigNat
@@ -112,9 +109,17 @@ module GHC.Integer.GMP.Internals
-- ** Export
, exportBigNatToAddr
+ , exportIntegerToAddr
+
+ , exportBigNatToMutableByteArray
+ , exportIntegerToMutableByteArray
-- ** Import
, importBigNatFromAddr
+ , importIntegerFromAddr
+
+ , importBigNatFromByteArray
+ , importIntegerFromByteArray
) where
import GHC.Integer
@@ -373,6 +378,18 @@ exportBigNatToAddr (BN# b) addr endian = IO \s ->
case B.bigNatToAddr# b addr endian s of
(# s', w #) -> (# s', W# w #)
+{-# DEPRECATED importIntegerFromAddr "Use integerFromAddr# instead" #-}
+importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer
+importIntegerFromAddr addr sz endian = IO \s ->
+ case I.integerFromAddr# sz addr endian s of
+ (# s', i #) -> (# s', i #)
+
+{-# DEPRECATED exportIntegerToAddr "Use integerToAddr# instead" #-}
+exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word
+exportIntegerToAddr i addr endian = IO \s ->
+ case I.integerToAddr# i addr endian s of
+ (# s', w #) -> (# s', W# w #)
+
wordToBigNat :: Word# -> BigNat
wordToBigNat w = BN# (B.bigNatFromWord# w)
@@ -398,3 +415,13 @@ importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray#
exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of
(# s', r #) -> (# s', W# r #))
+
+{-# DEPRECATED importIntegerFromByteArray "Use integerFromByteArray# instead" #-}
+importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
+importIntegerFromByteArray ba off sz endian = case runRW# (I.integerFromByteArray# sz ba off endian) of
+ (# _, r #) -> r
+
+{-# DEPRECATED exportIntegerToMutableByteArray "Use integerToMutableByteArray# instead" #-}
+exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
+exportIntegerToMutableByteArray i mba off endian = IO (\s -> case I.integerToMutableByteArray# i mba off endian s of
+ (# s', r #) -> (# s', W# r #))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab44b2abcbbf85c681f0e578b6dffe20efbe2e98...b86cf1a85c4069707753f1799b83269e26dbfe14
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab44b2abcbbf85c681f0e578b6dffe20efbe2e98...b86cf1a85c4069707753f1799b83269e26dbfe14
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/20200903/7b4e24fa/attachment-0001.html>
More information about the ghc-commits
mailing list