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

1 files changed, 18 insertions, 1 deletions

diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index b8af6a7c9d..8cafbfb4f1 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -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.