+Note [Recursive superclasses]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+See Trac #1470 for why we would *like* to add "self_dict" to the
+available instances here. But we can't do so because then the superclases
+get satisfied by selection from self_dict, and that leads to an immediate
+loop. What we need is to add self_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 TcSpecPrag
+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 <- tcSubType (SpecPragOrigin name) (SigSkol SpecInstCtxt)
+ (idType dfun_id) spec_ty
+ ; return (SpecPrag dfun_id 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}
+tcInstanceMethods :: DFunId -> Class -> [TcTyVar]
+ -> [EvVar]
+ -> [TcType]
+ -> EvBind -- "This" and its binding
+ -> ([Located TcSpecPrag], PragFun)
+ -> [(Id, DefMeth)]
+ -> InstBindings Name
+ -> TcM ([Id], [LHsBind Id])
+ -- The returned inst_meth_ids all have types starting
+ -- forall tvs. theta => ...
+tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
+ self_dict_ev (spec_inst_prags, prag_fn)
+ op_items (VanillaInst binds _ standalone_deriv)
+ = mapAndUnzipM tc_item op_items
+ where
+ ----------------------
+ tc_item :: (Id, DefMeth) -> TcM (Id, LHsBind Id)
+ tc_item (sel_id, dm_info)
+ = case findMethodBind (idName sel_id) binds of
+ Just user_bind -> tc_body sel_id standalone_deriv user_bind
+ Nothing -> tc_default sel_id dm_info
+
+ ----------------------
+ tc_body :: Id -> Bool -> LHsBind Name -> TcM (TcId, LHsBind Id)
+ tc_body sel_id generated_code rn_bind
+ = add_meth_ctxt sel_id generated_code rn_bind $
+ do { (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars
+ inst_tys sel_id
+ ; let prags = prag_fn (idName sel_id)
+ ; meth_id1 <- addInlinePrags meth_id prags
+ ; spec_prags <- tcSpecPrags meth_id1 prags
+ ; bind <- tcInstanceMethodBody InstSkol
+ tyvars dfun_ev_vars mb_dict_ev
+ meth_id1 local_meth_id meth_sig_fn
+ (mk_meth_spec_prags meth_id1 spec_prags)
+ rn_bind
+ ; return (meth_id1, bind) }
+
+ ----------------------
+ tc_default :: Id -> DefMeth -> TcM (TcId, LHsBind Id)
+ tc_default sel_id GenDefMeth -- Derivable type classes stuff
+ = do { meth_bind <- mkGenericDefMethBind clas inst_tys sel_id
+ ; tc_body sel_id False {- Not generated code? -} meth_bind }
+
+ tc_default sel_id NoDefMeth -- No default method at all
+ = do { warnMissingMethod sel_id
+ ; (meth_id, _) <- mkMethIds clas tyvars dfun_ev_vars
+ inst_tys sel_id
+ ; return (meth_id, mkVarBind meth_id $
+ mkLHsWrap lam_wrapper error_rhs) }
+ where
+ 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 ])
+ lam_wrapper = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars
+
+ tc_default sel_id (DefMeth dm_name) -- A 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*.
+
+ ; (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars
+ inst_tys sel_id
+ ; dm_id <- tcLookupId dm_name
+ ; let dm_inline_prag = idInlinePragma dm_id
+ EvBind self_dict _ = self_dict_ev
+ rhs = HsWrap (mkWpEvVarApps [self_dict] <.> mkWpTyApps inst_tys) $
+ HsVar dm_id
+
+ 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_ev_vars = dfun_ev_vars
+ , abs_exports = [( tyvars, meth_id1, local_meth_id
+ , mk_meth_spec_prags meth_id1 [])]
+ , abs_ev_binds = EvBinds (unitBag self_dict_ev)
+ , abs_binds = 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) }
+
+ ----------------------
+ mk_meth_spec_prags :: Id -> [LTcSpecPrag] -> TcSpecPrags
+ -- Adapt the SPECIALISE pragmas to work for this method Id
+ -- There are two sources:
+ -- * spec_inst_prags: {-# SPECIALISE instance :: <blah> #-}
+ -- These ones have the dfun inside, but [perhaps surprisingly]
+ -- the correct wrapper
+ -- * spec_prags_for_me: {-# SPECIALISE op :: <blah> #-}
+ mk_meth_spec_prags meth_id spec_prags_for_me
+ = SpecPrags (spec_prags_for_me ++
+ [ L loc (SpecPrag meth_id wrap inl)
+ | L loc (SpecPrag _ wrap inl) <- spec_inst_prags])
+
+ loc = getSrcSpan dfun_id
+ meth_sig_fn _ = Just ([],loc) -- 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!
+
+ mb_dict_ev = if null tyvars then Nothing else Just self_dict_ev
+ -- Only need the self_dict stuff if there are type
+ -- variables involved; otherwise overlap is not possible
+ -- See Note [Subtle interaction of recursion and overlap]
+ -- in TcInstDcls
+
+ -- 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 sel_id generated_code rn_bind thing
+ | generated_code = addLandmarkErrCtxt (derivBindCtxt sel_id clas inst_tys rn_bind) thing
+ | otherwise = thing
+
+
+tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
+ _ _ op_items (NewTypeDerived coi _)
+
+-- Running example:
+-- class Show b => Foo a b where
+-- op :: a -> b -> b
+-- newtype N a = MkN (Tree [a])
+-- deriving instance (Show p, Foo Int p) => Foo Int (N p)
+-- -- NB: standalone deriving clause means
+-- -- that the contex is user-specified
+-- Hence op :: forall a b. Foo a b => a -> b -> b