- fun_matches = matches, bind_fvs = fvs })]
- sig_fn -- Single function binding
- non_rec
- | Just scoped_tvs <- 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 name scoped_tvs
- ; 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,
- fun_tick = Nothing }
- ; return (unitBag (L b_loc fun_bind'),
- [(name, Just tc_sig, mono_id)]) }
-
-tcMonoBinds binds sig_fn non_rec
- = do { tc_binds <- mapM (wrapLocM (tcLhs sig_fn)) binds
-
- -- Bring the monomorphic Ids, into scope for the RHSs
- ; let mono_info = getMonoBindInfo tc_binds
- rhs_id_env = [(name,mono_id) | (name, Nothing, mono_id) <- mono_info]
- -- A monomorphic binding for each term variable that lacks
- -- a type sig. (Ones with a sig are already in scope.)
-
- ; binds' <- tcExtendIdEnv2 rhs_id_env $
- traceTc (text "tcMonoBinds" <+> vcat [ ppr n <+> ppr id <+> ppr (idType id)
- | (n,id) <- rhs_id_env]) `thenM_`
- mapM (wrapLocM tcRhs) tc_binds
- ; return (listToBag binds', mono_info) }
+ fun_matches = matches })]
+ sig_fn -- Single function binding
+ _
+ | Just scoped_tvs <- 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 name
+ ; 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) <- scoped_tvs `zip` sig_tvs tc_sig ]
+ -- See Note [More instantiated than scoped]
+ -- Note that the scoped_tvs and the (sig_tvs sig)
+ -- may have different Names. That's quite ok.
+
+ ; traceTc (text "tcMoonBinds" <+> ppr scoped_tvs $$ ppr tc_sig)
+ ; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs $
+ tcMatchesFun mono_name inf matches mono_ty
+ -- Note that "mono_ty" might actually be a polymorphic type,
+ -- if the original function had a signature like
+ -- forall a. Eq a => forall b. Ord b => ....
+ -- But that's ok: tcMatchesFun can deal with that
+ -- It happens, too! See Note [Polymorphic methods] in TcClassDcl.
+
+ ; 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,
+ fun_tick = Nothing }
+ ; return (unitBag (L b_loc fun_bind'),
+ [(name, Just tc_sig, mono_id)]) }
+
+tcMonoBinds binds sig_fn _
+ = do { tc_binds <- mapM (wrapLocM (tcLhs sig_fn)) binds
+
+ -- Bring the monomorphic Ids, into scope for the RHSs
+ ; let mono_info = getMonoBindInfo tc_binds
+ rhs_id_env = [(name,mono_id) | (name, Nothing, mono_id) <- mono_info]
+ -- A monomorphic binding for each term variable that lacks
+ -- a type sig. (Ones with a sig are already in scope.)
+
+ ; binds' <- tcExtendIdEnv2 rhs_id_env $ do
+ traceTc (text "tcMonoBinds" <+> vcat [ ppr n <+> ppr id <+> ppr (idType id)
+ | (n,id) <- rhs_id_env])
+ mapM (wrapLocM tcRhs) tc_binds
+ ; return (listToBag binds', mono_info) }