diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-01-12 17:22:11 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-01-17 05:58:12 -0500 |
| commit | 2ac28e4cbaee482d71182fe831cd30d36226c57a (patch) | |
| tree | 3b4f05691ca154e7d5dbe3cd4bec1469530d158f | |
| parent | e516ef7eb73ae19cc07c4f1da5270783b54a17f1 (diff) | |
| download | haskell-2ac28e4cbaee482d71182fe831cd30d36226c57a.tar.gz | |
Use captureTopConstraints at top level
Missing this caused #19197. Easily fixed.
| -rw-r--r-- | compiler/GHC/Tc/Module.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T19197.script | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T19197.stderr | 5 | ||||
| -rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 1 |
4 files changed, 14 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 819740c341..a77f9fe71a 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -60,7 +60,6 @@ import GHC.Tc.Gen.Match import GHC.Tc.Utils.Unify( checkConstraints ) import GHC.Tc.Utils.Zonk import GHC.Tc.Gen.Expr -import GHC.Tc.Errors( reportAllUnsolved ) import GHC.Tc.Gen.App( tcInferSigma ) import GHC.Tc.Utils.Monad import GHC.Tc.Gen.Export @@ -2610,13 +2609,16 @@ tcRnType hsc_env flexi normalise rdr_type -- It can have any rank or kind -- First bring into scope any wildcards ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) - ; (_tclvl, wanted, (ty, kind)) - <- pushLevelAndSolveEqualitiesX "tcRnType" $ + ; ((ty, kind), wanted) + <- captureTopConstraints $ + pushTcLevelM_ $ bindNamedWildCardBinders wcs $ \ wcs' -> do { mapM_ emitNamedTypeHole wcs' ; tcInferLHsTypeUnsaturated rn_type } - ; checkNoErrs (reportAllUnsolved wanted) + -- Since all the wanteds are equalities, the returned bindings will be empty + ; empty_binds <- simplifyTop wanted + ; MASSERT2( isEmptyBag empty_binds, ppr empty_binds ) -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kvs <- kindGeneralizeAll kind diff --git a/testsuite/tests/ghci/scripts/T19197.script b/testsuite/tests/ghci/scripts/T19197.script new file mode 100644 index 0000000000..a045db0bd4 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T19197.script @@ -0,0 +1,2 @@ +:set -XKindSignatures -XDataKinds +:k (() :: '()) diff --git a/testsuite/tests/ghci/scripts/T19197.stderr b/testsuite/tests/ghci/scripts/T19197.stderr new file mode 100644 index 0000000000..231ffd4de6 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T19197.stderr @@ -0,0 +1,5 @@ + +<interactive>:1:8: error: + • Expected a type, but ‘'()’ has kind ‘()’ + • In the kind ‘'()’ + In the type ‘(() :: '())’ diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index b9b534ca9e..f5c1a4ca39 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -326,3 +326,4 @@ test('T18501', normal, ghci_script, ['T18501.script']) test('T18644', normal, ghci_script, ['T18644.script']) test('T18755', normal, ghci_script, ['T18755.script']) test('T18828', normal, ghci_script, ['T18828.script']) +test('T19197', normal, ghci_script, ['T19197.script']) |