Commit a82956df authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Remove superfluous code when deriving Foldable/Traversable

Currently, `-XDeriveFoldable` and `-XDeriveTraversable` generate
unnecessary `mempty` and `pure` expressions when it traverses of an
argument of a constructor whose type does not mention the last type
parameter. Not only is this inefficient, but it prevents `Traversable`
from being derivable for datatypes with unlifted arguments (see
Trac #11174).

The solution to this problem is to adopt a slight change to the
algorithms for `-XDeriveFoldable` and `-XDeriveTraversable`, which is
described in [this wiki
page](https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFu
nctor#Proposal:alternativestrategyforderivingFoldableandTraversable).
The wiki page also describes why we don't apply the same changes to the
algorithm for `-XDeriveFunctor`.

This is techincally a breaking change for users of `-XDeriveFoldable`
and `-XDeriveTraversable`, since if someone was using a law-breaking
`Monoid` instance with a derived `Foldable` instance (i.e., one where `x
<> mempty` does not equal `x`) or a law-breaking `Applicative` instance
with a derived `Traversable` instance, then the new generated code could
result in different behavior. I suspect the number of scenarios like
this is very small, and the onus really should be on those users to fix
up their `Monoid`/`Applicative` instances.

Fixes #11174.

Test Plan: ./validate

Reviewers: hvr, simonpj, austin, bgamari

Reviewed By: simonpj, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1908

GHC Trac Issues: #11174
parent 67d22261
This diff is collapsed.
......@@ -14,7 +14,7 @@ module Util (
zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
zipLazy, stretchZipWith, zipWithAndUnzip,
filterByList, partitionByList,
filterByList, filterByLists, partitionByList,
unzipWith,
......@@ -331,6 +331,23 @@ filterByList (True:bs) (x:xs) = x : filterByList bs xs
filterByList (False:bs) (_:xs) = filterByList bs xs
filterByList _ _ = []
-- | 'filterByLists' takes a list of Bools and two lists as input, and
-- outputs a new list consisting of elements from the last two input lists. For
-- each Bool in the list, if it is 'True', then it takes an element from the
-- former list. If it is 'False', it takes an element from the latter list.
-- The elements taken correspond to the index of the Bool in its list.
-- For example:
--
-- @
-- filterByLists [True, False, True, False] \"abcd\" \"wxyz\" = \"axcz\"
-- @
--
-- This function does not check whether the lists have equal length.
filterByLists :: [Bool] -> [a] -> [a] -> [a]
filterByLists (True:bs) (x:xs) (_:ys) = x : filterByLists bs xs ys
filterByLists (False:bs) (_:xs) (y:ys) = y : filterByLists bs xs ys
filterByLists _ _ _ = []
-- | 'partitionByList' takes a list of Bools and a list of some elements and
-- partitions the list according to the list of Bools. Elements corresponding
-- to 'True' go to the left; elements corresponding to 'False' go to the right.
......
......@@ -192,7 +192,10 @@ Language
In previous versions of GHC, this required a workaround via an
explicit export list in ``Bar``.
- :ghc-flag:`-XDeriveFoldable` and :ghc-flag:`-XDeriveTraversable` now
generate code without superfluous ``mempty`` or ``pure`` expressions. As a
result, :ghc-flag:`-XDeriveTraversable` now works on datatypes that contain
arguments which have unlifted types.
Compiler
~~~~~~~~
......
......@@ -3515,8 +3515,11 @@ would generate the following instance::
The algorithm for :ghc-flag:`-XDeriveFoldable` is adapted from the :ghc-flag:`-XDeriveFunctor`
algorithm, but it generates definitions for ``foldMap`` and ``foldr`` instead
of ``fmap``. Here are the differences between the generated code in each
extension:
of ``fmap``. In addition, :ghc-flag:`-XDeriveFoldable` filters out all
constructor arguments on the RHS expression whose types do not mention the last
type parameter, since those arguments do not need to be folded over.
Here are the differences between the generated code in each extension:
#. When a bare type variable ``a`` is encountered, :ghc-flag:`-XDeriveFunctor` would
generate ``f a`` for an ``fmap`` definition. :ghc-flag:`-XDeriveFoldable` would
......@@ -3527,10 +3530,6 @@ extension:
``fmap`` on it. Similarly, :ghc-flag:`-XDeriveFoldable` would recursively call
``foldr`` and ``foldMap``.
#. When a type that does not mention ``a`` is encountered, :ghc-flag:`-XDeriveFunctor`
leaves it alone. On the other hand, :ghc-flag:`-XDeriveFoldable` would generate
``z`` (the state value) for ``foldr`` and ``mempty`` for ``foldMap``.
#. :ghc-flag:`-XDeriveFunctor` puts everything back together again at the end by
invoking the constructor. :ghc-flag:`-XDeriveFoldable`, however, builds up a value
of some type. For ``foldr``, this is accomplished by chaining applications
......@@ -3596,12 +3595,15 @@ would generate the following ``Traversable`` instance::
instance Traversable Example where
traverse f (Ex a1 a2 a3 a4)
= fmap Ex (f a1) <*> traverse f a3
= fmap (\b1 b3 -> Ex b1 a2 b3 a4) (f a1) <*> traverse f a3
The algorithm for :ghc-flag:`-XDeriveTraversable` is adapted from the
:ghc-flag:`-XDeriveFunctor` algorithm, but it generates a definition for ``traverse``
instead of ``fmap``. Here are the differences between the generated code in
each extension:
instead of ``fmap``. In addition, :ghc-flag:`-XDeriveTraversable` filters out
all constructor arguments on the RHS expression whose types do not mention the
last type parameter, since those arguments do not produce any effects in a
traversal. Here are the differences between the generated code in each
extension:
#. When a bare type variable ``a`` is encountered, both :ghc-flag:`-XDeriveFunctor` and
:ghc-flag:`-XDeriveTraversable` would generate ``f a`` for an ``fmap`` and
......@@ -3612,10 +3614,6 @@ each extension:
``fmap`` on it. Similarly, :ghc-flag:`-XDeriveTraversable` would recursively call
``traverse``.
#. When a type that does not mention ``a`` is encountered, :ghc-flag:`-XDeriveFunctor`
leaves it alone. On the other hand, :ghc-flag:`-XDeriveTraversable` would call
``pure`` on the value of that type.
#. :ghc-flag:`-XDeriveFunctor` puts everything back together again at the end by
invoking the constructor. :ghc-flag:`-XDeriveTraversable` does something similar,
but it works in an ``Applicative`` context by chaining everything together
......
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MagicHash #-}
module T11174 where
import GHC.Prim (Int#)
data IntHash a = IntHash Int#
deriving (Functor, Foldable, Traversable)
data IntHashFun a = IntHashFun ((a -> Int#) -> a)
deriving Functor
data IntHashTuple a = IntHashTuple Int# a (a, Int, IntHashTuple (a, Int))
deriving (Functor, Foldable, Traversable)
......@@ -61,5 +61,6 @@ test('T10524', normal, compile, [''])
test('T11148', normal, run_command,
['$MAKE -s --no-print-directory T11148'])
test('T9968', normal, compile, [''])
test('T11174', normal, compile, [''])
test('T11416', normal, compile, [''])
test('T11396', normal, compile, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment