\begin{code}
module RnSource (
rnSrcDecls, addTcgDUs,
- rnTyClDecls, checkModDeprec,
+ rnTyClDecls,
rnSplice, checkTH
) where
import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
import RnEnv ( lookupLocalDataTcNames,
lookupLocatedTopBndrRn, lookupLocatedOccRn,
- lookupOccRn, lookupTopBndrRn, newLocalsRn,
+ lookupOccRn, newLocalsRn,
bindLocatedLocalsFV, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalNames, checkDupNames, mapFvRn
import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcRnMonad
-import HscTypes ( FixityEnv, FixItem(..),
- Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
+import HscTypes ( FixityEnv, FixItem(..), Deprecations, Deprecs(..), plusDeprecs )
import Class ( FunDep )
import Name ( Name, nameOccName )
import NameSet
import SrcLoc ( Located(..), unLoc, noLoc )
import DynFlags ( DynFlag(..) )
import Maybes ( seqMaybe )
-import Maybe ( isNothing, isJust )
+import Maybe ( isNothing )
import Monad ( liftM, when )
import BasicTypes ( Boxity(..) )
\end{code}
hs_fords = foreign_decls,
hs_defds = default_decls,
hs_ruleds = rule_decls,
- hs_docs = docs })
+ hs_docs = docs })
= do { -- Deal with deprecations (returns only the extra deprecations)
deprecs <- rnSrcDeprecDecls deprec_decls ;
-- Deal with top-level fixity decls
-- (returns the total new fixity env)
rn_fix_decls <- rnSrcFixityDecls fix_decls ;
- fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
- updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
- $ do {
-
- -- Rename other declarations
- traceRn (text "Start rnmono") ;
- (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
- traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
+ tcg_env <- extendGblFixityEnv rn_fix_decls ;
+ setGblEnv tcg_env $ do {
+ -- Rename type and class decls
-- You might think that we could build proper def/use information
-- for type and class declarations, but they can be involved
-- in mutual recursion across modules, and we only do the SCC
-- means we'll only report a declaration as unused if it isn't
-- mentioned at all. Ah well.
traceRn (text "Start rnTyClDecls") ;
- (rn_tycl_decls, src_fvs1)
- <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
- traceRn (text "finish rnTyClDecls") ;
- (rn_inst_decls, src_fvs2)
- <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
- (rn_deriv_decls, src_fvs_deriv)
- <- mapFvRn (wrapLocFstM rnSrcDerivDecl) deriv_decls ;
- (rn_rule_decls, src_fvs3)
- <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
- (rn_foreign_decls, src_fvs4)
- <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
- (rn_default_decls, src_fvs5)
- <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
-
- rn_docs <- rnDocEntities docs ;
+ (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
+
+ -- Extract the mapping from data constructors to field names
+ tcg_env <- extendRecordFieldEnv rn_tycl_decls ;
+ setGblEnv tcg_env $ do {
+
+ -- Value declarations
+ traceRn (text "Start rnmono") ;
+ (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
+ traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
+
+ -- Other decls
+ (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
+ (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
+ (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
+ (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
+ (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
+
+ -- Haddock docs; no free vars
+ rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
let {
rn_group = HsGroup { hs_valds = rn_val_decls,
hs_fords = rn_foreign_decls,
hs_defds = rn_default_decls,
hs_ruleds = rn_rule_decls,
- hs_docs = rn_docs } ;
+ hs_docs = rn_docs } ;
- other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs_deriv, src_fvs3,
+ other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
src_fvs4, src_fvs5] ;
src_dus = bind_dus `plusDU` usesOnly other_fvs
-- Note: src_dus will contain *uses* for locally-defined types
traceRn (text "finish rnSrc" <+> ppr rn_group) ;
traceRn (text "finish Dus" <+> ppr src_dus ) ;
- tcg_env <- getGblEnv ;
return (tcg_env `addTcgDUs` src_dus, rn_group)
- }}}
+ }}}}
rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
-rnTyClDecls tycl_decls = do
- (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
- return decls'
+-- Used for external core
+rnTyClDecls tycl_decls = do (decls', fvs) <- rnList rnTyClDecl tycl_decls
+ return decls'
addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
+
+rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
+rnList f xs = mapFvRn (wrapLocFstM f) xs
\end{code}
%*********************************************************
\begin{code}
-rnDocEntities :: [DocEntity RdrName] -> RnM [DocEntity Name]
-rnDocEntities ents
- = ifErrsM (return []) $
- -- Yuk: stop if we have found errors. Otherwise
- -- the rnDocEntity stuff reports the errors again.
- mapM rnDocEntity ents
-
-rnDocEntity :: DocEntity RdrName -> RnM (DocEntity Name)
-rnDocEntity (DocEntity docdecl) = do
- rn_docdecl <- rnDocDecl docdecl
- return (DocEntity rn_docdecl)
-rnDocEntity (DeclEntity name) = do
- rn_name <- lookupTopBndrRn name
- return (DeclEntity rn_name)
-
rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
rnDocDecl (DocCommentNext doc) = do
rn_doc <- rnHsDoc doc
\begin{code}
rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
+-- First rename the fixity decls, so we can put
+-- the renamed decls in the renamed syntax tre
rnSrcFixityDecls fix_decls
- = do fix_decls <- mapM rnFixityDecl fix_decls
- return (concat fix_decls)
-
-rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
-rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
- = setSrcSpan nameLoc $
+ = do fix_decls <- mapM rn_decl fix_decls
+ return (concat fix_decls)
+ where
+ rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
-- GHC extension: look up both the tycon and data con
- -- for con-like things
+ -- for con-like things; hence returning a list
-- If neither are in scope, report an error; otherwise
-- add both to the fixity env
- do names <- lookupLocalDataTcNames rdr_name
- return [ L loc (FixitySig (L nameLoc name) fixity)
- | name <- names ]
-
-rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
-rnSrcFixityDeclsEnv fix_decls
- = getGblEnv `thenM` \ gbl_env ->
- foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
- fix_decls `thenM` \ fix_env ->
- traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
- returnM fix_env
-
-rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
-rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
- = case lookupNameEnv fix_env name of
- Just (FixItem _ _ loc')
- -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
- return fix_env
- Nothing
- -> return (extendNameEnv fix_env name fix_item)
- where fix_item = FixItem (nameOccName name) fixity nameLoc
+ rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
+ = setSrcSpan name_loc $
+ do names <- lookupLocalDataTcNames rdr_name
+ return [ L loc (FixitySig (L name_loc name) fixity)
+ | name <- names ]
+
+extendGblFixityEnv :: [LFixitySig Name] -> RnM TcGblEnv
+-- Extend the global envt with fixity decls, checking for duplicate decls
+extendGblFixityEnv decls
+ = do { env <- getGblEnv
+ ; fix_env' <- foldlM add_one (tcg_fix_env env) decls
+ ; return (env { tcg_fix_env = fix_env' }) }
+ where
+ add_one fix_env (L loc (FixitySig (L name_loc name) fixity))
+ | Just (FixItem _ _ loc') <- lookupNameEnv fix_env name
+ = do { setSrcSpan loc $
+ addLocErr (L name_loc name) (dupFixityDecl loc')
+ ; return fix_env }
+ | otherwise
+ = return (extendNameEnv fix_env name fix_item)
+ where
+ fix_item = FixItem (nameOccName name) fixity loc
pprFixEnv :: FixityEnv -> SDoc
pprFixEnv env
rn_deprec (Deprecation rdr_name txt)
= lookupLocalDataTcNames rdr_name `thenM` \ names ->
returnM [(name, (nameOccName name, txt)) | name <- names]
-
-checkModDeprec :: Maybe DeprecTxt -> Deprecations
--- Check for a module deprecation; done once at top level
-checkModDeprec Nothing = NoDeprecs
-checkModDeprec (Just txt) = DeprecAll txt
\end{code}
%*********************************************************
rnHsForeignDecl (ForeignExport name ty spec)
= lookupLocatedOccRn name `thenM` \ name' ->
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
- returnM (ForeignExport name' ty' spec, fvs )
+ returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
-- NB: a foreign export is an *occurrence site* for name, so
-- we add it to the free-variable list. It might, for example,
-- be imported from another module
Renaming of the associated types in instances.
-* We raise an error if we encounter a kind signature in an instance.
-
\begin{code}
rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
-rnATInsts atDecls =
- mapFvRn (wrapLocFstM rnATInst) atDecls
+rnATInsts atDecls = rnList rnATInst atDecls
where
- rnATInst tydecl@TyFunction {} =
- do
- addErr noKindSig
- rnTyClDecl tydecl
+ rnATInst tydecl@TyData {} = rnTyClDecl tydecl
rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
- rnATInst tydecl@TyData {} =
- do
- checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
- rnTyClDecl tydecl
- rnATInst _ =
- panic "RnSource.rnATInsts: not a type declaration"
-
-noKindSig = text "Instances cannot have kind signatures"
+ rnATInst tydecl =
+ pprPanic "RnSource.rnATInsts: invalid AT instance"
+ (ppr (tcdName tydecl))
\end{code}
For the method bindings in class and instance decls, we extend the
\begin{code}
extendTyVarEnvForMethodBinds tyvars thing_inside
- = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
- if opt_GlasgowExts then
- extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
- else
- thing_inside
+ = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
+ ; if scoped_tvs then
+ extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
+ else
+ thing_inside }
\end{code}
%*********************************************************
returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
emptyFVs)
+-- all flavours of type family declarations ("type family", "newtype fanily",
+-- and "data family")
+rnTyClDecl (tydecl@TyFamily {}) =
+ rnFamily tydecl bindTyVarsRn
+
+-- "data", "newtype", "data instance, and "newtype instance" declarations
rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
tcdLName = tycon, tcdTyVars = tyvars,
tcdTyPats = typatsMaybe, tcdCons = condecls,
tcdKindSig = sig, tcdDerivs = derivs})
- | isKindSigDecl tydecl -- kind signature of indexed type
- = rnTySig tydecl bindTyVarsRn
| is_vanilla -- Normal Haskell data type decl
= ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
-- data type is syntactically illegal
bindTyVarsRn data_doc tyvars $ \ tyvars' ->
- do { tycon' <- if isIdxTyDecl tydecl
+ do { tycon' <- if isFamInstDecl tydecl
then lookupLocatedOccRn tycon -- may be imported family
else lookupLocatedTopBndrRn tycon
; context' <- rnContext data_doc context
extractHsCtxtTyNames context' `plusFV`
plusFVs (map conDeclFVs condecls') `plusFV`
deriv_fvs `plusFV`
- (if isIdxTyDecl tydecl
+ (if isFamInstDecl tydecl
then unitFV (unLoc tycon') -- type instance => use
else emptyFVs))
}
| otherwise -- GADT
= ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
- do { tycon' <- if isIdxTyDecl tydecl
+ do { tycon' <- if isFamInstDecl tydecl
then lookupLocatedOccRn tycon -- may be imported family
else lookupLocatedTopBndrRn tycon
; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
tcdCons = condecls', tcdDerivs = derivs'},
plusFVs (map conDeclFVs condecls') `plusFV`
deriv_fvs `plusFV`
- (if isIdxTyDecl tydecl
+ (if isFamInstDecl tydecl
then unitFV (unLoc tycon') -- type instance => use
else emptyFVs))
}
rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
returnM (Just ds', extractHsTyNames_s ds')
-rnTyClDecl (tydecl@TyFunction {}) =
- rnTySig tydecl bindTyVarsRn
-
+-- "type" and "type instance" declarations
rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
tcdTyPats = typatsMaybe, tcdSynRhs = ty})
= bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
- do { name' <- if isIdxTyDecl tydecl
+ do { name' <- if isFamInstDecl tydecl
then lookupLocatedOccRn name -- may be imported family
else lookupLocatedTopBndrRn name
; typats' <- rnTyPats syn_doc typatsMaybe
tcdTyPats = typats', tcdSynRhs = ty'},
delFVs (map hsLTyVarName tyvars') $
fvs `plusFV`
- (if isIdxTyDecl tydecl
+ (if isFamInstDecl tydecl
then unitFV (unLoc name') -- type instance => use
else emptyFVs))
}
; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
- -- Sigh. Check the Haddock docs after the methods, to avoid duplicate errors
- -- Example: class { op :: a->a; op2 x = x }
- -- Don't want a duplicate complait about op2
- ; docs' <- bindLocalNames (map hsLTyVarName tyvars') $ rnDocEntities docs
+ -- Haddock docs
+ ; docs' <- mapM (wrapLocM rnDocDecl) docs
; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
-- For GADT syntax, the tvs are all the quantified tyvars
-- Hence the 'filter' in the ResTyH98 case only
; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
- arg_tys = hsConArgs details
+ arg_tys = hsConDeclArgTys details
implicit_tvs = case res_ty of
ResTyH98 -> filter not_in_scope $
get_rdr_tvs arg_tys
; bindTyVarsRn doc tvs' $ \new_tyvars -> do
{ new_context <- rnContext doc cxt
- ; new_details <- rnConDetails doc details
+ ; new_details <- rnConDeclDetails doc details
; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
where
RecCon fields -> return (details, ResTyGADT ty')
InfixCon {} -> panic "rnConResult"
-rnConDetails doc (PrefixCon tys)
+rnConDeclDetails doc (PrefixCon tys)
= mappM (rnLHsType doc) tys `thenM` \ new_tys ->
returnM (PrefixCon new_tys)
-rnConDetails doc (InfixCon ty1 ty2)
+rnConDeclDetails doc (InfixCon ty1 ty2)
= rnLHsType doc ty1 `thenM` \ new_ty1 ->
rnLHsType doc ty2 `thenM` \ new_ty2 ->
returnM (InfixCon new_ty1 new_ty2)
-rnConDetails doc (RecCon fields)
- = checkDupNames doc field_names `thenM_`
- mappM (rnField doc) fields `thenM` \ new_fields ->
- returnM (RecCon new_fields)
- where
- field_names = [ name | HsRecField name _ _ <- fields ]
+rnConDeclDetails doc (RecCon fields)
+ = do { checkDupNames doc (map cd_fld_name fields)
+ ; new_fields <- mappM (rnField doc) fields
+ ; return (RecCon new_fields) }
--- Document comments are renamed to Nothing here
-rnField doc (HsRecField name ty haddock_doc)
+rnField doc (ConDeclField name ty haddock_doc)
= lookupLocatedTopBndrRn name `thenM` \ new_name ->
rnLHsType doc ty `thenM` \ new_ty ->
rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
- returnM (HsRecField new_name new_ty new_haddock_doc)
+ returnM (ConDeclField new_name new_ty new_haddock_doc)
--- Rename kind signatures (signatures of indexed data types/newtypes and
--- signatures of type functions)
+-- Rename family declarations
--
-- * This function is parametrised by the routine handling the index
-- variables. On the toplevel, these are defining occurences, whereas they
-- are usage occurences for associated types.
--
-rnTySig :: TyClDecl RdrName
- -> (SDoc -> [LHsTyVarBndr RdrName] ->
- ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
- RnM (TyClDecl Name, FreeVars))
- -> RnM (TyClDecl Name, FreeVars)
-
-rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
- tcdTyVars = tyvars, tcdTyPats = mb_typats,
- tcdCons = condecls, tcdKindSig = sig,
- tcdDerivs = derivs})
+rnFamily :: TyClDecl RdrName
+ -> (SDoc -> [LHsTyVarBndr RdrName] ->
+ ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
+ RnM (TyClDecl Name, FreeVars))
+ -> RnM (TyClDecl Name, FreeVars)
+
+rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
+ tcdLName = tycon, tcdTyVars = tyvars})
bindIdxVars =
- ASSERT( null condecls ) -- won't have constructors
- ASSERT( isNothing mb_typats ) -- won't have type patterns
- ASSERT( isNothing derivs ) -- won't have deriving
- ASSERT( isJust sig ) -- will have kind signature
- do { bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
+ do { checkM (isDataFlavour flavour -- for synonyms,
+ || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
+ ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
; tycon' <- lookupLocatedTopBndrRn tycon
- ; context' <- rnContext (ksig_doc tycon) context
- ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
- tcdLName = tycon', tcdTyVars = tyvars',
- tcdTyPats = Nothing, tcdKindSig = sig,
- tcdCons = [], tcdDerivs = Nothing},
- delFVs (map hsLTyVarName tyvars') $
- extractHsCtxtTyNames context')
- } }
- where
-
-rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
- tcdKind = sig})
- bindIdxVars =
- do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
- ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
- ; tycon' <- lookupLocatedTopBndrRn tycon
- ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
- tcdIso = tcdIso tydecl, tcdKind = sig},
+ ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
+ tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
emptyFVs)
} }
+ where
+ isDataFlavour DataFamily = True
+ isDataFlavour _ = False
-ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
-needOneIdx = text "Kind signature requires at least one type index"
+family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
+needOneIdx = text "Type family declarations requires at least one type index"
-- Rename associated type declarations (in classes)
--
--- * This can be kind signatures and (default) type function equations.
+-- * This can be family declarations and (default) type instances
--
rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
where
- rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
- rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
- rn_at (tydecl@TySynonym {}) =
+ rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
+ rn_at (tydecl@TySynonym {}) =
do
checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
rnTyClDecl tydecl
%*********************************************************
%* *
+\subsection{Support code for type/data declarations}
+%* *
+%*********************************************************
+
+Get the mapping from constructors to fields for this module.
+It's convenient to do this after the data type decls have been renamed
+\begin{code}
+extendRecordFieldEnv :: [LTyClDecl Name] -> TcM TcGblEnv
+extendRecordFieldEnv decls
+ = do { tcg_env <- getGblEnv
+ ; let field_env' = foldr get (tcg_field_env tcg_env) decls
+ ; return (tcg_env { tcg_field_env = field_env' }) }
+ where
+ get (L _ (TyData { tcdCons = cons })) env = foldr get_con env cons
+ get other env = env
+
+ get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
+ = extendNameEnv env (unLoc con) (map (unLoc . cd_fld_name) flds)
+ get_con other env
+ = env
+\end{code}
+
+%*********************************************************
+%* *
\subsection{Support code to rename types}
%* *
%*********************************************************
projects / ghc-hetmet.git / blobdiff