[commit: ghc] master: Don't put foralls in front of TH-spliced GADT constructors that don't need them (9fd87ef)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/9fd87ef8a16fbbce35205ae63d75d239bb575ccc/ghc

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

commit 9fd87ef8a16fbbce35205ae63d75d239bb575ccc
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Tue Jan 24 10:16:38 2017 -0500

    Don't put foralls in front of TH-spliced GADT constructors that don't need them
    
    Summary:
    It turns out that D2974 broke this program
    (see https://phabricator.haskell.org/rGHC729a5e452db5#58801):
    
    ```lang=haskell
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE KindSignatures #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# OPTIONS_GHC -ddump-splices #-}
    module Bug where
    
    import GHC.Exts (Constraint)
    
    $([d| data Dec13 :: (* -> Constraint) -> * where
            MkDec13 :: c a => a -> Dec13 c
        |])
    ```
    
    This was actually due to a long-standing bug in `hsSyn/Convert` that put
    unnecessary `forall`s in front of GADT constructors that didn't have any
    explicitly quantified type variables.
    
    This cargo-cults the code in `Convert` that handles `ForallT` and adapts
    it to `ForallC`. Fixes #13123 (for real this time).
    
    Test Plan: make test TEST=T13123
    
    Reviewers: goldfire, austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D3002
    
    GHC Trac Issues: #13123


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

9fd87ef8a16fbbce35205ae63d75d239bb575ccc
 compiler/hsSyn/Convert.hs    | 15 +++++++++++----
 testsuite/tests/th/T13123.hs |  7 +++++++
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 7749265..3e0bf12 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -510,10 +510,17 @@ cvtConstr (ForallC tvs ctxt con)
         ; L _ con'    <- cvtConstr con
         ; returnL $ case con' of
                 ConDeclGADT { con_type = conT } ->
-                  con' { con_type =
-                         HsIB PlaceHolder
-                         (noLoc $ HsForAllTy (hsq_explicit tvs') $
-                          (noLoc $ HsQualTy (L loc ctxt') (hsib_body conT))) }
+                  let hs_ty
+                        | null tvs = rho_ty
+                        | otherwise = noLoc $ HsForAllTy
+                                                { hst_bndrs = hsq_explicit tvs'
+                                                , hst_body  = rho_ty }
+                      rho_ty
+                        | null ctxt = hsib_body conT
+                        | otherwise = noLoc $ HsQualTy
+                                                { hst_ctxt = L loc ctxt'
+                                                , hst_body = hsib_body conT }
+                  in con' { con_type = HsIB PlaceHolder hs_ty }
                 ConDeclH98  {} ->
                   let qvars = case (tvs, con_qvars con') of
                         ([], Nothing) -> Nothing
diff --git a/testsuite/tests/th/T13123.hs b/testsuite/tests/th/T13123.hs
index 987283b..d7e1006 100644
--- a/testsuite/tests/th/T13123.hs
+++ b/testsuite/tests/th/T13123.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE PolyKinds #-}
@@ -5,6 +6,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 module T13123 where
 
+import GHC.Exts (Constraint)
+
 $([d| idProxy :: forall proxy (a :: k). proxy a -> proxy a
       idProxy x = x
     |])
@@ -28,3 +31,7 @@ $([d| class Foo b where
 $([d| data GADT where
         MkGADT :: forall proxy (a :: k). proxy a -> GADT
     |])
+
+$([d| data Dec13 :: (* -> Constraint) -> * where
+        MkDec13 :: c a => a -> Dec13 c
+    |])