Fix `:k` command: add validity checking
authorNingning Xie <xnningxie@gmail.com>
Sun, 28 Oct 2018 16:26:12 +0000 (12:26 -0400)
committerBen Gamari <ben@smart-cactus.org>
Sun, 28 Oct 2018 17:40:13 +0000 (13:40 -0400)
Summary:
This patch fixes #15806, where we found that the `:k` command in GHCi
misses a validity checking for the type.

Missing validity checking causes `:k` to accept types that are not validated.
For example, `:k (Maybe (forall a. a -> a))` (incorrectly) returns `*`, while
impredictivity of type instantiation shouldn't be allowed.

Test Plan: ./validate

Reviewers: simonpj, goldfire, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, carter

GHC Trac Issues: #15806

Differential Revision: https://phabricator.haskell.org/D5265

compiler/typecheck/TcHsType.hs
compiler/typecheck/TcRnDriver.hs
testsuite/tests/ghci/should_run/T15806.script [new file with mode: 0644]
testsuite/tests/ghci/should_run/T15806.stderr [new file with mode: 0644]
testsuite/tests/ghci/should_run/T15806.stdout [new file with mode: 0644]
testsuite/tests/ghci/should_run/all.T

index 24299dd..2194fa0 100644 (file)
@@ -174,7 +174,7 @@ pprSigCtxt ctxt hs_ty
 
 tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type
 -- This one is used when we have a LHsSigWcType, but in
 
 tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type
 -- This one is used when we have a LHsSigWcType, but in
--- a place where wildards aren't allowed. The renamer has
+-- a place where wildcards aren't allowed. The renamer has
 -- already checked this, so we can simply ignore it.
 tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty)
 
 -- already checked this, so we can simply ignore it.
 tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty)
 
index 814a580..1c04327 100644 (file)
@@ -51,6 +51,7 @@ import {-# SOURCE #-} TcSplice ( finishTH, runRemoteModFinalizers )
 import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
 import IfaceEnv( externaliseName )
 import TcHsType
 import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
 import IfaceEnv( externaliseName )
 import TcHsType
+import TcValidity( checkValidType )
 import TcMatches
 import Inst( deeplyInstantiate )
 import TcUnify( checkConstraints )
 import TcMatches
 import Inst( deeplyInstantiate )
 import TcUnify( checkConstraints )
@@ -2397,6 +2398,9 @@ tcRnType hsc_env normalise rdr_type
        ; kvs <- kindGeneralize kind
        ; ty  <- zonkTcTypeToType ty
 
        ; kvs <- kindGeneralize kind
        ; ty  <- zonkTcTypeToType ty
 
+       -- Do validity checking on type
+       ; checkValidType GhciCtxt ty
+
        ; ty' <- if normalise
                 then do { fam_envs <- tcGetFamInstEnvs
                         ; let (_, ty')
        ; ty' <- if normalise
                 then do { fam_envs <- tcGetFamInstEnvs
                         ; let (_, ty')
diff --git a/testsuite/tests/ghci/should_run/T15806.script b/testsuite/tests/ghci/should_run/T15806.script
new file mode 100644 (file)
index 0000000..71f0dee
--- /dev/null
@@ -0,0 +1,3 @@
+:set -XRankNTypes
+:k (Maybe Int)
+:k (Maybe (forall a. a -> a))
\ No newline at end of file
diff --git a/testsuite/tests/ghci/should_run/T15806.stderr b/testsuite/tests/ghci/should_run/T15806.stderr
new file mode 100644 (file)
index 0000000..b7e0b4b
--- /dev/null
@@ -0,0 +1,3 @@
+<interactive>:1:1: error:
+    Illegal polymorphic type: forall a. a -> a
+    GHC doesn't yet support impredicative polymorphism
\ No newline at end of file
diff --git a/testsuite/tests/ghci/should_run/T15806.stdout b/testsuite/tests/ghci/should_run/T15806.stdout
new file mode 100644 (file)
index 0000000..f4e9f23
--- /dev/null
@@ -0,0 +1 @@
+(Maybe Int) :: *
\ No newline at end of file
index 70e200c..855b603 100644 (file)
@@ -35,3 +35,4 @@ test('T14963a', just_ghci, ghci_script, ['T14963a.script'])
 test('T14963b', just_ghci, ghci_script, ['T14963b.script'])
 test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script'])
 test('T15007', just_ghci, ghci_script, ['T15007.script'])
 test('T14963b', just_ghci, ghci_script, ['T14963b.script'])
 test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script'])
 test('T15007', just_ghci, ghci_script, ['T15007.script'])
+test('T15806',     just_ghci, ghci_script, ['T15806.script'])