+Note [Recursive superclasses]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+See Trac #1470 for why we would *like* to add "this_dict" to the
+available instances here. But we can't do so because then the superclases
+get satisfied by selection from this_dict, and that leads to an immediate
+loop. What we need is to add this_dict to Avails without adding its
+superclasses, and we currently have no way to do that.
+
+Note [SPECIALISE instance pragmas]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+
+ instance (Ix a, Ix b) => Ix (a,b) where
+ {-# SPECIALISE instance Ix (Int,Int) #-}
+ range (x,y) = ...
+
+We do *not* want to make a specialised version of the dictionary
+function. Rather, we want specialised versions of each method.
+Thus we should generate something like this:
+
+ $dfIx :: (Ix a, Ix x) => Ix (a,b)
+ {- DFUN [$crange, ...] -}
+ $dfIx da db = Ix ($crange da db) (...other methods...)
+
+ $dfIxPair :: (Ix a, Ix x) => Ix (a,b)
+ {- DFUN [$crangePair, ...] -}
+ $dfIxPair = Ix ($crangePair da db) (...other methods...)
+
+ $crange :: (Ix a, Ix b) -> ((a,b),(a,b)) -> [(a,b)]
+ {-# SPECIALISE $crange :: ((Int,Int),(Int,Int)) -> [(Int,Int)] #-}
+ $crange da db = <blah>
+
+ {-# RULE range ($dfIx da db) = $crange da db #-}
+
+Note that
+
+ * The RULE is unaffected by the specialisation. We don't want to
+ specialise $dfIx, because then it would need a specialised RULE
+ which is a pain. The single RULE works fine at all specialisations.
+ See Note [How instance declarations are translated] above
+
+ * Instead, we want to specialise the *method*, $crange
+
+In practice, rather than faking up a SPECIALISE pragama for each
+method (which is painful, since we'd have to figure out its
+specialised type), we call tcSpecPrag *as if* were going to specialise
+$dfIx -- you can see that in the call to tcSpecInst. That generates a
+SpecPrag which, as it turns out, can be used unchanged for each method.
+The "it turns out" bit is delicate, but it works fine!
+
+\begin{code}
+tcSpecInst :: Id -> Sig Name -> TcM SpecPrag
+tcSpecInst dfun_id prag@(SpecInstSig hs_ty)
+ = addErrCtxt (spec_ctxt prag) $
+ do { let name = idName dfun_id
+ ; (tyvars, theta, tau) <- tcHsInstHead hs_ty
+ ; let spec_ty = mkSigmaTy tyvars theta tau
+ ; co_fn <- tcSubExp (SpecPragOrigin name) (idType dfun_id) spec_ty
+ ; return (SpecPrag co_fn defaultInlinePragma) }
+ where
+ spec_ctxt prag = hang (ptext (sLit "In the SPECIALISE pragma")) 2 (ppr prag)
+
+tcSpecInst _ _ = panic "tcSpecInst"
+\end{code}
+
+%************************************************************************
+%* *
+ Type-checking an instance method
+%* *
+%************************************************************************
+
+tcInstanceMethod
+- Make the method bindings, as a [(NonRec, HsBinds)], one per method
+- Remembering to use fresh Name (the instance method Name) as the binder
+- Bring the instance method Ids into scope, for the benefit of tcInstSig
+- Use sig_fn mapping instance method Name -> instance tyvars
+- Ditto prag_fn
+- Use tcValBinds to do the checking
+
+\begin{code}
+tcInstanceMethod :: SrcSpan -> Bool -> Class -> [TcTyVar] -> [Inst]
+ -> [TcType]
+ -> (Inst, LHsBinds Id) -- "This" and its binding
+ -> TcPragFun -- Local prags
+ -> [LSpecPrag] -- Arising from 'SPECLALISE instance'
+ -> LHsBinds Name
+ -> (Id, DefMeth)
+ -> TcM (Id, LHsBind Id)
+ -- The returned inst_meth_ids all have types starting
+ -- forall tvs. theta => ...
+
+tcInstanceMethod loc standalone_deriv clas tyvars dfun_dicts inst_tys
+ (this_dict, this_dict_bind)
+ prag_fn spec_inst_prags binds_in (sel_id, dm_info)
+ = do { uniq <- newUnique
+ ; let meth_name = mkDerivedInternalName mkClassOpAuxOcc uniq sel_name
+ ; local_meth_name <- newLocalName sel_name
+ -- Base the local_meth_name on the selector name, becuase
+ -- type errors from tcInstanceMethodBody come from here
+
+ ; let local_meth_ty = instantiateMethod clas sel_id inst_tys
+ meth_ty = mkSigmaTy tyvars (map dictPred dfun_dicts) local_meth_ty
+ meth_id = mkLocalId meth_name meth_ty
+ local_meth_id = mkLocalId local_meth_name local_meth_ty
+
+ --------------
+ tc_body rn_bind
+ = add_meth_ctxt rn_bind $
+ do { (meth_id1, spec_prags) <- tcPrags NonRecursive False True
+ meth_id (prag_fn sel_name)
+ ; tcInstanceMethodBody (instLoc this_dict)
+ tyvars dfun_dicts
+ ([this_dict], this_dict_bind)
+ meth_id1 local_meth_id
+ meth_sig_fn
+ (spec_inst_prags ++ spec_prags)
+ rn_bind }
+
+ --------------
+ tc_default :: DefMeth -> TcM (Id, LHsBind Id)
+ -- The user didn't supply a method binding, so we have to make
+ -- up a default binding, in a way depending on the default-method info
+
+ tc_default NoDefMeth -- No default method at all
+ = do { warnMissingMethod sel_id
+ ; return (meth_id, mkVarBind meth_id $
+ mkLHsWrap lam_wrapper error_rhs) }
+
+ tc_default GenDefMeth -- Derivable type classes stuff
+ = do { meth_bind <- mkGenericDefMethBind clas inst_tys sel_id local_meth_name
+ ; tc_body meth_bind }
+
+ tc_default DefMeth -- An polymorphic default method
+ = do { -- Build the typechecked version directly,
+ -- without calling typecheck_method;
+ -- see Note [Default methods in instances]
+ -- Generate /\as.\ds. let this = df as ds
+ -- in $dm inst_tys this
+ -- The 'let' is necessary only because HsSyn doesn't allow
+ -- you to apply a function to a dictionary *expression*.
+ dm_name <- lookupGlobalOccRn (mkDefMethRdrName sel_name)
+ -- Might not be imported, but will be an OrigName
+ ; dm_id <- tcLookupId dm_name
+ ; inline_id <- tcLookupId inlineIdName
+ ; let dm_inline_prag = idInlinePragma dm_id
+ dm_app = HsWrap (WpApp (instToId this_dict) <.> mkWpTyApps inst_tys) $
+ HsVar dm_id
+ rhs | isInlinePragma dm_inline_prag -- See Note [INLINE and default methods]
+ = HsApp (L loc (HsWrap (WpTyApp local_meth_ty) (HsVar inline_id)))
+ (L loc dm_app)
+ | otherwise = dm_app
+
+ meth_bind = L loc $ VarBind { var_id = local_meth_id
+ , var_rhs = L loc rhs
+ , var_inline = False }
+ meth_id1 = meth_id `setInlinePragma` dm_inline_prag
+ -- Copy the inline pragma (if any) from the default
+ -- method to this version. Note [INLINE and default methods]
+
+ bind = AbsBinds { abs_tvs = tyvars, abs_dicts = dfun_lam_vars
+ , abs_exports = [( tyvars, meth_id1
+ , local_meth_id, spec_inst_prags)]
+ , abs_binds = this_dict_bind `unionBags` unitBag meth_bind }
+ -- Default methods in an instance declaration can't have their own
+ -- INLINE or SPECIALISE pragmas. It'd be possible to allow them, but
+ -- currently they are rejected with
+ -- "INLINE pragma lacks an accompanying binding"
+
+ ; return (meth_id1, L loc bind) }
+
+ ; case findMethodBind sel_name local_meth_name binds_in of
+ Just user_bind -> tc_body user_bind -- User-supplied method binding
+ Nothing -> tc_default dm_info -- None supplied
+ }
+ where
+ sel_name = idName sel_id
+
+ meth_sig_fn _ = Just [] -- The 'Just' says "yes, there's a type sig"
+ -- But there are no scoped type variables from local_method_id
+ -- Only the ones from the instance decl itself, which are already
+ -- in scope. Example:
+ -- class C a where { op :: forall b. Eq b => ... }
+ -- instance C [c] where { op = <rhs> }
+ -- In <rhs>, 'c' is scope but 'b' is not!
+
+ error_rhs = L loc $ HsApp error_fun error_msg
+ error_fun = L loc $ wrapId (WpTyApp meth_tau) nO_METHOD_BINDING_ERROR_ID
+ error_msg = L loc (HsLit (HsStringPrim (mkFastString error_string)))
+ meth_tau = funResultTy (applyTys (idType sel_id) inst_tys)
+ error_string = showSDoc (hcat [ppr loc, text "|", ppr sel_id ])
+
+ dfun_lam_vars = map instToVar dfun_dicts
+ lam_wrapper = mkWpTyLams tyvars <.> mkWpLams dfun_lam_vars
+
+ -- For instance decls that come from standalone deriving clauses
+ -- we want to print out the full source code if there's an error
+ -- because otherwise the user won't see the code at all
+ add_meth_ctxt rn_bind thing
+ | standalone_deriv = addLandmarkErrCtxt (derivBindCtxt clas inst_tys rn_bind) thing
+ | otherwise = thing
+
+wrapId :: HsWrapper -> id -> HsExpr id
+wrapId wrapper id = mkHsWrap wrapper (HsVar id)
+
+derivBindCtxt :: Class -> [Type ] -> LHsBind Name -> SDoc
+derivBindCtxt clas tys bind
+ = vcat [ ptext (sLit "When typechecking a standalone-derived method for")
+ <+> quotes (pprClassPred clas tys) <> colon
+ , nest 2 $ pprSetDepth AllTheWay $ ppr bind ]
+
+warnMissingMethod :: Id -> TcM ()
+warnMissingMethod sel_id
+ = do { warn <- doptM Opt_WarnMissingMethods
+ ; warnTc (warn -- Warn only if -fwarn-missing-methods
+ && not (startsWithUnderscore (getOccName sel_id)))
+ -- Don't warn about _foo methods
+ (ptext (sLit "No explicit method nor default method for")
+ <+> quotes (ppr sel_id)) }
+\end{code}
+
+Note [Export helper functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We arrange to export the "helper functions" of an instance declaration,
+so that they are not subject to preInlineUnconditionally, even if their
+RHS is trivial. Reason: they are mentioned in the DFunUnfolding of
+the dict fun as Ids, not as CoreExprs, so we can't substitute a
+non-variable for them.
+
+We could change this by making DFunUnfoldings have CoreExprs, but it
+seems a bit simpler this way.
+
+Note [Default methods in instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this
+
+ class Baz v x where
+ foo :: x -> x
+ foo y = <blah>
+
+ instance Baz Int Int
+
+From the class decl we get
+
+ $dmfoo :: forall v x. Baz v x => x -> x
+ $dmfoo y = <blah>
+
+Notice that the type is ambiguous. That's fine, though. The instance decl generates
+
+ $dBazIntInt = MkBaz fooIntInt
+ fooIntInt = $dmfoo Int Int $dBazIntInt
+
+BUT this does mean we must generate the dictionary translation of
+fooIntInt directly, rather than generating source-code and
+type-checking it. That was the bug in Trac #1061. In any case it's
+less work to generate the translated version!
+
+Note [INLINE and default methods]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We *copy* any INLINE pragma from the default method to the instance.
+Example:
+ class Foo a where
+ op1, op2 :: Bool -> a -> a
+
+ {-# INLINE op1 #-}
+ op1 b x = op2 (not b) x
+
+ instance Foo Int where
+ op2 b x = <blah>
+
+Then we generate:
+
+ {-# INLINE $dmop1 #-}
+ $dmop1 d b x = op2 d (not b) x
+
+ $fFooInt = MkD $cop1 $cop2
+
+ {-# INLINE $cop1 #-}
+ $cop1 = inline $dmop1 $fFooInt
+
+ $cop2 = <blah>
+
+Note carefully:
+ a) We copy $dmop1's inline pragma to $cop1. Otherwise
+ we'll just inline the former in the latter and stop, which
+ isn't what the user expected
+
+ b) We use the magic 'inline' Id to ensure that $dmop1 really is
+ inlined in $cop1, even though the latter itself has an INLINE pragma
+ That is important to allow the mutual recursion between $fooInt and
+ $cop1 to be broken