+ is_vanilla = case condecls of -- Yuk
+ [] -> True
+ L _ (ConDecl {}) : _ -> True
+ other -> False
+
+ data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
+ con_names = map con_names_helper condecls
+
+ con_names_helper (L _ (ConDecl n _ _ _)) = n
+ con_names_helper (L _ (GadtDecl n _)) = n
+
+ rn_derivs Nothing = returnM (Nothing, emptyFVs)
+ rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
+ returnM (Just ds', extractHsTyNames_s ds')
+
+rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
+ = lookupLocatedTopBndrRn name `thenM` \ name' ->
+ bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
+ rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
+ returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
+ tcdSynRhs = ty'},
+ delFVs (map hsLTyVarName tyvars') fvs)
+ where
+ syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
+
+rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
+ tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
+ tcdMeths = mbinds})
+ = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
+
+ -- Tyvars scope over superclass context and method signatures
+ bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
+ rnContext cls_doc context `thenM` \ context' ->
+ rnFds cls_doc fds `thenM` \ fds' ->
+ renameSigs sigs `thenM` \ sigs' ->
+ returnM (tyvars', context', fds', sigs')
+ ) `thenM` \ (tyvars', context', fds', sigs') ->
+
+ -- Check the signatures
+ -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
+ let
+ sig_rdr_names_w_locs = [op | L _ (Sig op _) <- sigs]
+ in
+ checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
+ checkSigs okClsDclSig sigs' `thenM_`
+ -- Typechecker is responsible for checking that we only
+ -- give default-method bindings for things in this class.
+ -- The renamer *could* check this for class decls, but can't
+ -- for instance decls.
+
+ -- The newLocals call is tiresome: given a generic class decl
+ -- class C a where
+ -- op :: a -> a
+ -- op {| x+y |} (Inl a) = ...
+ -- op {| x+y |} (Inr b) = ...
+ -- op {| a*b |} (a*b) = ...
+ -- we want to name both "x" tyvars with the same unique, so that they are
+ -- easy to group together in the typechecker.
+ extendTyVarEnvForMethodBinds tyvars' (
+ getLocalRdrEnv `thenM` \ name_env ->
+ let
+ meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
+ gen_rdr_tyvars_w_locs =
+ [ tv | tv <- extractGenericPatTyVars mbinds,
+ not (unLoc tv `elemLocalRdrEnv` name_env) ]
+ in
+ checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
+ newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
+ rnMethodBinds (unLoc cname') gen_tyvars mbinds
+ ) `thenM` \ (mbinds', meth_fvs) ->
+
+ returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
+ tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
+ delFVs (map hsLTyVarName tyvars') $
+ extractHsCtxtTyNames context' `plusFV`
+ plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
+ hsSigsFVs sigs' `plusFV`
+ meth_fvs)
+ where
+ meth_doc = text "In the default-methods for class" <+> ppr cname
+ cls_doc = text "In the declaration for class" <+> ppr cname
+ sig_doc = text "In the signatures for class" <+> ppr cname