- meth_id = mkUserLocal (getOccName sel_id) uniq real_tau
- (srcSpanStart loc) --TODO
- in
- returnM (Nothing, meth_id)
-
- -- The user didn't supply a method binding,
- -- so we have to make up a default binding
- -- The RHS of a default method depends on the default-method info
-mkDefMethRhs origin clas inst_tys sel_id loc DefMeth
- = -- An polymorphic default method
- lookupImportedName (mkDefMethRdrName sel_id) `thenM` \ dm_name ->
- -- Might not be imported, but will be an OrigName
- traceRn (text "mkDefMeth" <+> ppr dm_name) `thenM_`
- returnM (nlHsVar dm_name)
-
-mkDefMethRhs origin clas inst_tys sel_id loc NoDefMeth
- = -- No default method
- -- Warn only if -fwarn-missing-methods
- doptM Opt_WarnMissingMethods `thenM` \ warn ->
- warnTc (isInstDecl origin
- && warn
- && reportIfUnused (getOccName sel_id))
- (omittedMethodWarn sel_id) `thenM_`
- returnM error_rhs
- where
- error_rhs = noLoc $ HsLam (mkMatchGroup [mkSimpleMatch wild_pats simple_rhs])
- simple_rhs = nlHsApp (nlHsVar (getName nO_METHOD_BINDING_ERROR_ID))
- (nlHsLit (HsStringPrim (mkFastString error_msg)))
- error_msg = showSDoc (hcat [ppr loc, text "|", ppr sel_id ])
-
- -- When the type is of form t1 -> t2 -> t3
- -- make a default method like (\ _ _ -> noMethBind "blah")
- -- rather than simply (noMethBind "blah")
- -- Reason: if t1 or t2 are higher-ranked types we get n
- -- silly ambiguity messages.
- -- Example: f :: (forall a. Eq a => a -> a) -> Int
- -- f = error "urk"
- -- Here, tcSub tries to force (error "urk") to have the right type,
- -- thus: f = \(x::forall a. Eq a => a->a) -> error "urk" (x t)
- -- where 't' is fresh ty var. This leads directly to "ambiguous t".
- --
- -- NB: technically this changes the meaning of the default-default
- -- method slightly, because `seq` can see the lambdas. Oh well.
- (_,_,tau1) = tcSplitSigmaTy (idType sel_id)
- (_,_,tau2) = tcSplitSigmaTy tau1
- -- Need two splits because the selector can have a type like
- -- forall a. Foo a => forall b. Eq b => ...
- (arg_tys, _) = tcSplitFunTys tau2
- wild_pats = [nlWildPat | ty <- arg_tys]
-
-mkDefMethRhs origin clas inst_tys sel_id loc GenDefMeth
+ meth_id = mkUserLocal (getOccName sel_id) uniq real_tau loc
+
+ return (Nothing, meth_id)
+
+---------------------------
+-- The renamer just puts the selector ID as the binder in the method binding
+-- but we must use the method name; so we substitute it here. Crude but simple.
+find_bind :: Name -> Name -- Selector and method name
+ -> LHsBinds Name -- A group of bindings
+ -> Maybe (LHsBind Name) -- The binding, with meth_name replacing sel_name
+find_bind sel_name meth_name binds
+ = foldlBag mplus Nothing (mapBag f binds)
+ where
+ f (L loc1 bind@(FunBind { fun_id = L loc2 op_name })) | op_name == sel_name
+ = Just (L loc1 (bind { fun_id = L loc2 meth_name }))
+ f _other = Nothing
+
+---------------------------
+mkGenericDefMethBind clas inst_tys sel_id meth_name