[commit: ghc] wip/T14880: Fix newtype instance GADTs (16944e6)

[git at git.haskell.org]

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

On branch  : wip/T14880
Link       : http://ghc.haskell.org/trac/ghc/changeset/16944e6c462d782671d719ace1b8430070e9b2bd/ghc

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

commit 16944e6c462d782671d719ace1b8430070e9b2bd
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Wed May 30 21:49:41 2018 -0400

    Fix newtype instance GADTs


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

16944e6c462d782671d719ace1b8430070e9b2bd
 compiler/basicTypes/MkId.hs | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 7e55520..15ce5c2 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -569,10 +569,17 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
              -- Passing Nothing here allows the wrapper to inline when
              -- unsaturated.
              wrap_unf = mkInlineUnfolding wrap_rhs
+
+             -- Newtype "workers" already have any family coercion applied
+             -- (see the definition of newtype_unf in mkDataConWorkId), so
+             -- we don't want to apply the coercion again.
+             casted_body | isNewTyCon tycon = wrap_body
+                         | otherwise        = wrapFamInstBody tycon res_ty_args $
+                                              wrap_body
+
              wrap_rhs = mkLams wrap_tvs $
                         mkLams wrap_args $
-                        wrapFamInstBody tycon res_ty_args $
-                        wrap_body
+                        casted_body
 
        ; return (DCR { dcr_wrap_id = wrap_id
                      , dcr_boxer   = mk_boxer boxers