- -- No need to instantiate the argument type... it's must be the result
- -- of instantiating a function involving rank-2 polymorphism, so there
- -- isn't any danger of using the same tyvars twice
- -- The argument type shouldn't be overloaded type (hence ASSERT)
-
- -- To ensure that the forall'd type variables don't get unified with each
- -- other or any other types, we make fresh *signature* type variables
- -- and unify them with the tyvars.
- let
- (expected_tyvars, expected_theta, expected_tau) = splitSigmaTy expected_arg_ty
- in
- ASSERT( null expected_theta ) -- And expected_tyvars are all DontBind things
- tcInstSigTyVars expected_tyvars `thenNF_Tc` \ (sig_tyvars, sig_tyvar_tys, _) ->
- unifyTauTyLists (mkTyVarTys expected_tyvars) sig_tyvar_tys `thenTc_`
-
- -- Type-check the arg and unify with expected type
- tcExpr arg `thenTc` \ (arg', lie_arg, actual_arg_ty) ->
- unifyTauTy expected_tau actual_arg_ty `thenTc_` (
-
- -- Check that the arg_tyvars havn't been constrained
- -- The interesting bit here is that we must include the free variables
- -- of the expected arg ty. Here's an example:
- -- runST (newVar True)
- -- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool))
- -- for (newVar True), with s fresh. Then we unify with the runST's arg type
- -- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool.
- -- So now s' isn't unconstrained because it's linked to a.
- -- Conclusion: include the free vars of the expected arg type in the
- -- list of "free vars" for the signature check.
-
- tcAddErrCtxt (rank2ArgCtxt arg expected_arg_ty) $
- checkSigTyVarsGivenGlobals
- (tyVarsOfType expected_arg_ty)
- expected_tyvars expected_tau `thenTc_`
-
- -- Check that there's no overloading involved
- -- Even if there isn't, there may be some Insts which mention the expected_tyvars,
- -- but which, on simplification, don't actually need a dictionary involving
- -- the tyvar. So we have to do a proper simplification right here.
- tcSimplifyRank2 (mkTyVarSet expected_tyvars)
- lie_arg `thenTc` \ (free_insts, inst_binds) ->
-
- -- This HsLet binds any Insts which came out of the simplification.
- -- It's a bit out of place here, but using AbsBind involves inventing
- -- a couple of new names which seems worse.
- returnTc (TyLam expected_tyvars (HsLet (mk_binds inst_binds) arg'), free_insts)
- )
- where
-
- mk_binds [] = EmptyBinds
- mk_binds ((inst,rhs):inst_binds)
- = (SingleBind (NonRecBind (VarMonoBind inst rhs))) `ThenBinds`
- mk_binds inst_binds