[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: users guide: Fix syntax errors
Marge Bot
gitlab at gitlab.haskell.org
Fri Dec 11 09:27:33 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00
users guide: Fix syntax errors
Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3.
- - - - -
d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00
users guide: Describe GC lifecycle events
Every time I am asked about how to interpret these events I need to
figure it out from scratch. It's well past time that the users guide
properly documents these.
- - - - -
741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00
gitlab-ci: Fix incorrect Docker image for nightly cross job
Also refactor the job definition to eliminate the bug by construction.
- - - - -
19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00
gitlab-ci: Fix name of flavour in ThreadSanitizer job
It looks like I neglected to update this after introduce flavour
transformers.
- - - - -
4336faf4 by Sylvain Henry at 2020-12-11T04:27:22-05:00
Display FFI labels (fix #18539)
- - - - -
cf071848 by Aaron Allen at 2020-12-11T04:27:24-05:00
Elide extraneous messages for :doc command (#15784)
Do not print `<has no documentation>` alongside a valid doc.
Additionally, if two matching symbols lack documentation then the
message will only be printed once. Hence, `<has no documentation>` will
be printed at most once and only if all matching symbols are lacking
docs.
- - - - -
d112fb3d by Aaron Allen at 2020-12-11T04:27:24-05:00
Add :doc test case for duplicate record fields
Tests that the output of the `:doc` command is correct for duplicate
record fields defined using -XDuplicateRecordFields.
- - - - -
11 changed files:
- .gitlab-ci.yml
- compiler/GHC/Types/ForeignCall.hs
- docs/users_guide/eventlog-formats.rst
- docs/users_guide/runtime_control.rst
- docs/users_guide/using-optimisation.rst
- ghc/GHCi/UI.hs
- rts/Stats.c
- testsuite/tests/ghci/scripts/ghci065.hs
- testsuite/tests/ghci/scripts/ghci065.script
- testsuite/tests/ghci/scripts/ghci065.stdout
- testsuite/tests/numeric/should_compile/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -257,27 +257,24 @@ validate-x86_64-linux-deb9-unreg-hadrian:
CONFIGURE_ARGS: --enable-unregisterised
TEST_ENV: "x86_64-linux-deb9-unreg-hadrian"
-validate-x86_64-linux-deb10-hadrian-cross-aarch64:
- <<: *nightly
+.build-x86_64-linux-deb10-hadrian-cross-aarch64:
extends: .validate-linux-hadrian
- stage: full-build
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV"
variables:
BIN_DIST_NAME: "ghc-x86_64-deb9-linux"
- rules:
- - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/'
- variables:
CONFIGURE_ARGS: --with-intree-gmp
CROSS_TARGET: "aarch64-linux-gnu"
+validate-x86_64-linux-deb10-hadrian-cross-aarch64:
+ extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64
+ stage: full-build
+ rules:
+ - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/'
+
nightly-x86_64-linux-deb10-hadrian-cross-aarch64:
<<: *nightly
- extends: .validate-linux-hadrian
+ extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64
stage: full-build
- variables:
- CONFIGURE_ARGS: --with-intree-gmp
- CROSS_TARGET: "aarch64-linux-gnu"
-
############################################################
@@ -712,7 +709,7 @@ nightly-x86_64-linux-deb9-integer-simple:
stage: full-build
variables:
TEST_ENV: "x86_64-linux-deb9-tsan"
- BUILD_FLAVOUR: "thread-sanitizer"
+ BUILD_FLAVOUR: "default+thread_sanitizer"
TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions"
# Haddock is large enough to make TSAN choke without massive quantities of
# memory.
=====================================
compiler/GHC/Types/ForeignCall.hs
=====================================
@@ -206,24 +206,26 @@ instance Outputable CExportSpec where
instance Outputable CCallSpec where
ppr (CCallSpec fun cconv safety)
- = hcat [ whenPprDebug callconv, ppr_fun fun ]
+ = hcat [ whenPprDebug callconv, ppr_fun fun, text " ::" ]
where
callconv = text "{-" <> ppr cconv <> text "-}"
- gc_suf | playSafe safety = text "_GC"
- | otherwise = empty
+ gc_suf | playSafe safety = text "_safe"
+ | otherwise = text "_unsafe"
- ppr_fun (StaticTarget st _fn mPkgId isFun)
- = text (if isFun then "__pkg_ccall"
- else "__pkg_ccall_value")
+ ppr_fun (StaticTarget st lbl mPkgId isFun)
+ = text (if isFun then "__ffi_static_ccall"
+ else "__ffi_static_ccall_value")
<> gc_suf
<+> (case mPkgId of
Nothing -> empty
Just pkgId -> ppr pkgId)
+ <> text ":"
+ <> ppr lbl
<+> (pprWithSourceText st empty)
ppr_fun DynamicTarget
- = text "__dyn_ccall" <> gc_suf <+> text "\"\""
+ = text "__ffi_dyn_ccall" <> gc_suf <+> text "\"\""
-- The filename for a C header file
-- Note [Pragma source text] in GHC.Types.SourceText
=====================================
docs/users_guide/eventlog-formats.rst
=====================================
@@ -207,9 +207,61 @@ Thread and scheduling events
:base-ref:`Control.Concurrent.setThreadLabel`).
+.. _gc-events:
+
Garbage collector events
~~~~~~~~~~~~~~~~~~~~~~~~
+The following events mark various points of the lifecycle of a moving garbage
+collection.
+
+A typical garbage collection will look something like the following:
+
+1. A capability realizes that it needs a garbage collection (e.g. as a result
+ of running out of nursery) and requests a garbage collection. This is
+ marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`.
+
+2. As other capabilities reach yield points and suspend execution they emit
+ :event-type:`STOP_THREAD` events.
+
+3. When all capabilities have suspended execution, collection will begin,
+ marked by a :event-type:`GC_START` event.
+
+4. As individual parallel GC threads commence with scavenging they will emit
+ :event-type:`GC_WORK` events.
+
+5. If a parallel GC thread runs out of work it will emit a
+ :event-type:`GC_IDLE` event. If it is later handed more work it will emit
+ another :event-type:`GC_WORK` event.
+
+6. Eventually when scavenging has finished a :event-type:`GC_DONE` event
+ will be emitted by each GC thread.
+
+7. A bit of book-keeping is performed.
+
+8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle.
+
+9. A :event-type:`HEAP_SIZE` event will be emitted giving the
+ cumulative heap allocations of the program until now.
+
+10. A :event-type:`GC_STATS_GHC` event will be emitted
+ containing various details of the collection and heap state.
+
+11. In the case of a major collection, a
+ :event-type:`HEAP_LIVE` event will be emitted describing
+ the current size of the live on-heap data.
+
+12. In the case of the :ghc-flag:`-threaded` RTS, a
+ :event-type:`SPARK_COUNTERS` event will be emitted giving
+ details on how many sparks have been created, evaluated, and GC'd.
+
+13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD`
+ events.
+
+Note that in the case of the concurrent non-moving collector additional events
+will be emitted during the concurrent phase of collection. These are described
+in :ref:`nonmoving-gc-events`.
+
.. event-type:: GC_START
:tag: 9
@@ -685,6 +737,46 @@ These events mark various stages of the
:rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled
with the ``+RTS -lg`` event-set.
+A typical non-moving collection cycle will look something like the following:
+
+1. The preparatory phase of collection will emit the usual events associated
+ with a moving collection. See :ref:`gc-events` for details.
+
+2. The concurrent write barrier is enabled and the concurrent mark thread is
+ started. From this point forward mutator threads may emit
+ :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have
+ flushed their capability-local update remembered sets.
+
+3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event.
+
+4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted.
+
+5. If necessary (e.g. due to weak pointer marking), the marking process will
+ continue, returning to step (3) above.
+
+6. When the collector has done as much concurrent marking as it can it will
+ enter the post-mark synchronization phase of collection, denoted by a
+ :event-type:`CONC_SYNC_BEGIN` event.
+
+7. Mutator threads will suspend execution and, if necessary, flush their update
+ remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events).
+
+8. The collector will do any final marking necessary (indicated by
+ :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events).
+
+9. The collector will do a small amount of sweeping, disable the write barrier,
+ emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume
+
+10. The collector will begin the concurrent sweep phase, indicated by a
+ :event-type:`CONC_SWEEP_BEGIN` event.
+
+11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be
+ emitted and the concurrent collector thread will terminate.
+
+12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the
+ fragmentation state of the non-moving heap.
+
+
.. event-type:: CONC_MARK_BEGIN
:tag: 200
@@ -742,8 +834,9 @@ with the ``+RTS -lg`` event-set.
Non-moving heap census
~~~~~~~~~~~~~~~~~~~~~~
-The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are
-intended to provide insight into fragmentation of the non-moving heap.
+The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l ⟨flags⟩>`
+event-set) are intended to provide insight into fragmentation of the non-moving
+heap.
.. event-type:: NONMOVING_HEAP_CENSUS
@@ -760,8 +853,8 @@ Ticky counters
~~~~~~~~~~~~~~
Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked
-with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the
-eventlog.
+with :rts-flag:`+RTS -lT <-l ⟨flags⟩>` will emit periodic samples of the ticky
+entry counters to the eventlog.
.. event-type:: TICKY_COUNTER_DEF
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option
- ``f`` — parallel sparks (fully accurate). Disabled by default.
+ - ``T`` — :ghc-flag:`ticky-ticky profiler <-ticky>` events. Disabled by
+ default.
+
- ``u`` — user events. These are events emitted from Haskell code using
functions such as ``Debug.Trace.traceEvent``. Enabled by default.
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``.
This is the full syntax for cardinalities, demands and sub-demands in BNF:
- .. code-block::
+ .. code-block:: none
- card ::= B | A | 1 | U | S | M semantics as in the table above
+ card ::= B | A | 1 | U | S | M semantics as in the table above
- d ::= card sd card = how often, sd = how deep
- | card abbreviation: Same as "card card"
+ d ::= card sd card = how often, sd = how deep
+ | card abbreviation: Same as "card card"
- sd ::= card polymorphic sub-demand, card at every level
- | P(d,d,..) product sub-demand
- | Ccard(sd) call sub-demand
+ sd ::= card polymorphic sub-demand, card at every level
+ | P(d,d,..) product sub-demand
+ | Ccard(sd) call sub-demand
For example, ``fst`` is strict in its argument, and also in the first
component of the argument. It will not evaluate the argument's second
@@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``.
We summarise a function's demand properties in its *demand signature*.
This is the general syntax:
- .. code-block::
+ .. code-block:: none
- {x->dx,y->dy,z->dz...}<d1><d2><d3>...<dn>div
- ^ ^ ^ ^ ^ ^
- | | | | | |
- | \---+---+------/ |
- | | |
- demand on free demand on divergence
- variables arguments information
- (omitted if empty) (omitted if
- no information)
+ {x->dx,y->dy,z->dz...}<d1><d2><d3>...<dn>div
+ ^ ^ ^ ^ ^ ^
+ | | | | | |
+ | \---+---+------/ |
+ | | |
+ demand on free demand on divergence
+ variables arguments information
+ (omitted if empty) (omitted if
+ no information)
We summarise ``fst``'s demand properties in its *demand signature*
``<SP(SU,A)>``, which just says "If ``fst`` is applied to one argument,
@@ -1260,13 +1260,11 @@ by saying ``-fno-wombat``.
**Call sub-demands**
- Consider ``maybe``:
+ Consider ``maybe``: ::
- .. code-block::
-
- maybe :: b -> (a -> b) -> Maybe a -> b
- maybe n _ Nothing = n
- maybe _ s (Just a) = s a
+ maybe :: b -> (a -> b) -> Maybe a -> b
+ maybe n _ Nothing = n
+ maybe _ s (Just a) = s a
We give it demand signature ``<U><1C1(U)><SU>``. The ``C1(U)`` is a *call
sub-demand* that says "Called at most once, where the result is used
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -1791,22 +1791,32 @@ docCmd "" =
docCmd s = do
-- TODO: Maybe also get module headers for module names
names <- GHC.parseName s
- e_docss <- mapM GHC.getDocs names
- sdocs <- mapM (either handleGetDocsFailure (pure . pprDocs)) e_docss
+ e_docss <- sequence <$> mapM GHC.getDocs names
+ sdocs <- either handleGetDocsFailure (pure . pprDocs) e_docss
let sdocs' = vcat (intersperse (text "") sdocs)
unqual <- GHC.getPrintUnqual
dflags <- getDynFlags
(liftIO . putStrLn . showSDocForUser dflags unqual) sdocs'
+pprDocs :: [(Maybe HsDocString, Map Int HsDocString)] -> [SDoc]
+pprDocs docs
+ | null nonEmptyDocs = pprDoc <$> take 1 docs
+ -- elide <has no documentation> if there's at least one non-empty doc (#15784)
+ | otherwise = pprDoc <$> nonEmptyDocs
+ where
+ empty (mb_decl_docs, arg_docs)
+ = isNothing mb_decl_docs && null arg_docs
+ nonEmptyDocs = filter (not . empty) docs
+
-- TODO: also print arg docs.
-pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc
-pprDocs (mb_decl_docs, _arg_docs) =
+pprDoc :: (Maybe HsDocString, Map Int HsDocString) -> SDoc
+pprDoc (mb_decl_docs, _arg_docs) =
maybe
(text "<has no documentation>")
(text . unpackHDS)
mb_decl_docs
-handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc
+handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m [SDoc]
handleGetDocsFailure no_docs = do
dflags <- getDynFlags
let msg = showPpr dflags no_docs
=====================================
rts/Stats.c
=====================================
@@ -570,7 +570,7 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s
// Emit events to the event log
// Has to be emitted while all caps stopped for GC, but before GC_END.
- // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents
+ // See https://gitlab.haskell.org/ghc/ghc/-/wikis/RTSsummaryEvents
// for a detailed design rationale of the current setup
// of GC eventlog events.
traceEventGcGlobalSync(cap);
=====================================
testsuite/tests/ghci/scripts/ghci065.hs
=====================================
@@ -5,6 +5,7 @@
-- this test is constructed with simple text (without markup) only.
--
+{-# LANGUAGE DuplicateRecordFields #-}
module Test where
-- | This is the haddock comment of a data declaration for Data1.
@@ -13,6 +14,25 @@ data Data1 = Val1a | Val1b
data Data2 = Val2a -- ^ This is the haddock comment of a data value for Val2a
| Val2b -- ^ This is the haddock comment of a data value for Val2b
+-- | This is the haddock comment of a data declaration for Data3.
+newtype Data3 =
+ Data3 { getData3 :: Int }
+
+newtype Data4 =
+ -- | This is the haddock comment of a data constructor for Data4.
+ Data4 { getData4 :: Int }
+
+data DupeFields1 =
+ DF1 { dupeField :: Int -- ^ This is the first haddock comment of a duplicate record field.
+ }
+
+data DupeFields2 =
+ DF2 { dupeField :: Int -- ^ This is the second haddock comment of a duplicate record field.
+ }
+
+data DupeFields3 =
+ DF3 { dupeField :: Int -- No haddock
+ }
-- | This is the haddock comment of a function declaration for func1.
func1 :: Int -> Int -> Int
=====================================
testsuite/tests/ghci/scripts/ghci065.script
=====================================
@@ -5,6 +5,9 @@
:doc Data1
:doc Val2a
:doc Val2b
+:doc Data3
+:doc Data4
+:doc dupeField
:doc func1
:doc func2
=====================================
testsuite/tests/ghci/scripts/ghci065.stdout
=====================================
@@ -1,6 +1,11 @@
This is the haddock comment of a data declaration for Data1.
This is the haddock comment of a data value for Val2a
This is the haddock comment of a data value for Val2b
+ This is the haddock comment of a data declaration for Data3.
+ This is the haddock comment of a data constructor for Data4.
+ This is the second haddock comment of a duplicate record field.
+
+ This is the first haddock comment of a duplicate record field.
This is the haddock comment of a function declaration for func1.
<has no documentation>
This is the haddock comment of a function declaration for func3.
=====================================
testsuite/tests/numeric/should_compile/all.T
=====================================
@@ -8,4 +8,4 @@ test('T7881', normal, compile, [''])
# desugaring, so we don't get the warning we expect.
test('T8542', omit_ways(['hpc']), compile, [''])
test('T10929', normal, compile, [''])
-test('T16402', [ grep_errmsg(r'and') ], compile, [''])
+test('T16402', [ grep_errmsg(r'and'), when(wordsize(32), expect_broken(19024)) ], compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6acfc525611463525587a0af5cf591c6fdbe8cf1...d112fb3dbd8519b33bfb3cea22000022f68169d4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6acfc525611463525587a0af5cf591c6fdbe8cf1...d112fb3dbd8519b33bfb3cea22000022f68169d4
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/20201211/43e9b93e/attachment-0001.html>
More information about the ghc-commits
mailing list