import HsSyn
import HsCore
import Class ( FunDep, DefMeth(..) )
-import TysWiredIn ( tupleTyCon, listTyCon, charTyCon )
+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 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 RenamedHsDecl = HsDecl Name RenamedPat
-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 RenamedHsModule = HsModule Name RenamedPat
-type RenamedInstDecl = InstDecl Name RenamedPat
-type RenamedMatch = Match Name RenamedPat
-type RenamedMonoBinds = MonoBinds 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
+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}
%************************************************************************
These free-variable finders returns tycons and classes too.
\begin{code}
-charTyCon_name, listTyCon_name :: Name
+charTyCon_name, listTyCon_name, parrTyCon_name :: Name
charTyCon_name = getName charTyCon
listTyCon_name = getName listTyCon
+parrTyCon_name = getName parrTyCon
tupleTyCon_name :: Boxity -> Int -> Name
tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
where
get (HsAppTy ty1 ty2) = get ty1 `unionNameSets` get ty2
get (HsListTy ty) = unitNameSet listTyCon_name `unionNameSets` get ty
+ get (HsPArrTy ty) = unitNameSet parrTyCon_name `unionNameSets` get ty
get (HsTupleTy con tys) = hsTupConFVs con `unionNameSets` extractHsTyNames_s tys
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
get (HsForAllTy (Just tvs)
ctxt ty) = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
`minusNameSet`
- for class decls we ignore the bindings
- for instance decls likewise, plus the pragmas
- for rule decls, we ignore HsRules
+ - for data decls, we ignore derivings
*** 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
= extractHsTyNames ty `plusFV`
plusFVs (map hsIdInfoFVs id_infos)
-tyClDeclFVs (TyData {tcdCtxt = context, tcdTyVars = tyvars, tcdCons = condecls, tcdDerivs = derivings})
- = delFVs (map hsTyVarName tyvars) $
+tyClDeclFVs (TyData {tcdCtxt = context, tcdTyVars = tyvars, tcdCons = condecls})
+ = delFVs (map hsTyVarName tyvars) $
extractHsCtxtTyNames context `plusFV`
- plusFVs (map conDeclFVs condecls)
+ plusFVs (map conDeclFVs (visibleDataCons condecls))
tyClDeclFVs (TySynonym {tcdTyVars = tyvars, tcdSynRhs = ty})
= delFVs (map hsTyVarName tyvars) (extractHsTyNames ty)
----------------
ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs
-ruleDeclFVs (IfaceRule _ vars _ args rhs _)
+ruleDeclFVs (IfaceRuleOut _ _) = emptyFVs
+ruleDeclFVs (IfaceRule _ _ vars _ args rhs _)
= delFVs (map ufBinderName vars) $
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 tvs (TypePatIn ty : pats) sig_ty grhss)
- = Just (ty, Match tvs pats sig_ty grhss)
+maybeGenericMatch (Match (TypePat ty : pats) sig_ty grhss)
+ = Just (ty, Match pats sig_ty grhss)
maybeGenericMatch other_match = Nothing
\end{code}
projects / ghc-hetmet.git / blobdiff