- data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
- con_names = map conDeclName condecls
-
-rnDecl (TyClD (TySynonym name tyvars ty src_loc))
- = pushSrcLocRn src_loc $
- lookupBndrRn name `thenRn` \ name' ->
- bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
- rnHsType syn_doc (unquantify ty) `thenRn` \ (ty', ty_fvs) ->
- returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
- where
- syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
-
- -- For H98 we do *not* universally quantify on the RHS of a synonym
- -- Silently discard context... but the tyvars in the rest won't be in scope
- unquantify (HsForAllTy Nothing ctxt ty) | not opt_GlasgowExts = ty
- unquantify ty = ty
-
-rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas
- tname dname dwname snames src_loc))
- = pushSrcLocRn src_loc $
-
- lookupBndrRn cname `thenRn` \ cname' ->
-
- -- Deal with the implicit tycon and datacon name
- -- They aren't in scope (because they aren't visible to the user)
- -- and what we want to do is simply look them up in the cache;
- -- we jolly well ought to get a 'hit' there!
- -- So the 'Imported' part of this call is not relevant.
- -- Unclean; but since these two are the only place this happens
- -- I can't work up the energy to do it more beautifully
- mkImportedGlobalFromRdrName tname `thenRn` \ tname' ->
- mkImportedGlobalFromRdrName dname `thenRn` \ dname' ->
- mkImportedGlobalFromRdrName dwname `thenRn` \ dwname' ->
- mapRn mkImportedGlobalFromRdrName snames `thenRn` \ snames' ->
-
- -- Tyvars scope over bindings and context
- bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
-
- -- Check the superclasses
- rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
-
- -- Check the functional dependencies
- rnFds cls_doc fds `thenRn` \ (fds', fds_fvs) ->
-
- -- Check the signatures
- let
- -- First process the class op sigs, then the fixity sigs.
- (op_sigs, non_op_sigs) = partition isClassOpSig sigs
- in
- checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
- mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs `thenRn` \ (sigs', sig_fvs) ->
- let
- binders = mkNameSet [ nm | (ClassOpSig nm _ _ _ _) <- sigs' ]
- in
- renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ (non_ops', fix_fvs) ->
-
- -- Check the methods
- checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
- rnMethodBinds mbinds
- `thenRn` \ (mbinds', meth_fvs) ->
-
- -- 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.
-
- ASSERT(isNoClassPragmas pragmas)
- returnRn (TyClD (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
- NoClassPragmas tname' dname' dwname' snames' src_loc),
- sig_fvs `plusFV`
- fix_fvs `plusFV`
- cxt_fvs `plusFV`
- fds_fvs `plusFV`
- meth_fvs
- )
- )
- where
- cls_doc = text "the declaration for class" <+> ppr cname
- sig_doc = text "the signatures for class" <+> ppr cname
- meth_doc = text "the default-methods for class" <+> ppr cname
-
- sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ _ locn <- sigs]
- meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
- meth_rdr_names = map fst meth_rdr_names_w_locs
-
- rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op dm_rdr_name explicit_dm ty locn)
- = pushSrcLocRn locn $
- lookupBndrRn op `thenRn` \ op_name ->
-
- -- Check the signature
- rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
- let
- check_in_op_ty clas_tyvar =
- checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
- (classTyVarNotInOpTyErr clas_tyvar sig)
- in
- mapRn_ check_in_op_ty clas_tyvars `thenRn_`
-
- -- Make the default-method name
- getModeRn `thenRn` \ mode ->
- (case mode of
- SourceMode -> -- Source class decl
- newImplicitBinder (mkDefaultMethodOcc (rdrNameOcc op)) locn `thenRn` \ dm_name ->
- returnRn (dm_name, op `elem` meth_rdr_names, emptyFVs)
-
- InterfaceMode
- -> -- Imported class that has a default method decl
- -- See comments with tname, snames, above
- lookupImplicitOccRn dm_rdr_name `thenRn` \ dm_name ->
- returnRn (dm_name, explicit_dm, if explicit_dm then unitFV dm_name else emptyFVs)
- -- An imported class decl for a class decl that had an explicit default
- -- method, mentions, rather than defines,
- -- the default method, so we must arrange to pull it in
- ) `thenRn` \ (dm_name, final_explicit_dm, dm_fvs) ->
-
- returnRn (ClassOpSig op_name dm_name final_explicit_dm new_ty locn, op_ty_fvs `plusFV` dm_fvs)