Rename the types in a GADT constructor in toposorted order
authorRyan Scott <ryan.gl.scott@gmail.com>
Sun, 18 Feb 2018 16:14:26 +0000 (11:14 -0500)
committerBen Gamari <ben@smart-cactus.org>
Sun, 18 Feb 2018 16:57:46 +0000 (11:57 -0500)
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

compiler/rename/RnSource.hs
testsuite/tests/gadt/T14808.hs [new file with mode: 0644]
testsuite/tests/gadt/all.T
testsuite/tests/th/T13123.hs

index e51d9ef..5c7f538 100644 (file)
@@ -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 (file)
index 0000000..726f502
--- /dev/null
@@ -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 @() @[] @()
index 59ec307..4c8eb80 100644 (file)
@@ -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, [''])
index dbc071c..d7e1006 100644 (file)
@@ -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