[Git][ghc/ghc][wip/int-index/parser-allocations] 3 commits: Bump bytestring submodule to something closer to 0.12.1
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Sat Feb 3 08:05:16 UTC 2024
Vladislav Zavialov pushed to branch wip/int-index/parser-allocations at Glasgow Haskell Compiler / GHC
Commits:
27020458 by Matthew Craven at 2024-02-03T01:53:26-05:00
Bump bytestring submodule to something closer to 0.12.1
...mostly so that 16d6b7e835ffdcf9b894e79f933dd52348dedd0c
(which reworks unaligned writes in Builder) and the stuff in
https://github.com/haskell/bytestring/pull/631 can see wider testing.
The less-terrible code for unaligned writes used in Builder on
hosts not known to be ulaigned-friendly also takes less effort
for GHC to compile, resulting in a metric decrease for T21839c
on some platforms.
The metric increase on T21839r is caused by the unrelated commit
750dac33465e7b59100698a330b44de7049a345c. It perhaps warrants
further analysis and discussion (see #23822) but is not critical.
Metric Decrease:
T21839c
Metric Increase:
T21839r
- - - - -
cdddeb0f by Rodrigo Mesquita at 2024-02-03T01:54:02-05:00
Work around autotools setting C11 standard in CC/CXX
In autoconf >=2.70, C11 is set by default for $CC and $CXX via the
-std=...11 flag. In this patch, we split the "-std" flag out of the $CC
and $CXX variables, which we traditionally assume to be just the
executable name/path, and move it to $CFLAGS/$CXXFLAGS instead.
Fixes #24324
- - - - -
7f13c6b8 by Vladislav Zavialov at 2024-02-03T11:04:45+03:00
Reduce parser allocations in allocateCommentsP
In the most common case, the comment queue is empty, so we can skip the
work of processing it. This reduces allocations by about 10% in the
parsing001 test.
Metric Decrease:
MultiLayerModulesRecomp
parsing001
- - - - -
8 changed files:
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- configure.ac
- libraries/bytestring
- + m4/fp_prog_move_to_flags.m4
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/annotations-literals/all.T
- testsuite/tests/ghci/scripts/T9881.stdout
Changes:
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -3235,6 +3235,7 @@ instance MonadP P where
getBit ext = P $ \s -> let b = ext `xtest` pExtsBitmap (options s)
in b `seq` POk s b
allocateCommentsP ss = P $ \s ->
+ if null (comment_q s) then POk s emptyComments else -- fast path
let (comment_q', newAnns) = allocateComments ss (comment_q s) in
POk s {
comment_q = comment_q'
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -3060,6 +3060,7 @@ instance MonadP PV where
let b = ext `xtest` pExtsBitmap (pv_options ctx) in
PV_Ok acc $! b
allocateCommentsP ss = PV $ \_ s ->
+ if null (pv_comment_q s) then PV_Ok s emptyComments else -- fast path
let (comment_q', newAnns) = allocateComments ss (pv_comment_q s) in
PV_Ok s {
pv_comment_q = comment_q'
=====================================
configure.ac
=====================================
@@ -417,6 +417,9 @@ dnl detect compiler (prefer gcc over clang) and set $CC (unless CC already set),
dnl later CC is copied to CC_STAGE{1,2,3}
AC_PROG_CC([cc gcc clang])
AC_PROG_CXX([g++ clang++ c++])
+# Work around #24324
+MOVE_TO_FLAGS([CC],[CFLAGS])
+MOVE_TO_FLAGS([CXX],[CXXFLAGS])
MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0])
=====================================
libraries/bytestring
=====================================
@@ -1 +1 @@
-Subproject commit 39f40116a4adf8a3296067d64bd00e1a1e5e15bd
+Subproject commit ba6918dbb155c1671ffbda4da7d8efff14e5b8f5
=====================================
m4/fp_prog_move_to_flags.m4
=====================================
@@ -0,0 +1,19 @@
+# MOVE_TO_FLAGS
+# --------------------------------
+# Split off flags from $1 (the compiler) to $2 (the flags).
+# This works around autoconf setting $CC and $CXX to be a program plus the C11
+# `-std=...11` flag (#24324), starting from autotools 2.70.
+AC_DEFUN([MOVE_TO_FLAGS],[
+
+dnl Use IFS=' ' to split off the command from the arguments in $1.
+dnl By expanding $$1, set accounts for quoting correctly, such that splitting
+dnl e.g. '"A B/C" D' results in "A B/C" and "D".
+tmp_IFS="$IFS"
+IFS=' '
+eval set -- $$1
+IFS="$tmp_IFS"
+
+$1="[$]1"
+shift
+$2="[$]@ $$2"
+])
=====================================
testsuite/tests/ghc-api/all.T
=====================================
@@ -1,7 +1,7 @@
setTestOpts(when(arch('wasm32'), run_timeout_multiplier(2)))
test('ghcApi', normal, compile_and_run, ['-package ghc'])
-test('T6145', js_broken(22352), makefile_test, ['T6145'])
+test('T6145', normal, makefile_test, ['T6145'])
test('T8639_api', req_rts_linker,
makefile_test, ['T8639_api'])
test('T8628', req_rts_linker,
=====================================
testsuite/tests/ghc-api/annotations-literals/all.T
=====================================
@@ -1,2 +1,2 @@
-test('literals', [normalise_slashes, extra_files(['LiteralsTest.hs']), js_broken(22352)], makefile_test, ['literals'])
-test('parsed', [extra_files(['LiteralsTest2.hs']), js_broken(22352)], makefile_test, ['parsed'])
+test('literals', [normalise_slashes, extra_files(['LiteralsTest.hs'])], makefile_test, ['literals'])
+test('parsed', [extra_files(['LiteralsTest2.hs'])], makefile_test, ['parsed'])
=====================================
testsuite/tests/ghci/scripts/T9881.stdout
=====================================
@@ -1,7 +1,7 @@
type Data.ByteString.Lazy.ByteString :: *
data Data.ByteString.Lazy.ByteString
= Data.ByteString.Lazy.Internal.Empty
- | Data.ByteString.Lazy.Internal.Chunk {-# UNPACK #-}Data.ByteString.ByteString
+ | Data.ByteString.Lazy.Internal.Chunk {-# UNPACK #-}StrictByteString
Data.ByteString.Lazy.ByteString
-- Defined in ‘Data.ByteString.Lazy.Internal’
instance Monoid Data.ByteString.Lazy.ByteString
@@ -19,19 +19,19 @@ instance Ord Data.ByteString.Lazy.ByteString
type Data.ByteString.ByteString :: *
data Data.ByteString.ByteString
- = bytestring-0.11.4.0:Data.ByteString.Internal.Type.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr
+ = bytestring-0.12.1.0:Data.ByteString.Internal.Type.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr
GHC.Word.Word8)
{-# UNPACK #-}Int
- -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’
+ -- Defined in ‘bytestring-0.12.1.0:Data.ByteString.Internal.Type’
instance Monoid Data.ByteString.ByteString
- -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’
+ -- Defined in ‘bytestring-0.12.1.0:Data.ByteString.Internal.Type’
instance Read Data.ByteString.ByteString
- -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’
+ -- Defined in ‘bytestring-0.12.1.0:Data.ByteString.Internal.Type’
instance Semigroup Data.ByteString.ByteString
- -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’
+ -- Defined in ‘bytestring-0.12.1.0:Data.ByteString.Internal.Type’
instance Show Data.ByteString.ByteString
- -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’
+ -- Defined in ‘bytestring-0.12.1.0:Data.ByteString.Internal.Type’
instance Eq Data.ByteString.ByteString
- -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’
+ -- Defined in ‘bytestring-0.12.1.0:Data.ByteString.Internal.Type’
instance Ord Data.ByteString.ByteString
- -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’
+ -- Defined in ‘bytestring-0.12.1.0:Data.ByteString.Internal.Type’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b21c33d71e7cbb58613bcb74a7a5dcdb64fbdf6...7f13c6b8cca9eed3c5422c239272f6fc478b3ee7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b21c33d71e7cbb58613bcb74a7a5dcdb64fbdf6...7f13c6b8cca9eed3c5422c239272f6fc478b3ee7
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/20240203/21310e05/attachment-0001.html>
More information about the ghc-commits
mailing list