Fix #15787 by squashing a coercion hole.
authorRichard Eisenberg <rae@cs.brynmawr.edu>
Sun, 28 Oct 2018 20:06:17 +0000 (16:06 -0400)
committerBen Gamari <ben@smart-cactus.org>
Fri, 2 Nov 2018 14:59:49 +0000 (10:59 -0400)
In type-incorrect code, we can sometimes let a coercion
hole make it through the zonker. If this coercion hole then
ends up in the environment (e.g., in the type of a data
constructor), then it causes trouble later.

This patch avoids trouble by substituting the coercion hole
for its representative CoVar. Really, any coercion would do,
but the CoVar was very handy.

test case: polykinds/T15787

(cherry picked from commit 4427315a65b25db22e1754d41b43dd4b782b022f)

compiler/typecheck/TcHsSyn.hs
testsuite/tests/polykinds/T15787.hs [new file with mode: 0644]
testsuite/tests/polykinds/T15787.stderr [new file with mode: 0644]
testsuite/tests/polykinds/all.T

index b3f9a69..986047b 100644 (file)
@@ -1673,7 +1673,9 @@ zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
                                    , text "Type-correct unfilled coercion hole"
                                      <+> ppr hole )
                          ; cv' <- zonkCoVar cv
-                         ; return $ mkHoleCo (hole { ch_co_var = cv' }) } }
+                         ; return $ mkCoVarCo cv' } }
+                             -- This will be an out-of-scope variable, but keeping
+                             -- this as a coercion hole led to #15787
 
 zonk_tycomapper :: TyCoMapper ZonkEnv TcM
 zonk_tycomapper = TyCoMapper
diff --git a/testsuite/tests/polykinds/T15787.hs b/testsuite/tests/polykinds/T15787.hs
new file mode 100644 (file)
index 0000000..85e737a
--- /dev/null
@@ -0,0 +1,19 @@
+{-# Language RankNTypes #-}
+{-# Language TypeApplications #-}
+{-# Language DataKinds        #-}
+{-# Language PolyKinds        #-}
+{-# Language GADTs            #-}
+{-# Language TypeFamilies     #-}
+
+import Data.Kind
+
+class Ríki (ob :: Type) where
+ type Hom :: ob -> ob -> Type
+
+data
+  Kl_kind :: forall ob . (ob -> ob) -> ob -> Type where
+  Kl      :: k -> Kl_kind (m :: ob -> ob) k
+
+type family
+  UnKl (kl :: Kl_kind m k) = (res :: k) where
+  UnKl (Kl a) = a
diff --git a/testsuite/tests/polykinds/T15787.stderr b/testsuite/tests/polykinds/T15787.stderr
new file mode 100644 (file)
index 0000000..6d368d5
--- /dev/null
@@ -0,0 +1,6 @@
+
+T15787.hs:15:43: error:
+    • Expected kind ‘ob’, but ‘k’ has kind ‘*’
+    • In the second argument of ‘Kl_kind’, namely ‘k’
+      In the type ‘Kl_kind (m :: ob -> ob) k’
+      In the definition of data constructor ‘Kl’
index 2d0f993..53a33e3 100644 (file)
@@ -193,3 +193,4 @@ test('T15116a', normal, compile_fail, [''])
 test('T15170', normal, compile, [''])
 test('T14939', normal, compile, ['-O'])
 test('T15577', normal, compile_fail, ['-O'])
+test('T15787', normal, compile_fail, [''])