diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-02-18 11:14:26 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-02-18 11:57:46 -0500 |
| commit | 043466b9aac403553e2aaf8054c064016f963f80 (patch) | |
| tree | 766996d96ce3807c3fa9639094b590ca3e3ac498 | |
| parent | 7f389a580f42a105623853adad15ab3323b41ed5 (diff) | |
| download | haskell-043466b9aac403553e2aaf8054c064016f963f80.tar.gz | |
Rename the types in a GADT constructor in toposorted order
Previously, we were extracting the free variables from a
GADT constructor in an incorrect order, which caused the type
variables for the constructor's type signature to end up in
non-toposorted order. Thankfully, rearranging the order of types
during renaming makes swift work of this bug.
This fixes a regression introduced in commit
fa29df02a1b0b926afb2525a258172dcbf0ea460.
For whatever reason, that commit also commented out a
significant portion of the `T13123` test. This code appears
to work, so I've opted to uncomment it.
Test Plan: make test TEST=T14808
Reviewers: simonpj, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #14808
Differential Revision: https://phabricator.haskell.org/D4413
| -rw-r--r-- | compiler/rename/RnSource.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/gadt/T14808.hs | 12 | ||||
| -rw-r--r-- | testsuite/tests/gadt/all.T | 1 | ||||
| -rw-r--r-- | testsuite/tests/th/T13123.hs | 2 |
4 files changed, 17 insertions, 3 deletions
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index e51d9efc43..5c7f53860e 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -1917,7 +1917,10 @@ rnConDecl decl@(ConDeclGADT { con_names = names ; let explicit_tkvs = hsQTvExplicit qtvs theta = hsConDeclTheta mcxt arg_tys = hsConDeclArgTys args - ; free_tkvs <- extractHsTysRdrTyVarsDups (res_ty : theta ++ arg_tys) + -- We must ensure that we extract the free tkvs in the + -- order of theta, then arg_tys, then res_ty. Failing to + -- do so resulted in #14808. + ; free_tkvs <- extractHsTysRdrTyVarsDups (theta ++ arg_tys ++ [res_ty]) ; free_tkvs <- extractHsTvBndrs explicit_tkvs free_tkvs ; let ctxt = ConDeclCtx new_names diff --git a/testsuite/tests/gadt/T14808.hs b/testsuite/tests/gadt/T14808.hs new file mode 100644 index 0000000000..726f502789 --- /dev/null +++ b/testsuite/tests/gadt/T14808.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} +module T14808 where + +import Data.Kind + +data ECC ctx f a where + ECC :: ctx => f a -> ECC ctx f a + +f :: [()] -> ECC () [] () +f = ECC @() @[] @() diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 59ec307d58..4c8eb806a7 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -116,3 +116,4 @@ test('T12087', normal, compile_fail, ['']) test('T12468', normal, compile_fail, ['']) test('T14320', normal, compile, ['']) test('T14719', normal, compile_fail, ['-fdiagnostics-show-caret']) +test('T14808', normal, compile, ['']) diff --git a/testsuite/tests/th/T13123.hs b/testsuite/tests/th/T13123.hs index dbc071c184..d7e1006b9e 100644 --- a/testsuite/tests/th/T13123.hs +++ b/testsuite/tests/th/T13123.hs @@ -8,7 +8,6 @@ module T13123 where import GHC.Exts (Constraint) -{- $([d| idProxy :: forall proxy (a :: k). proxy a -> proxy a idProxy x = x |]) @@ -32,7 +31,6 @@ $([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 |