-\subsection{Processing each method}
-%* *
-%************************************************************************
-
-\begin{code}
-tcInstMethodBind
- :: Class
- -> [TcType s] -- Instance types
- -> [TcTyVar s] -- and their free (sig) tyvars
- -> RenamedMonoBinds -- Method binding
- -> [RenamedSig] -- Pragmas
- -> (Id, Maybe Id) -- Selector id and default-method id
- -> TcM s (TcMonoBinds s, LIE s, (LIE s, TcIdOcc s))
-
-tcInstMethodBind clas inst_tys inst_tyvars meth_binds prags (sel_id, maybe_dm_id)
- = tcGetSrcLoc `thenNF_Tc` \ loc ->
- tcGetUnique `thenNF_Tc` \ uniq ->
- let
- sel_name = idName sel_id
- meth_occ = getOccName sel_name
- default_meth_name = mkLocalName uniq meth_occ loc
- maybe_meth_bind = find sel_name meth_binds
- the_meth_bind = case maybe_meth_bind of
- Just stuff -> stuff
- Nothing -> mk_default_bind default_meth_name loc
- meth_prags = sigsForMe (== sel_name) prags
- in
-
- -- Warn if no method binding, only if -fwarn-missing-methods
-
- warnTc (opt_WarnMissingMethods &&
- not (maybeToBool maybe_meth_bind) &&
- not (maybeToBool maybe_dm_id))
- (omittedMethodWarn sel_id clas) `thenNF_Tc_`
-
- -- Typecheck the method binding
- tcMethodBind clas origin inst_tys inst_tyvars sel_id the_meth_bind meth_prags
- where
- origin = InstanceDeclOrigin -- Poor
-
- find sel EmptyMonoBinds = Nothing
- find sel (AndMonoBinds b1 b2) = find sel b1 `seqMaybe` find sel b2
-
- find sel b@(FunMonoBind op_name _ _ _) | op_name == sel = Just b
- | otherwise = Nothing
- find sel b@(PatMonoBind (VarPatIn op_name) _ _) | op_name == sel = Just b
- | otherwise = Nothing
- find sel other = panic "Urk! Bad instance method binding"
-
-
- mk_default_bind local_meth_name loc
- = PatMonoBind (VarPatIn local_meth_name)
- (GRHSsAndBindsIn (unguardedRHS (default_expr loc) loc) EmptyBinds)
- loc
-
- default_expr loc
- = case maybe_dm_id of
- Just dm_id -> HsVar (getName dm_id) -- There's a default method
- Nothing -> error_expr loc -- No default method
-
- error_expr loc
- = HsApp (HsVar (getName nO_METHOD_BINDING_ERROR_ID))
- (HsLit (HsString (_PK_ (error_msg loc))))
-
- error_msg loc = showSDoc (hcat [ppr loc, text "|", ppr sel_id ])
-\end{code}
-
-
-
-%************************************************************************
-%* *