[Git][ghc/ghc][wip/refactor-demand] Update user's guide entry on demand analysis and worker/wrapper
Sebastian Graf
gitlab at gitlab.haskell.org
Tue Nov 10 12:22:14 UTC 2020
Sebastian Graf pushed to branch wip/refactor-demand at Glasgow Haskell Compiler / GHC
Commits:
c70b5613 by Sebastian Graf at 2020-11-10T13:20:04+01:00
Update user's guide entry on demand analysis and worker/wrapper
The demand signature notation has been undocumented for a long time.
The only source to understand it, apart from reading the `Outputable`
instance, has been an outdated wiki page.
Since the previous commits have reworked the demand lattice, I took
it as an opportunity to also write some documentation about notation.
- - - - -
4 changed files:
- docs/users_guide/9.2.1-notes.rst
- docs/users_guide/debugging.rst
- docs/users_guide/exts/instances.rst
- docs/users_guide/using-optimisation.rst
Changes:
=====================================
docs/users_guide/9.2.1-notes.rst
=====================================
@@ -44,7 +44,7 @@ Compiler
Code using ``Void#`` now has to enable :extension:`UnboxedTuples`.
``ghc`` library
-~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~
- The ``con_args`` field of ``ConDeclGADT`` has been renamed to ``con_g_args``.
This is because the type of ``con_g_args`` is now different from the type of
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -334,16 +334,22 @@ subexpression elimination pass.
its rationale.
.. ghc-flag:: -ddump-stranal
- :shortdesc: Dump strictness analyser output
+ :shortdesc: Dump demand analysis output
:type: dynamic
- Dump strictness analyser output
+ Dump demand analysis output.
+
+ See :ghc-flag:`-fstrictness` for the syntax and semantics of demand
+ annotations.
.. ghc-flag:: -ddump-str-signatures
- :shortdesc: Dump strictness signatures
+ :shortdesc: Dump top-level demand signatures
:type: dynamic
- Dump strictness signatures
+ Dump top-level demand signatures as produced by demand analysis.
+
+ See :ghc-flag:`-fstrictness` for the syntax and semantics of demand
+ annotations.
.. ghc-flag:: -ddump-cpranal
:shortdesc: Dump CPR analysis output
@@ -381,7 +387,6 @@ subexpression elimination pass.
Dump output of Core preparation pass
-
STG representation
~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/exts/instances.rst
=====================================
@@ -147,7 +147,7 @@ Where:
``(forall a. a)`` and ``(Eq a => a)`` are legal.
- ``ctype`` is a ``btype`` that has no restrictions on an outermost
``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``\s.
-- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``\s
+- ``arg_type`` is a type that is not allowed to have ``forall``\s or ``=>``\s
- ``prefix_cls_tycon`` is a class type constructor written prefix (e.g.,
``Show`` or ``(&&&)``), while ``infix_cls_tycon`` is a class type constructor
written infix (e.g., ``\`Show\``` or ``&&&``).
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -1125,7 +1125,7 @@ by saying ``-fno-wombat``.
available parameter registers on x86_64.
.. ghc-flag:: -fstrictness
- :shortdesc: Turn on strictness analysis.
+ :shortdesc: Turn on demand analysis.
Implied by :ghc-flag:`-O`. Implies :ghc-flag:`-fworker-wrapper`
:type: dynamic
:reverse: -fno-strictness
@@ -1133,23 +1133,147 @@ by saying ``-fno-wombat``.
:default: on
- Switch on the strictness analyser. The implementation is described in the
- paper `Theory and Practice of Demand Analysis in Haskell
- <https://www.microsoft.com/en-us/research/wp-content/uploads/2017/03/demand-jfp-draft.pdf>`__.
-
- The strictness analyser figures out when arguments and variables in
- a function can be treated 'strictly' (that is they are always
- evaluated in the function at some point). This allow GHC to apply
- certain optimisations such as unboxing that otherwise don't apply as
- they change the semantics of the program when applied to lazy
- arguments.
+ Turn on demand analysis.
+
+ A *Demand* describes an evaluation context of an expression. *Demand
+ analysis* tries to find out what demands a function puts on its arguments
+ when called: If an argument is scrutinised on every code path, the function
+ is strict in that argument and GHC is free to use the more efficient
+ call-by-value calling convention, as well as pass parameters unboxed.
+
+ Apart from *strictness analysis*, demand analysis also performs *usage
+ analysis*: Where *strict* translates to "evaluated at least once", usage
+ analysis asks whether arguments and bindings are "evaluated at most once"
+ or not at all ("evaluated at most zero times"), e.g. *absent*. For the
+ former, GHC may use call-by-name instead of call-by-need, effectively
+ turning thunks into non-memoised functions. For the latter, no code needs
+ to be generated at all: An absent argument can simply be replaced by a
+ dummy value at the call site or omitted altogether.
+
+ The worker/wrapper transformation (:ghc-flag:`-fworker-wrapper`) is
+ reponsible for exploiting unboxing opportunities and replacing absent
+ arguments by dummies. For arugments that can't be unboxed, opportunities
+ for call-by-value and call-by-name are exploited in CorePrep when
+ translating to STG.
+
+ It's not only interesting to look at how often a binding is *evaluated*,
+ but also how often a function *is called*. If a function is called at most
+ once, we may freely eta-expand it, even if doing so destroys shared work
+ if the function was called multiple times. This information translates
+ into ``OneShotInfo`` annotations that the Simplifier acts on.
+
+ **Notation**
+
+ So demand analysis is about conservatively inferring lower and upper
+ bounds about how many times something is evaluated/called. We call the
+ "how many times" part a *cardinality*. In the compiler and debug output
+ we differentiate the following cardinality intervals as approximations
+ to cardinality:
+
+ +----------+------------------------------+--------+---------------------------------------+
+ | Interval | Set of denoted cardinalities | Syntax | Explanation tying syntax to semantics |
+ +==========+==============================+========+=======================================+
+ | [1,0] | {} | ``B`` | bottom element |
+ +----------+------------------------------+--------+---------------------------------------+
+ | [0,0] | {0} | ``A`` | absent |
+ +----------+------------------------------+--------+---------------------------------------+
+ | [0,1] | {0,1} | ``1`` | used at most once |
+ +----------+------------------------------+--------+---------------------------------------+
+ | [0,ω] | {0,1,ω} | ``U`` | top element, no information, |
+ | | | | used at least 0, at most many times |
+ +----------+------------------------------+--------+---------------------------------------+
+ | [1,1] | {1} | ``S`` | strict, used exactly once |
+ +----------+------------------------------+--------+---------------------------------------+
+ | [1,ω] | {1,ω} | ``M`` | strict, used possibly many times |
+ +----------+------------------------------+--------+---------------------------------------+
+
+ Note that it's never interesting to differentiate between a cardinality
+ of 2 and 3, or even 4232123. We just approximate the >1 case with ω,
+ standing for "many times".
+
+ Apart from the cardinality describing *how often* an argument is evaluated,
+ a demand also carries a *sub-demand*, describing *how deep* something
+ is evaluated beyond a simple ``seq``-like evaluation.
+
+ 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
+ component. That is expressed by the demand ``SP(SU,A)``. The ``P`` is for
+ "product sub-demand", which has a *demand* for each product field. The
+ notation ``SU`` just says "evaluated strictly (``S``), with everything
+ nested inside evaluated according to ``U``" -- e.g., no information,
+ because that would depend on the evaluation context of the call site of
+ ``fst``. The role of ``U`` in ``SU`` is that of a *polymorphic* sub-demand,
+ being semantically equivalent to the sub-demand ``P(UP(..))``, which we
+ simply abbreviate by the (consequently overloaded) cardinality notation
+ ``U``.
+
+ For another example, the expression ``x + 1`` evaluates ``x`` according to
+ demand ``SP(U)``. We have seen single letters stand for cardinalities and
+ polymorphic sub-demands, but what does the single letter ``U`` mean for a
+ *demand*? Such a single letter demand simply expands to a cardinality and
+ a polymorphic sub-demand of the same letter: E.g. ``U`` is equivalent to
+ ``UU`` by expansion of the single letter demand, which is equivalent to
+ ``UP(UP(..))``, so ``U``\s all the way down.
+
+ **Demand signatures**
+
+ We summarise a function's demand properties in its *demand signature*.
+ This is the general syntax:
+
+ .. code-block::
+
+ {x->dx,y->dy,z->dz...}<d1><d2><d3>...<dn>d
+ ^ ^ ^ ^ ^ ^
+ | | | | | |
+ | \---+---+------/ |
+ | | |
+ 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,
+ that argument is evaluated according to ``SP(SU,A)``". For another
+ example, the demand signature of ``seq`` would be ``<SA>`` and that of
+ ``+`` would be ``<SP(U)><SP(U)>``.
+
+ If not omitted, the divergence information can be ``b`` (surely diverges)
+ or ``x`` (surely diverges or throws a precise exception). For example,
+ ``error`` has demand signature ``<M>b`` and ``throwIO`` (which is the
+ only way to throw precise exceptions) has demand signature ``<_><U><U>x``
+ (leaving out the complicated demand on the ``Exception`` dictionary).
+
+ **Call sub-demands**
+
+ Consider ``maybe``:
+
+ .. code-block::
+
+ maybe :: b -> (a -> b) -> Maybe a -> b
+ maybe n _ Nothing = n
+ maybe _ s (Just a) = s a
+
+ We give it demand signature ``<U><C1(U)><SU>``. The ``C1(U)`` is a
+ *call sub-demand* that says "called at most once, where the result is
+ used according to ``U``". It's in a position where we expect a demand,
+ and similarly to before, this notation is short for ``1C1(U)``, which also
+ says that the argument was evaluated once. When the evaluation cardinality
+ conincides with the outer call cardinality, it is omitted. The expression
+ ``f `seq` f 1 2`` puts ``f`` under demand ``MCS(U)`` and serves as an example
+ where evaluation cardinality doesn't conincide with call cardinality.
+
+ Cardinality is always relative to the enclosing call cardinality, so
+ ``g 1 2 + g 3 4`` puts ``g`` under demand ``CM(CS(U))``, which says "called
+ multiple times (``M``), but every time it is called with one argument,
+ it is applied exactly once to another argument (``S``)".
.. ghc-flag:: -fstrictness-before=⟨n⟩
- :shortdesc: Run an additional strictness analysis before simplifier phase ⟨n⟩
+ :shortdesc: Run an additional demand analysis before simplifier phase ⟨n⟩
:type: dynamic
:category:
- Run an additional strictness analysis before simplifier phase ⟨n⟩.
+ Run an additional demand analysis before simplifier phase ⟨n⟩.
.. ghc-flag:: -funbox-small-strict-fields
:shortdesc: Flatten strict constructor fields with a pointer-sized
@@ -1308,14 +1432,20 @@ by saying ``-fno-wombat``.
potential inlining.
.. ghc-flag:: -fworker-wrapper
- :shortdesc: Enable the worker-wrapper transformation.
+ :shortdesc: Enable the worker/wrapper transformation.
:type: dynamic
:category:
- Enable the worker-wrapper transformation after a strictness
- analysis pass. Implied by :ghc-flag:`-O`, and by :ghc-flag:`-fstrictness`.
+ Enable the worker/wrapper transformation after a demand analysis pass.
+
+ Exploits strictness and absence information by unboxing strict arguments
+ and replacing absent fields by dummy values in a wrapper function that
+ will inline in all relevant scenarios and thus expose a specialised,
+ unboxed calling convention of the worker function.
+
+ Implied by :ghc-flag:`-O`, and by :ghc-flag:`-fstrictness`.
Disabled by :ghc-flag:`-fno-strictness`. Enabling :ghc-flag:`-fworker-wrapper`
- while strictness analysis is disabled (by :ghc-flag:`-fno-strictness`)
+ while demand analysis is disabled (by :ghc-flag:`-fno-strictness`)
has no effect.
.. ghc-flag:: -fbinary-blob-threshold=⟨n⟩
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c70b5613a4ac59e4046feed23e7d99f388cdd958
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c70b5613a4ac59e4046feed23e7d99f388cdd958
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/20201110/c46952d6/attachment-0001.html>
More information about the ghc-commits
mailing list