+%************************************************************************
+%* *
+\subsection{Typechecking a method}
+%* *
+%************************************************************************
+
+@tcMethodBind@ is used to type-check both default-method and
+instance-decl method declarations. We must type-check methods one at a
+time, because their signatures may have different contexts and
+tyvar sets.
+
+\begin{code}
+tcMethodBind
+ :: [(TyVar,TcTyVar)] -- Bindings for type environment
+ -> [TcTyVar] -- Instantiated type variables for the
+ -- 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
+ -> [RenamedSig] -- Pragmas (e.g. inline pragmas)
+ -> (Id, TcSigInfo, RenamedMonoBinds) -- Details of this method
+ -> TcM TcMonoBinds
+
+tcMethodBind xtve inst_tyvars inst_theta avail_insts prags
+ (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 (
+ addErrCtxt (methodCtxt sel_id) $
+ getLIE (tcMonoBinds meth_bind [meth_sig] NonRecursive)
+ ) `thenM` \ ((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
+ addErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id)) $
+ newDicts SignatureOrigin meth_theta `thenM` \ 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 `thenM` \ lie_binds ->
+
+ checkSigTyVars all_tyvars `thenM` \ all_tyvars' ->
+
+ let
+ -- Attach inline pragmas as appropriate
+ (final_meth_id, inlines)
+ | (InlineSig inl _ phase _ : _) <- filter is_inline prags
+ = (meth_id `setInlinePragma` phase,
+ if inl then unitNameSet (idName meth_id) else emptyNameSet)
+ | otherwise
+ = (meth_id, emptyNameSet)
+
+ is_inline (InlineSig _ name _ _) = name == idName sel_id
+ is_inline other = False
+
+ meth_tvs' = take (length meth_tvs) all_tyvars'
+ poly_meth_bind = AbsBinds meth_tvs'
+ (map instToId meth_dicts)
+ [(meth_tvs', final_meth_id, local_meth_id)]
+ inlines
+ (lie_binds `andMonoBinds` meth_bind)
+ in
+ returnM poly_meth_bind
+
+
+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)
+ = getInstLoc origin `thenM` \ inst_loc ->
+ newMethodAtLoc inst_loc sel_id inst_tys `thenM` \ meth_inst ->
+ -- Do not dump anything into the LIE