Commit 4c746cb2 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Add missing solveEqualities

I'd missed a call to solveEqualities in the partial-type-sig case
of TcBinds.tcUserTypeSig.

Also the checkValidType test done there best done after inference,
in checkInferredPolyId (and is already done there).

Fixes Trac #11976
parent 9ed57d66
......@@ -1797,8 +1797,9 @@ tcUserTypeSig hs_sig_ty mb_name
<- pushTcLevelM_ $
-- When instantiating the signature, do so "one level in"
-- so that they can be unified under the forall
tcImplicitTKBndrs vars $
tcWildCardBinders wcs $ \ wcs ->
solveEqualities $
tcImplicitTKBndrs vars $
tcWildCardBinders wcs $ \ wcs ->
tcExplicitTKBndrs hs_tvs $ \ tvs2 ->
do { -- Instantiate the type-class context; but if there
-- is an extra-constraints wildcard, just discard it here
......@@ -1815,20 +1816,14 @@ tcUserTypeSig hs_sig_ty mb_name
; theta <- zonkTcTypes theta
; tau <- zonkTcType tau
-- Check for validity (eg rankN etc)
-- The ambiguity check will happen (from checkValidType),
-- but unnecessarily; it will always succeed because there
-- is no quantification
; checkValidType ctxt_F (mkPhiTy theta tau)
-- NB: Do this in the context of the pushTcLevel so that
-- the TcLevel invariant is respected
; let bound_tvs
= unionVarSets [ allBoundVariabless theta
, allBoundVariables tau
, mkVarSet (map snd wcs) ]
; return ((wcs, tvs2, theta, tau), bound_tvs) }
-- NB: checkValidType on the final inferred type will
-- be done later by checkInferredPolyId
; loc <- getSrcSpanM
; return $
TISI { sig_bndr = PartialSig { sig_name = name, sig_hs_ty = hs_ty
......
{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}
module T11976 where
type Lens s a = forall f. Functor f => (a -> f a) -> (s -> f s)
foo = undefined :: Lens _ _ _
T11976.hs:7:20: error:
• Expecting one fewer arguments to ‘Lens t0 t1’
Expected kind ‘k0 -> *’, but ‘Lens t0 t1’ has kind ‘*’
• In the type ‘Lens _ _ _’
In the expression: undefined :: Lens _ _ _
In an equation for ‘foo’: foo = undefined :: Lens _ _ _
......@@ -60,3 +60,4 @@ test('T10615', normal, compile_fail, [''])
test('T10045', normal, compile_fail, [''])
test('T10999', normal, compile_fail, [''])
test('T11122', normal, compile, [''])
test('T11976', normal, compile_fail, [''])
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