-----------------------------------------
Fix a bug in the monomorphism restriction
------------------------------------------
Thanks for Koen for reporting this bug.
In tcSimplifyRestricted, I wrongly called tcSimpifyToDicts,
whereas actually we have to simplfy further than simply to
a dictionary.
The test for this is in typecheck/should_compile/tc132.hs
-- foo = f (3::Int)
-- We want to infer the polymorphic type
-- foo :: forall b. b -> b
-- foo = f (3::Int)
-- We want to infer the polymorphic type
-- foo :: forall b. b -> b
- tcSimplifyToDicts wanted_lie `thenTc` \ (dicts, _) ->
- constrained_tvs = tyVarsOfInsts dicts
+ wanteds = lieToList wanted_lie
+ try_me inst = ReduceMe -- Reduce as far as we can. Don't stop at
+ -- dicts; the idea is to get rid of as many type
+ -- variables as possible, and we don't want to stop
+ -- at (say) Monad (ST s), because that reduces
+ -- immediately, with no constraint on s.
+ simpleReduceLoop doc try_me wanteds `thenTc` \ (_, _, constrained_dicts) ->
-- Next, figure out the tyvars we will quantify over
zonkTcTyVarsAndFV (varSetElems tau_tvs) `thenNF_Tc` \ tau_tvs' ->
tcGetGlobalTyVars `thenNF_Tc` \ gbl_tvs ->
let
-- Next, figure out the tyvars we will quantify over
zonkTcTyVarsAndFV (varSetElems tau_tvs) `thenNF_Tc` \ tau_tvs' ->
tcGetGlobalTyVars `thenNF_Tc` \ gbl_tvs ->
let
- qtvs = (tau_tvs' `minusVarSet` oclose (predsOfInsts dicts) gbl_tvs)
+ constrained_tvs = tyVarsOfInsts constrained_dicts
+ qtvs = (tau_tvs' `minusVarSet` oclose (predsOfInsts constrained_dicts) gbl_tvs)
`minusVarSet` constrained_tvs
in
`minusVarSet` constrained_tvs
in
reduceContext doc try_me [] wanteds' `thenTc` \ (no_improvement, frees, binds, irreds) ->
ASSERT( no_improvement )
ASSERT( null irreds )
reduceContext doc try_me [] wanteds' `thenTc` \ (no_improvement, frees, binds, irreds) ->
ASSERT( no_improvement )
ASSERT( null irreds )
- -- No need to loop because tcSimplifyToDicts will have
+ -- No need to loop because simpleReduceLoop will have
-- already done any improvement necessary
returnTc (varSetElems qtvs, mkLIE frees, binds)
-- already done any improvement necessary
returnTc (varSetElems qtvs, mkLIE frees, binds)