diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-01-24 10:16:38 -0500 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-01-24 10:16:38 -0500 |
| commit | 9fd87ef8a16fbbce35205ae63d75d239bb575ccc (patch) | |
| tree | 074b7cb46ef513d93d2a43175e25b517ef18cc92 | |
| parent | 90e83a7cbdccfeee86b02b7fe2f81b0485857f6e (diff) | |
| download | haskell-9fd87ef8a16fbbce35205ae63d75d239bb575ccc.tar.gz | |
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
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 15 | ||||
| -rw-r--r-- | 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 7749265682..3e0bf126cf 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 987283be70..d7e1006b9e 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 + |]) |