+ ; when (not (null inst_info)) $
+ dumpDerivingInfo (ddump_deriving inst_info rn_binds)
+
+ ; return (inst_info, rn_binds, rn_dus) }
+ where
+ ddump_deriving :: [InstInfo Name] -> HsValBinds Name -> SDoc
+ ddump_deriving inst_infos extra_binds
+ = hang (ptext (sLit "Derived instances"))
+ 2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos)
+ $$ ppr extra_binds)
+
+renameDeriv :: Bool -> LHsBinds RdrName
+ -> [(InstInfo RdrName, DerivAuxBinds)]
+ -> TcM ([InstInfo Name], HsValBinds Name, DefUses)
+renameDeriv is_boot gen_binds insts
+ | is_boot -- If we are compiling a hs-boot file, don't generate any derived bindings
+ -- The inst-info bindings will all be empty, but it's easier to
+ -- just use rn_inst_info to change the type appropriately
+ = do { (rn_inst_infos, fvs) <- mapAndUnzipM rn_inst_info inst_infos
+ ; return (rn_inst_infos, emptyValBindsOut, usesOnly (plusFVs fvs)) }
+
+ | otherwise
+ = discardWarnings $ -- Discard warnings about unused bindings etc
+ do { (rn_gen, dus_gen) <- setOptM Opt_ScopedTypeVariables $ -- Type signatures in patterns
+ -- are used in the generic binds
+ rnTopBinds (ValBindsIn gen_binds [])
+ ; keepAliveSetTc (duDefs dus_gen) -- Mark these guys to be kept alive
+
+ -- Generate and rename any extra not-one-inst-decl-specific binds,
+ -- notably "con2tag" and/or "tag2con" functions.
+ -- Bring those names into scope before renaming the instances themselves
+ ; loc <- getSrcSpanM -- Generic loc for shared bindings
+ ; let (aux_binds, aux_sigs) = unzip $ map (genAuxBind loc) $
+ rm_dups [] $ concat deriv_aux_binds
+ aux_val_binds = ValBindsIn (listToBag aux_binds) aux_sigs
+ ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
+ ; bindLocalNames (collectHsValBinders rn_aux_lhs) $
+ do { (rn_aux, dus_aux) <- rnTopBindsRHS rn_aux_lhs
+ ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
+ ; return (rn_inst_infos, rn_aux `plusHsValBinds` rn_gen,
+ dus_gen `plusDU` dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
+
+ where
+ (inst_infos, deriv_aux_binds) = unzip insts
+
+ -- Remove duplicate requests for auxilliary bindings
+ rm_dups acc [] = acc
+ rm_dups acc (b:bs) | any (isDupAux b) acc = rm_dups acc bs
+ | otherwise = rm_dups (b:acc) bs
+
+
+ rn_inst_info :: InstInfo RdrName -> TcM (InstInfo Name, FreeVars)
+ rn_inst_info info@(InstInfo { iBinds = NewTypeDerived coi tc })
+ = return ( info { iBinds = NewTypeDerived coi tc }
+ , mkFVs (map dataConName (tyConDataCons tc)))
+ -- See Note [Newtype deriving and unused constructors]
+
+ rn_inst_info inst_info@(InstInfo { iSpec = inst, iBinds = VanillaInst binds sigs standalone_deriv })
+ = -- Bring the right type variables into
+ -- scope (yuk), and rename the method binds
+ ASSERT( null sigs )
+ bindLocalNames (map Var.varName tyvars) $
+ do { (rn_binds, fvs) <- rnMethodBinds clas_nm (\_ -> []) [] binds
+ ; let binds' = VanillaInst rn_binds [] standalone_deriv
+ ; return (inst_info { iBinds = binds' }, fvs) }
+ where
+ (tyvars,_, clas,_) = instanceHead inst
+ clas_nm = className clas