[commit: ghc] ghc-8.0: Make DeriveFunctor work with unboxed tuples (1f862ac)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/1f862acbd7d38b28a205002cded4f7b8824262e5/ghc

>---------------------------------------------------------------

commit 1f862acbd7d38b28a205002cded4f7b8824262e5
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Mon Jul 18 09:28:42 2016 -0400

    Make DeriveFunctor work with unboxed tuples
    
    Summary:
    Unboxed tuples have `RuntimeRep` arguments which `-XDeriveFunctor` was
    mistaking for actual data constructor arguments. As a result, a derived
    `Functor` instance for a datatype that contained an unboxed tuple would
    generate twice as many arguments as it needed for an unboxed tuple pattern
    match or expression. The solution is to simply put `dropRuntimeRepArgs` in the
    right place.
    
    Fixes #12399.
    
    Test Plan: ./validate
    
    Reviewers: austin, hvr, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie, osa1
    
    Differential Revision: https://phabricator.haskell.org/D2404
    
    GHC Trac Issues: #12399
    
    (cherry picked from commit 3fa3fe8a9a8afa67829e12efa5d25b76e58a185a)


>---------------------------------------------------------------

1f862acbd7d38b28a205002cded4f7b8824262e5
 compiler/typecheck/TcGenDeriv.hs                  | 8 ++++++--
 testsuite/tests/deriving/should_compile/T12399.hs | 7 +++++++
 testsuite/tests/deriving/should_compile/all.T     | 1 +
 3 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index e5b7ba2..f2da4dd 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1658,7 +1658,11 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial,     ft_var = caseVar
                           = (caseTyApp fun_ty (last xrs), True)
        | otherwise        = (caseWrongArg, True)   -- Non-decomposable (eg type function)
        where
-         (xrs,xcs) = unzip (map (go co) args)
+         -- When folding over an unboxed tuple, we must explicitly drop the
+         -- runtime rep arguments, or else GHC will generate twice as many
+         -- variables in a unboxed tuple pattern match and expression as it
+         -- actually needs. See Trac #12399
+         (xrs,xcs) = unzip (map (go co) (dropRuntimeRepArgs args))
     go _  (ForAllTy (Named _ Visible) _) = panic "unexpected visible binder"
     go co (ForAllTy (Named v _)       x) | v /= var && xc = (caseForAll v xr,True)
         where (xr,xc) = go co x
@@ -2727,7 +2731,7 @@ a is the last type variable in a given datatype):
 * ft_tup:     A tuple type which mentions the last type variable in at least
               one of its fields. The TyCon argument of ft_tup represents the
               particular tuple's type constructor.
-              Examples: (a, Int), (Maybe a, [a], Either a Int)
+              Examples: (a, Int), (Maybe a, [a], Either a Int), (# Int, a #)
 
 * ft_ty_app:  A type is being applied to the last type parameter, where the
               applied type does not mention the last type parameter (if it
diff --git a/testsuite/tests/deriving/should_compile/T12399.hs b/testsuite/tests/deriving/should_compile/T12399.hs
new file mode 100644
index 0000000..c3429f8
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T12399.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE DeriveFunctor, MagicHash, UnboxedTuples #-}
+module T12399 where
+
+import GHC.Exts
+
+newtype RmLoopsM a = RmLoopsM { runRmLoops :: Int# -> (# Int#, a #) }
+  deriving Functor
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 9017687..6b37420 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -71,3 +71,4 @@ test('T11732b', normal, compile, [''])
 test('T11732c', normal, compile, [''])
 test('T11833', normal, compile, [''])
 test('T11837', normal, compile, [''])
+test('T12399', normal, compile, [''])