+tcMonoBinds [L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf,
+ fun_matches = matches, bind_fvs = fvs })]
+ sig_fn -- Single function binding,
+ NonRecursive -- binder isn't mentioned in RHS,
+ | Nothing <- sig_fn name -- ...with no type signature
+ = -- In this very special case we infer the type of the
+ -- right hand side first (it may have a higher-rank type)
+ -- and *then* make the monomorphic Id for the LHS
+ -- e.g. f = \(x::forall a. a->a) -> <body>
+ -- We want to infer a higher-rank type for f
+ setSrcSpan b_loc $
+ do { ((co_fn, matches'), rhs_ty) <- tcInfer (tcMatchesFun name matches)
+
+ -- Check for an unboxed tuple type
+ -- f = (# True, False #)
+ -- Zonk first just in case it's hidden inside a meta type variable
+ -- (This shows up as a (more obscure) kind error
+ -- in the 'otherwise' case of tcMonoBinds.)
+ ; zonked_rhs_ty <- zonkTcType rhs_ty
+ ; checkTc (not (isUnboxedTupleType zonked_rhs_ty))
+ (unboxedTupleErr name zonked_rhs_ty)
+
+ ; mono_name <- newLocalName name
+ ; let mono_id = mkLocalId mono_name zonked_rhs_ty
+ ; return (unitBag (L b_loc (FunBind { fun_id = L nm_loc mono_id, fun_infix = inf,
+ fun_matches = matches', bind_fvs = fvs,
+ fun_co_fn = co_fn })),
+ [(name, Nothing, mono_id)]) }
+
+tcMonoBinds [L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf,
+ fun_matches = matches, bind_fvs = fvs })]
+ sig_fn -- Single function binding
+ non_rec
+ | Just sig <- sig_fn name -- ...with a type signature
+ = -- When we have a single function binding, with a type signature
+ -- we can (a) use genuine, rigid skolem constants for the type variables
+ -- (b) bring (rigid) scoped type variables into scope
+ setSrcSpan b_loc $
+ do { tc_sig <- tcInstSig True sig
+ ; mono_name <- newLocalName name
+ ; let mono_ty = sig_tau tc_sig
+ mono_id = mkLocalId mono_name mono_ty
+ rhs_tvs = [ (name, mkTyVarTy tv)
+ | (name, tv) <- sig_scoped tc_sig `zip` sig_tvs tc_sig ]
+
+ ; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs $
+ tcMatchesFun mono_name matches mono_ty
+
+ ; let fun_bind' = FunBind { fun_id = L nm_loc mono_id,
+ fun_infix = inf, fun_matches = matches',
+ bind_fvs = placeHolderNames, fun_co_fn = co_fn }
+ ; return (unitBag (L b_loc fun_bind'),
+ [(name, Just tc_sig, mono_id)]) }