+tcArg :: TcType s -- Expected arg type
+ -> RenamedHsExpr -- Actual argument
+ -> TcM s (TcExpr s, LIE s) -- Resulting argument and LIE
+
+tcArg expected_arg_ty arg
+ | not (maybeToBool (getForAllTy_maybe expected_arg_ty))
+ = -- The ordinary, non-rank-2 polymorphic case
+ tcExpr arg `thenTc` \ (arg', lie_arg, actual_arg_ty) ->
+ unifyTauTy expected_arg_ty actual_arg_ty `thenTc_`
+ returnTc (arg', lie_arg)
+
+ | otherwise
+ = -- Ha! The argument type of the function is a for-all type,
+ -- An example of rank-2 polymorphism.
+
+ -- 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.
+ tcInstSigTcType expected_arg_ty `thenNF_Tc` \ (sig_tyvars, sig_rho) ->
+ let
+ (sig_theta, sig_tau) = splitRhoTy sig_rho
+ in
+ ASSERT( null sig_theta ) -- And expected_tyvars are all DontBind things
+
+ -- Type-check the arg and unify with expected type
+ tcExpr arg `thenTc` \ (arg', lie_arg, actual_arg_ty) ->
+ unifyTauTy sig_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) (
+ tcExtendGlobalTyVars (tyVarsOfType expected_arg_ty) (
+ checkSigTyVars sig_tyvars sig_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 sig_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 sig_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