- tcInstTcType method_ty `thenNF_Tc` \ (method_tyvars, method_rho) ->
- let
- (method_theta, method_tau) = splitRhoTy method_rho
- in
- newDicts origin method_theta `thenNF_Tc` \ (method_dicts,method_dict_ids) ->
-
- case (method_tyvars, method_dict_ids) of
-
- ([],[]) -> -- The simple case; no local polymorphism or overloading in the method
-
- -- Type check the method itself
- tcMethodBind method_id method_tau mbind `thenTc` \ (mbind', lieIop) ->
- returnTc ([tag], lieIop, mbind')
-
- other -> -- It's a locally-polymorphic and/or overloaded method; UGH!
-
- -- Make a new id for (a) the local, non-overloaded method
- -- and (b) the locally-overloaded method
- -- The latter is needed just so we can return an AbsBinds wrapped
- -- up inside a MonoBinds.
-
-
- -- Make the method_tyvars into signature tyvars so they
- -- won't get unified with anything.
- tcInstSigTyVars method_tyvars `thenNF_Tc` \ (sig_tyvars, sig_tyvar_tys, _) ->
- unifyTauTyLists sig_tyvar_tys (mkTyVarTys method_tyvars) `thenTc_`
-
- newLocalId occ method_tau `thenNF_Tc` \ local_id ->
- newLocalId occ method_ty `thenNF_Tc` \ copy_id ->
- let
- tc_local_id = TcId local_id
- tc_copy_id = TcId copy_id
- sig_tyvar_set = mkTyVarSet sig_tyvars
- in
- -- Typecheck the method
- tcMethodBind tc_local_id method_tau mbind `thenTc` \ (mbind', lieIop) ->
-
- -- Check the overloading part of the signature.
-
- -- =========== POSSIBLE BUT NOT DONE =================
- -- Simplify everything fully, even though some
- -- constraints could "really" be left to the next
- -- level out. The case which forces this is
- --
- -- class Foo a where { op :: Bar a => a -> a }
- --
- -- Here we must simplify constraints on "a" to catch all
- -- the Bar-ish things.
-
- -- We don't do this because it's currently illegal Haskell (not sure why),
- -- and because the local type of the method would have a context at
- -- the front with no for-all, which confuses the hell out of everything!
- -- ====================================================
-
- tcAddErrCtxt (methodSigCtxt op method_ty) (
- checkSigTyVars
- sig_tyvars method_tau `thenTc_`
-
- tcSimplifyAndCheck
- sig_tyvar_set
- (method_dicts `plusLIE` avail_insts)
- lieIop
- ) `thenTc` \ (f_dicts, dict_binds) ->
-
-
- returnTc ([tag],
- f_dicts,
- VarMonoBind method_id
- (HsLet
- (AbsBinds
- method_tyvars
- method_dict_ids
- [(tc_local_id, tc_copy_id)]
- dict_binds
- (NonRecBind mbind'))
- (HsVar tc_copy_id)))
-\end{code}