X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnHsSyn.lhs;h=bfbcdc515f6a92c65336ab95803c40672ca707c8;hp=60e08238027913c7127fac217a77a9edc6b63d7b;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=836b1e90821aacc9d1e09fe78085f911597274c8 diff --git a/compiler/rename/RnHsSyn.lhs b/compiler/rename/RnHsSyn.lhs index 60e0823..bfbcdc5 100644 --- a/compiler/rename/RnHsSyn.lhs +++ b/compiler/rename/RnHsSyn.lhs @@ -11,9 +11,7 @@ module RnHsSyn( extractFunDepNames, extractHsCtxtTyNames, extractHsPredTyNames, -- Free variables - hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs, - - maybeGenericMatch + hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs ) where #include "HsVersions.h" @@ -24,7 +22,7 @@ import TysWiredIn ( tupleTyCon, listTyCon, parrTyCon, charTyCon ) import Name ( Name, getName, isTyVarName ) import NameSet import BasicTypes ( Boxity ) -import SrcLoc ( Located(..), unLoc ) +import SrcLoc \end{code} %************************************************************************ @@ -66,7 +64,6 @@ extractHsTyNames ty get (HsParTy ty) = getl ty get (HsBangTy _ ty) = getl ty get (HsRecTy flds) = extractHsTyNames_s (map cd_fld_type flds) - get (HsNumTy _) = emptyNameSet get (HsTyVar tv) = unitNameSet tv get (HsSpliceTy _ fvs _) = fvs get (HsQuasiQuoteTy {}) = emptyNameSet @@ -77,6 +74,8 @@ extractHsTyNames ty `minusNameSet` mkNameSet (hsLTyVarNames tvs) get (HsDocTy ty _) = getl ty + get (HsCoreTy {}) = emptyNameSet -- This probably isn't quite right + -- but I don't think it matters extractHsTyNames_s :: [LHsType Name] -> NameSet extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys @@ -118,10 +117,11 @@ hsSigsFVs :: [LSig Name] -> FreeVars hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs) hsSigFVs :: Sig Name -> FreeVars -hsSigFVs (TypeSig _ ty) = extractHsTyNames ty -hsSigFVs (SpecInstSig ty) = extractHsTyNames ty -hsSigFVs (SpecSig _ ty _) = extractHsTyNames ty -hsSigFVs _ = emptyFVs +hsSigFVs (TypeSig _ ty) = extractHsTyNames ty +hsSigFVs (GenericSig _ ty) = extractHsTyNames ty +hsSigFVs (SpecInstSig ty) = extractHsTyNames ty +hsSigFVs (SpecSig _ ty _) = extractHsTyNames ty +hsSigFVs _ = emptyFVs ---------------- conDeclFVs :: LConDecl Name -> FreeVars @@ -142,24 +142,3 @@ conDetailsFVs details = plusFVs (map bangTyFVs (hsConDeclArgTys details)) bangTyFVs :: LHsType Name -> FreeVars bangTyFVs bty = extractHsTyNames (getBangType bty) \end{code} - - -%************************************************************************ -%* * -\subsection{A few functions on generic defintions -%* * -%************************************************************************ - -These functions on generics are defined over Matches Name, which is -why they are here and not in HsMatches. - -\begin{code} -maybeGenericMatch :: LMatch Name -> Maybe (HsType Name, LMatch Name) - -- Tells whether a Match is for a generic definition - -- and extract the type from a generic match and put it at the front - -maybeGenericMatch (L loc (Match (L _ (TypePat (L _ ty)) : pats) sig_ty grhss)) - = Just (ty, L loc (Match pats sig_ty grhss)) - -maybeGenericMatch _ = Nothing -\end{code}