19217 Implicitly quantify type variables in :kind command

5 files changed, 24 insertions, 6 deletions

diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index a332d61fb1..9ab53792a8 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2668,8 +2668,15 @@ tcRnType :: HscEnv
 tcRnType hsc_env flexi normalise rdr_type
   = runTcInteractive hsc_env $
     setXOptM LangExt.PolyKinds $   -- See Note [Kind-generalise in tcRnType]
-    do { (HsWC { hswc_ext = wcs, hswc_body = rn_type }, _fvs)
-               <- rnHsWcType GHCiCtx (mkHsWildCardBndrs rdr_type)
+    do { (HsWC { hswc_ext = wcs, hswc_body = rn_sig_type@(L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body })) }, _fvs)
+                 -- we are using 'rnHsSigWcType' to bind the unbound type variables
+                 -- and in combination with 'tcOuterTKBndrs' we are able to
+                 -- implicitly quantify them as if the user wrote 'forall' by
+                 -- hand (see #19217). This allows kind check to work in presence
+                 -- of free type variables :
+                 -- ghci> :k [a]
+                 -- [a] :: *
+               <- rnHsSigWcType GHCiCtx (mkHsWildCardBndrs $ noLocA (mkHsImplicitSigType rdr_type))
                   -- The type can have wild cards, but no implicit
                   -- generalisation; e.g.   :kind (T _)
        ; failIfErrsM
@@ -2679,14 +2686,14 @@ tcRnType hsc_env flexi normalise rdr_type
         -- Now kind-check the type
         -- It can have any rank or kind
         -- First bring into scope any wildcards
-       ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type])
-       ; ((ty, kind), wanted)
+       ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_sig_type])
+       ; si <- mkSkolemInfo $ SigTypeSkol (GhciCtxt True)
+       ; ((_, (ty, kind)), wanted)
                <- captureTopConstraints $
                   pushTcLevelM_         $
                   bindNamedWildCardBinders wcs $ \ wcs' ->
                   do { mapM_ emitNamedTypeHole wcs'
-                     ; tcInferLHsTypeUnsaturated rn_type }
-
+                     ; tcOuterTKBndrs si outer_bndrs $ tcInferLHsTypeUnsaturated body }
        -- Since all the wanteds are equalities, the returned bindings will be empty
        ; empty_binds <- simplifyTop wanted
        ; massertPpr (isEmptyBag empty_binds) (ppr empty_binds)
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index bdce8d5933..cb09eab3ff 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -2615,6 +2615,14 @@ commonly used commands.
         ghci> :k T Int
         T Int :: * -> *
 
+    Free type variables are also implicitly quantified, same as if you wrote
+    ``:k forall a. [a]`` so this also works:
+
+    .. code-block:: none
+
+        ghci> :k [a]
+        [a] :: *
+
     If you specify the optional "``!``", GHC will in addition normalise
     the type by expanding out type synonyms and evaluating type-function
     applications, and display the normalised result.
diff --git a/testsuite/tests/ghci/should_run/T19217.script b/testsuite/tests/ghci/should_run/T19217.script
new file mode 100644
index 0000000000..b06fed35df
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T19217.script
@@ -0,0 +1 @@
+:kind [a]
diff --git a/testsuite/tests/ghci/should_run/T19217.stdout b/testsuite/tests/ghci/should_run/T19217.stdout
new file mode 100644
index 0000000000..f8de790c75
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T19217.stdout
@@ -0,0 +1 @@
+[a] :: *
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index 5433a613db..935cbecd7d 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -77,6 +77,7 @@ test('T18064',
    ['T18064.script'])
 test('T18594', just_ghci, ghci_script, ['T18594.script'])
 test('T18562', just_ghci, ghci_script, ['T18562.script'])
+test('T19217', just_ghci, ghci_script, ['T19217.script'])
 test('T19460', just_ghci, ghci_script, ['T19460.script'])
 test('T19733', just_ghci, compile_and_run, [''])