[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: EPA: Remove unused hsCaseAnnsRest
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Oct 7 09:49:53 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
4a2f0f13 by Alan Zimmerman at 2024-10-07T05:16:54-04:00
EPA: Remove unused hsCaseAnnsRest
We never populate it, so remove it.
- - - - -
5099057b by John Paul Adrian Glaubitz at 2024-10-07T05:17:40-04:00
rts: Fix invocation of __ieee_set_fp_control() on alpha-linux
Fixes the following error when building GHC on alpha-linux:
rts/posix/Signals.c: In function ‘initDefaultHandlers’:
rts/posix/Signals.c:709:5: error:
error: implicit declaration of function ‘ieee_set_fp_control’ [-Wimplicit-function-declaration]
709 | ieee_set_fp_control(0);
| ^~~~~~~~~~~~~~~~~~~
|
709 | ieee_set_fp_control(0);
|
- - - - -
c9590ba0 by Teo Camarasu at 2024-10-07T05:18:17-04:00
Add changelog entries for !12479
- - - - -
822ab964 by Matthew Pickering at 2024-10-07T05:49:17-04:00
javascript: Read fields of ObjectBlock lazily
When linking a module with a large dependency footprint too much of the
object files were forced during linking. This lead to a large amount of
memory taken up by thunks which would never be forced
On the PartialDownsweep test this halves the memory required (from 25G
to 13G).
Towards #25324
-------------------------
Metric Increase:
size_hello_obj
-------------------------
- - - - -
57b540e0 by Matthew Pickering at 2024-10-07T05:49:18-04:00
ci: Run the i386 validation job when i386 label is set
This is helpful when making changes to base and must update the
javascript and i386 base exports files.
- - - - -
f2eda0b2 by Matthew Pickering at 2024-10-07T05:49:19-04:00
Rewrite partitionByWorkerSize to avoid pattern match checker bug
With `-g3` the pattern match checker would warn about these incomplete
patterns. This affects the debug_info builds on CI.
```
Pattern match(es) are non-exhaustive
In an equation for ‘go’:
Patterns of type ‘[a]’, ‘[a]’, ‘[SpecFailWarning]’ not matched:
(_:_) _ _
|
2514 | go [] small warnings = (small, warnings)
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
```
Workaround for #25338
- - - - -
12 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Parser.y
- compiler/GHC/StgToJS/Object.hs
- compiler/GHC/StgToJS/Types.hs
- libraries/base/changelog.md
- libraries/template-haskell/changelog.md
- rts/posix/Signals.c
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -631,6 +631,7 @@ data ValidateRule =
| NonmovingGc -- ^ Run this job when the "non-moving GC" label is set.
| IpeData -- ^ Run this job when the "IPE" label is set
| TestPrimops -- ^ Run this job when "test-primops" label is set
+ | I386Backend -- ^ Run this job when the "i386" label is set
deriving (Show, Enum, Bounded, Ord, Eq)
-- A constant evaluating to True because gitlab doesn't support "true" in the
@@ -678,6 +679,7 @@ validateRuleString FreeBSDLabel = labelString "FreeBSD"
validateRuleString NonmovingGc = labelString "non-moving GC"
validateRuleString IpeData = labelString "IPE"
validateRuleString TestPrimops = labelString "test-primops"
+validateRuleString I386Backend = labelString "i386"
-- | A 'Job' is the description of a single job in a gitlab pipeline. The
-- job contains all the information about how to do the build but can be further
@@ -1055,7 +1057,7 @@ debian_aarch64 =
debian_i386 :: [JobGroup Job]
debian_i386 =
[ disableValidate (standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla))
- , standardBuildsWithConfig I386 (Linux Debian12) (splitSectionsBroken vanilla)
+ , addValidateRule I386Backend (standardBuildsWithConfig I386 (Linux Debian12) (splitSectionsBroken vanilla))
]
ubuntu_x86 :: [JobGroup Job]
=====================================
.gitlab/jobs.yaml
=====================================
@@ -227,7 +227,7 @@
],
"rules": [
{
- "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*i386.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -2512,13 +2512,11 @@ callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls
partitionByWorkerSize worker_size pats = go pats [] []
where
go [] small warnings = (small, warnings)
- go (p:ps) small warnings
- | WorkerSmallEnough <- worker_size p
- = go ps (p:small) warnings
- | WorkerTooLarge <- worker_size p
- = go ps small warnings
- | WorkerTooLargeForced name <- worker_size p
- = go ps small (SpecFailForcedArgCount name : warnings)
+ go (p:ps) small warnings =
+ case worker_size p of
+ WorkerSmallEnough -> go ps (p:small) warnings
+ WorkerTooLarge -> go ps small warnings
+ WorkerTooLargeForced name -> go ps small (SpecFailForcedArgCount name : warnings)
trim_pats :: ScEnv -> Id -> SpecInfo -> [CallPat] -> (Bool, [CallPat])
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -202,11 +202,10 @@ type instance XUntypedBracket GhcTc = HsBracketTc
data EpAnnHsCase = EpAnnHsCase
{ hsCaseAnnCase :: EpaLocation
, hsCaseAnnOf :: EpaLocation
- , hsCaseAnnsRest :: [AddEpAnn]
} deriving Data
instance NoAnn EpAnnHsCase where
- noAnn = EpAnnHsCase noAnn noAnn noAnn
+ noAnn = EpAnnHsCase noAnn noAnn
data EpAnnUnboundVar = EpAnnUnboundVar
{ hsUnboundBackquotes :: (EpaLocation, EpaLocation)
=====================================
compiler/GHC/Parser.y
=====================================
@@ -3042,7 +3042,7 @@ aexp :: { ECP }
return $ ECP $
$4 >>= \ $4 ->
mkHsCasePV (comb3 $1 $3 $4) $2 $4
- (EpAnnHsCase (glAA $1) (glAA $3) []) }
+ (EpAnnHsCase (glAA $1) (glAA $3)) }
-- QualifiedDo.
| DO stmtlist {% do
hintQualifiedDo $1
=====================================
compiler/GHC/StgToJS/Object.hs
=====================================
@@ -255,23 +255,23 @@ instance Outputable ExportedFun where
-- index
putObjBlock :: WriteBinHandle -> ObjBlock -> IO ()
putObjBlock bh (ObjBlock _syms b c d e f g) = do
- put_ bh b
- put_ bh c
+ lazyPut bh b
+ lazyPut bh c
lazyPut bh d
- put_ bh e
- put_ bh f
- put_ bh g
+ lazyPut bh e
+ lazyPut bh f
+ lazyPut bh g
-- | Read an ObjBlock and associate it to the given symbols (that must have been
-- read from the index)
getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock
getObjBlock syms bh = do
- b <- get bh
- c <- get bh
+ b <- lazyGet bh
+ c <- lazyGet bh
d <- lazyGet bh
- e <- get bh
- f <- get bh
- g <- get bh
+ e <- lazyGet bh
+ f <- lazyGet bh
+ g <- lazyGet bh
pure $ ObjBlock
{ oiSymbols = syms
, oiClInfo = b
=====================================
compiler/GHC/StgToJS/Types.hs
=====================================
@@ -312,13 +312,13 @@ data LinkableUnit = LinkableUnit
-- | one toplevel block in the object file
data ObjBlock = ObjBlock
- { oiSymbols :: ![FastString] -- ^ toplevel symbols (stored in index)
- , oiClInfo :: ![ClosureInfo] -- ^ closure information of all closures in block
- , oiStatic :: ![StaticInfo] -- ^ static closure data
+ { oiSymbols :: [FastString] -- ^ toplevel symbols (stored in index)
+ , oiClInfo :: [ClosureInfo] -- ^ closure information of all closures in block
+ , oiStatic :: [StaticInfo] -- ^ static closure data
, oiStat :: Sat.JStat -- ^ the code
- , oiRaw :: !BS.ByteString -- ^ raw JS code
- , oiFExports :: ![ExpFun]
- , oiFImports :: ![ForeignJSRef]
+ , oiRaw :: BS.ByteString -- ^ raw JS code
+ , oiFExports :: [ExpFun]
+ , oiFImports :: [ForeignJSRef]
}
data ExpFun = ExpFun
=====================================
libraries/base/changelog.md
=====================================
@@ -34,6 +34,7 @@
the context since it will be redundant. These functions are mostly useful
for libraries that define exception-handling combinators like `catch` and
`onException`, such as `base`, or the `exceptions` package.
+ * Move `Lift ByteArray` and `Lift Fixed` instances into `base` from `template-haskell`. See [CLC proposal #287](https://github.com/haskell/core-libraries-committee/issues/287).
## 4.20.0.0 May 2024
* Shipped with GHC 9.10.1
=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -4,6 +4,7 @@
* Extend `Exp` with `ForallE`, `ForallVisE`, `ConstraintedE`,
introduce functions `forallE`, `forallVisE`, `constraintedE` (GHC Proposal #281).
+ * `template-haskell` is no longer wired-in. All wired-in identifiers have been moved to `ghc-internal`.
## 2.22.1.0
=====================================
rts/posix/Signals.c
=====================================
@@ -27,7 +27,7 @@
#if defined(alpha_HOST_ARCH)
# if defined(linux_HOST_OS)
-# include <asm/fpu.h>
+# include <fenv.h>
# else
# include <machine/fpu.h>
# endif
@@ -721,7 +721,11 @@ initDefaultHandlers(void)
#endif
#if defined(alpha_HOST_ARCH)
+# if defined(linux_HOST_OS)
+ __ieee_set_fp_control(0);
+# else
ieee_set_fp_control(0);
+# endif
#endif
// ignore SIGPIPE; see #1619
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -2170,8 +2170,7 @@
(HsCase
(EpAnnHsCase
(EpaSpan { DumpSemis.hs:37:3-6 })
- (EpaSpan { DumpSemis.hs:37:10-11 })
- [])
+ (EpaSpan { DumpSemis.hs:37:10-11 }))
(L
(EpAnn
(EpaSpan { DumpSemis.hs:37:8 })
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1211,7 +1211,6 @@ laiElseSemi k parent = fmap (\new -> parent { aiElseSemi = new })
-- data EpAnnHsCase = EpAnnHsCase
-- { hsCaseAnnCase :: EpaLocation
-- , hsCaseAnnOf :: EpaLocation
--- , hsCaseAnnsRest :: [AddEpAnn]
-- } deriving Data
lhsCaseAnnCase :: Lens EpAnnHsCase EpaLocation
@@ -1222,10 +1221,6 @@ lhsCaseAnnOf :: Lens EpAnnHsCase EpaLocation
lhsCaseAnnOf k parent = fmap (\new -> parent { hsCaseAnnOf = new })
(k (hsCaseAnnOf parent))
-lhsCaseAnnsRest :: Lens EpAnnHsCase [AddEpAnn]
-lhsCaseAnnsRest k parent = fmap (\new -> parent { hsCaseAnnsRest = new })
- (k (hsCaseAnnsRest parent))
-
-- ---------------------------------------------------------------------
-- data HsRuleAnn
@@ -3161,11 +3156,8 @@ instance ExactPrint (HsExpr GhcPs) where
an0 <- markLensKw an lhsCaseAnnCase AnnCase
e' <- markAnnotated e
an1 <- markLensKw an0 lhsCaseAnnOf AnnOf
- an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC
- an3 <- markEpAnnAllL' an2 lhsCaseAnnsRest AnnSemi
alts' <- setLayoutBoth $ markAnnotated alts
- an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC
- return (HsCase an4 e' alts')
+ return (HsCase an1 e' alts')
exact (HsIf an e1 e2 e3) = do
an0 <- markLensKw an laiIf AnnIf
@@ -3635,11 +3627,8 @@ instance ExactPrint (HsCmd GhcPs) where
an0 <- markLensKw an lhsCaseAnnCase AnnCase
e' <- markAnnotated e
an1 <- markLensKw an0 lhsCaseAnnOf AnnOf
- an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC
- an3 <- markEpAnnAllL' an2 lhsCaseAnnsRest AnnSemi
alts' <- markAnnotated alts
- an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC
- return (HsCmdCase an4 e' alts')
+ return (HsCmdCase an1 e' alts')
exact (HsCmdIf an a e1 e2 e3) = do
an0 <- markLensKw an laiIf AnnIf
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99bd564f21429c03603755b792ce840aaa0022cd...f2eda0b22fd3ba08812a3f68e7e4fc4abe71d186
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99bd564f21429c03603755b792ce840aaa0022cd...f2eda0b22fd3ba08812a3f68e7e4fc4abe71d186
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/20241007/723e368e/attachment-0001.html>
More information about the ghc-commits
mailing list