Commit c50e4c92 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Marge Bot

Fix validity checking for inferred types

GHC is suposed to uphold the principle that an /inferred/ type
for a let-binding should obey the rules for that module.  E.g.
we should only accept an inferred higher rank type if we have
RankNTypes on.

But we were failing to check this: TcValidity.checkValidType
allowed arbitrary rank for inferred types.

This patch fixes the bug.  It might in principle cause some breakage,
but if so that's good: the user should add RankNTypes and/or a
manual signature.  (And almost every package has explicit user
signatures for all top-level things anyway.)  Let's see.

Fixes #17213.

Metric Decrease:
    T10370
parent 0a338264
Pipeline #11297 passed with stages
in 425 minutes and 9 seconds
......@@ -356,7 +356,9 @@ checkValidType ctxt ty
-- So we do this check here.
FunSigCtxt {} -> rank1
InfSigCtxt _ -> ArbitraryRank -- Inferred type
InfSigCtxt {} -> rank1 -- Inferred types should obey the
-- same rules as declared ones
ConArgCtxt _ -> rank1 -- We are given the type of the entire
-- constructor, hence rank 1
PatSynCtxt _ -> rank1
......@@ -676,7 +678,7 @@ check_type ve (CastTy ty _) = check_type ve ty
check_type ve@(ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt
, ve_rank = rank, ve_expand = expand }) ty
| not (null tvbs && null theta)
= do { traceTc "check_type" (ppr ty $$ ppr (forAllAllowed rank))
= do { traceTc "check_type" (ppr ty $$ ppr rank)
; checkTcM (forAllAllowed rank) (forAllTyErr env rank ty)
-- Reject e.g. (Maybe (?x::Int => Int)),
-- with a decent error message
......
module T17213 where
import T17213a
g = foo
T17213.hs:5:1: error:
• Illegal polymorphic type: forall a. a -> a
Perhaps you intended to use RankNTypes
• When checking the inferred type
g :: (forall a. a -> a) -> Int
{-# LANGUAGE RankNTypes #-}
module T17213a where
foo :: (forall a. a->a)-> Int
foo x = error "ukr"
......@@ -543,3 +543,4 @@ test('UnliftedNewtypesMismatchedKindRecord', normal, compile_fail, [''])
test('UnliftedNewtypesMultiFieldGadt', normal, compile_fail, [''])
test('T13834', normal, compile_fail, [''])
test('T17077', normal, compile_fail, [''])
test('T17213', [extra_files(['T17213a.hs'])], multimod_compile_fail, ['T17213', '-v0'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment