+ returnM (mb_inst, (sel_id, meth_id, meth_bind))
+
+mkMethId :: InstOrigin -> Class
+ -> Id -> [TcType] -- Selector, and instance types
+ -> TcM (Maybe Inst, Id)
+
+-- mkMethId instantiates the selector Id at the specified types
+-- THe
+mkMethId origin clas sel_id inst_tys
+ = let
+ (tyvars,rho) = tcSplitForAllTys (idType sel_id)
+ rho_ty = ASSERT( length tyvars == length inst_tys )
+ substTyWith tyvars inst_tys rho
+ (preds,tau) = tcSplitPhiTy rho_ty
+ first_pred = head preds
+ in
+ -- The first predicate should be of form (C a b)
+ -- where C is the class in question
+ ASSERT( not (null preds) &&
+ case getClassPredTys_maybe first_pred of
+ { Just (clas1,tys) -> clas == clas1 ; Nothing -> False }
+ )
+ if isSingleton preds then
+ -- If it's the only one, make a 'method'
+ getInstLoc origin `thenM` \ inst_loc ->
+ newMethod inst_loc sel_id inst_tys preds tau `thenM` \ meth_inst ->
+ returnM (Just meth_inst, instToId meth_inst)
+ else
+ -- If it's not the only one we need to be careful
+ -- For example, given 'op' defined thus:
+ -- class Foo a where
+ -- op :: (?x :: String) => a -> a
+ -- (mkMethId op T) should return an Inst with type
+ -- (?x :: String) => T -> T
+ -- That is, the class-op's context is still there.
+ -- BUT: it can't be a Method any more, because it breaks
+ -- INVARIANT 2 of methods. (See the data decl for Inst.)
+ newUnique `thenM` \ uniq ->
+ getSrcLocM `thenM` \ loc ->
+ let
+ real_tau = mkPhiTy (tail preds) tau
+ meth_id = mkUserLocal (getOccName sel_id) uniq real_tau loc
+ in
+ returnM (Nothing, meth_id)