Commit 9fd87ef8 authored by Ryan Scott's avatar Ryan Scott
Browse files

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
parent 90e83a7c
...@@ -510,10 +510,17 @@ cvtConstr (ForallC tvs ctxt con) ...@@ -510,10 +510,17 @@ cvtConstr (ForallC tvs ctxt con)
; L _ con' <- cvtConstr con ; L _ con' <- cvtConstr con
; returnL $ case con' of ; returnL $ case con' of
ConDeclGADT { con_type = conT } -> ConDeclGADT { con_type = conT } ->
con' { con_type = let hs_ty
HsIB PlaceHolder | null tvs = rho_ty
(noLoc $ HsForAllTy (hsq_explicit tvs') $ | otherwise = noLoc $ HsForAllTy
(noLoc $ HsQualTy (L loc ctxt') (hsib_body conT))) } { 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 {} -> ConDeclH98 {} ->
let qvars = case (tvs, con_qvars con') of let qvars = case (tvs, con_qvars con') of
([], Nothing) -> Nothing ([], Nothing) -> Nothing
......
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
...@@ -5,6 +6,8 @@ ...@@ -5,6 +6,8 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module T13123 where module T13123 where
import GHC.Exts (Constraint)
$([d| idProxy :: forall proxy (a :: k). proxy a -> proxy a $([d| idProxy :: forall proxy (a :: k). proxy a -> proxy a
idProxy x = x idProxy x = x
|]) |])
...@@ -28,3 +31,7 @@ $([d| class Foo b where ...@@ -28,3 +31,7 @@ $([d| class Foo b where
$([d| data GADT where $([d| data GADT where
MkGADT :: forall proxy (a :: k). proxy a -> GADT MkGADT :: forall proxy (a :: k). proxy a -> GADT
|]) |])
$([d| data Dec13 :: (* -> Constraint) -> * where
MkDec13 :: c a => a -> Dec13 c
|])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment