- -- enclosing class/instance decl.
- -- They'll be signature tyvars, and we
- -- want to check that they don't get bound
- -> [TcType] -- Instance types
- -> TcThetaType -- Available theta; this could be used to check
- -- the method signature, but actually that's done by
- -- the caller; here, it's just used for the error message
- -> RenamedMonoBinds -- Method binding (pick the right one from in here)
- -> [RenamedSig] -- Pramgas (just for this one)
- -> Bool -- True <=> This method is from an instance declaration
- -> ClassOpItem -- The method selector and default-method Id
- -> TcM (TcMonoBinds, LIE, Inst)
-
-tcMethodBind clas origin inst_tyvars inst_tys inst_theta
- meth_binds prags is_inst_decl (sel_id, dm_info)
+ -- enclosing class/instance decl.
+ -- They'll be signature tyvars, and we
+ -- want to check that they don't get bound
+ -- Always equal the range of the type envt
+ -> TcThetaType -- Available theta; it's just used for the error message
+ -> [Inst] -- Available from context, used to simplify constraints
+ -- from the method body
+ -> (Id, TcSigInfo, RenamedMonoBinds) -- Details of this method
+ -> TcM (TcMonoBinds, LIE)
+
+tcMethodBind xtve inst_tyvars inst_theta avail_insts
+ (sel_id, meth_sig, meth_bind)
+ =
+ -- Check the bindings; first adding inst_tyvars to the envt
+ -- so that we don't quantify over them in nested places
+ tcExtendTyVarEnv2 xtve (
+ tcAddErrCtxt (methodCtxt sel_id) $
+ tcMonoBinds meth_bind [meth_sig] NonRecursive
+ ) `thenTc` \ (meth_bind, meth_lie, _, _) ->
+
+ -- Now do context reduction. We simplify wrt both the local tyvars
+ -- and the ones of the class/instance decl, so that there is
+ -- no problem with
+ -- class C a where
+ -- op :: Eq a => a -> b -> a
+ --
+ -- We do this for each method independently to localise error messages
+
+ let
+ TySigInfo meth_id meth_tvs meth_theta _ local_meth_id _ _ = meth_sig
+ in
+ tcAddErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id)) $
+ newDicts SignatureOrigin meth_theta `thenNF_Tc` \ meth_dicts ->
+ let
+ all_tyvars = meth_tvs ++ inst_tyvars
+ all_insts = avail_insts ++ meth_dicts
+ in
+ tcSimplifyCheck
+ (ptext SLIT("class or instance method") <+> quotes (ppr sel_id))
+ all_tyvars all_insts meth_lie `thenTc` \ (lie, lie_binds) ->
+
+ checkSigTyVars all_tyvars `thenTc` \ all_tyvars' ->
+
+ let
+ meth_tvs' = take (length meth_tvs) all_tyvars'
+ poly_meth_bind = AbsBinds meth_tvs'
+ (map instToId meth_dicts)
+ [(meth_tvs', meth_id, local_meth_id)]
+ emptyNameSet -- Inlines?
+ (lie_binds `andMonoBinds` meth_bind)
+ in
+ returnTc (poly_meth_bind, lie)
+
+
+mkMethodBind :: InstOrigin
+ -> Class -> [TcType] -- Class and instance types
+ -> RenamedMonoBinds -- Method binding (pick the right one from in here)
+ -> ClassOpItem
+ -> TcM (Inst, -- Method inst
+ (Id, -- Global selector Id
+ TcSigInfo, -- Signature
+ RenamedMonoBinds)) -- Binding for the method
+
+mkMethodBind origin clas inst_tys meth_binds (sel_id, dm_info)