import HsSyn
import HsCore
import Class ( FunDep, DefMeth(..) )
-import TyCon ( DataConDetails, visibleDataCons )
+import TyCon ( visibleDataCons, tyConName )
import TysWiredIn ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
import Name ( Name, getName, isTyVarName )
import NameSet
-import BasicTypes ( Boxity )
+import BasicTypes ( Boxity, FixitySig )
import Outputable
\end{code}
\begin{code}
-type RenamedHsDecl = HsDecl Name RenamedPat
-type RenamedArithSeqInfo = ArithSeqInfo Name RenamedPat
+type RenamedHsDecl = HsDecl Name
+type RenamedArithSeqInfo = ArithSeqInfo Name
type RenamedClassOpSig = Sig Name
type RenamedConDecl = ConDecl Name
type RenamedContext = HsContext Name
-type RenamedRuleDecl = RuleDecl Name RenamedPat
-type RenamedTyClDecl = TyClDecl Name RenamedPat
+type RenamedRuleDecl = RuleDecl Name
+type RenamedTyClDecl = TyClDecl Name
type RenamedDefaultDecl = DefaultDecl Name
type RenamedForeignDecl = ForeignDecl Name
-type RenamedGRHS = GRHS Name RenamedPat
-type RenamedGRHSs = GRHSs Name RenamedPat
-type RenamedHsBinds = HsBinds Name RenamedPat
-type RenamedHsExpr = HsExpr Name RenamedPat
-type RenamedInstDecl = InstDecl Name RenamedPat
+type RenamedCoreDecl = CoreDecl Name
+type RenamedGRHS = GRHS Name
+type RenamedGRHSs = GRHSs Name
+type RenamedHsBinds = HsBinds Name
+type RenamedHsExpr = HsExpr Name
+type RenamedInstDecl = InstDecl Name
type RenamedMatchContext = HsMatchContext Name
-type RenamedMatch = Match Name RenamedPat
-type RenamedMonoBinds = MonoBinds Name RenamedPat
+type RenamedMatch = Match Name
+type RenamedMonoBinds = MonoBinds Name
type RenamedPat = InPat Name
type RenamedHsType = HsType Name
type RenamedHsPred = HsPred Name
-type RenamedRecordBinds = HsRecordBinds Name RenamedPat
+type RenamedRecordBinds = HsRecordBinds Name
type RenamedSig = Sig Name
-type RenamedStmt = Stmt Name RenamedPat
+type RenamedStmt = Stmt Name
type RenamedFixitySig = FixitySig Name
type RenamedDeprecation = DeprecDecl Name
+type RenamedHsCmd = HsCmd Name
+type RenamedHsCmdTop = HsCmdTop Name
\end{code}
%************************************************************************
get (HsFunTy ty1 ty2) = get ty1 `unionNameSets` get ty2
get (HsPredTy p) = extractHsPredTyNames p
get (HsOpTy ty1 tycon ty2) = get ty1 `unionNameSets` get ty2 `unionNameSets`
- unitNameSet tycon
+ case tycon of { HsTyOp n -> unitNameSet n ;
+ HsArrow -> emptyNameSet }
+ get (HsParTy ty) = get ty
get (HsNumTy n) = emptyNameSet
get (HsTyVar tv) = unitNameSet tv
get (HsKindSig ty k) = get ty
*** See "THE NAMING STORY" in HsDecls ****
\begin{code}
+----------------
+impDeclFVs :: RenamedHsDecl -> NameSet
+ -- Just the ones that come from imports
+impDeclFVs (InstD d) = instDeclFVs d
+impDeclFVs (TyClD d) = tyClDeclFVs d
+
+----------------
tyClDeclFVs :: RenamedTyClDecl -> NameSet
tyClDeclFVs (ForeignType {})
= emptyFVs
ufExprFVs rhs `plusFV` plusFVs (map ufExprFVs args)
----------------
-conDeclFVs (ConDecl _ _ tyvars context details _)
+conDeclFVs (ConDecl _ tyvars context details _)
= delFVs (map hsTyVarName tyvars) $
extractHsCtxtTyNames context `plusFV`
conDetailsFVs details
-conDetailsFVs (VanillaCon btys) = plusFVs (map bangTyFVs btys)
+conDetailsFVs (PrefixCon btys) = plusFVs (map bangTyFVs btys)
conDetailsFVs (InfixCon bty1 bty2) = bangTyFVs bty1 `plusFV` bangTyFVs bty2
conDetailsFVs (RecCon flds) = plusFVs [bangTyFVs bty | (_, bty) <- flds]
ufNoteFVs (UfCoerce ty) = extractHsTyNames ty
ufNoteFVs note = emptyFVs
-hsTupConFVs (HsTupCon n _ _) = unitFV n
+hsTupConFVs (HsTupCon bx n) = unitFV (tyConName (tupleTyCon bx n))
+ -- Always return the TyCon; that'll suck in the data con
\end{code}
+
%************************************************************************
%* *
\subsection{A few functions on generic defintions
-- Tells whether a Match is for a generic definition
-- and extract the type from a generic match and put it at the front
-maybeGenericMatch (Match (TypePatIn ty : pats) sig_ty grhss)
+maybeGenericMatch (Match (TypePat ty : pats) sig_ty grhss)
= Just (ty, Match pats sig_ty grhss)
maybeGenericMatch other_match = Nothing