X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnHsSyn.lhs;h=9e6cb9d519b4cc8af0218f545eb0ad401da8fafb;hb=9241ac84d10f7e6b23841da2c0765275072ad7c1;hp=535aca2e83d5fa03ba429ad1403c6486431a8e02;hpb=34c8d0312071f7d0f4d221a997d3408c653ef9e5;p=ghc-hetmet.git diff --git a/compiler/rename/RnHsSyn.lhs b/compiler/rename/RnHsSyn.lhs index 535aca2..9e6cb9d 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, hetMetCodeTypeTyCon, import Name ( Name, getName, isTyVarName ) import NameSet import BasicTypes ( Boxity ) -import SrcLoc ( Located(..), unLoc ) +import SrcLoc \end{code} %************************************************************************ @@ -41,7 +39,7 @@ charTyCon_name = getName charTyCon listTyCon_name = getName listTyCon parrTyCon_name = getName parrTyCon hetMetCodeTypeTyCon_name :: Name -hetMetCodeTypeTyCon_name = getName hetMetCodeTypeTyCon +hetMetCodeTypeTyCon_name = getName hetMetCodeTypeTyCon tupleTyCon_name :: Boxity -> Int -> Name tupleTyCon_name boxity n = getName (tupleTyCon boxity n) @@ -61,7 +59,12 @@ extractHsTyNames ty get (HsAppTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2 get (HsListTy ty) = unitNameSet listTyCon_name `unionNameSets` getl ty get (HsPArrTy ty) = unitNameSet parrTyCon_name `unionNameSets` getl ty - get (HsModalBoxType ecn ty) = (unitNameSet ecn) `unionNameSets` (unitNameSet hetMetCodeTypeTyCon_name) `unionNameSets` (getl ty) + get (HsModalBoxType ecn ty) = (unitNameSet ecn) + `unionNameSets` + (unitNameSet hetMetCodeTypeTyCon_name) + `unionNameSets` + (getl ty) + get (HsKappaTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2 get (HsTupleTy _ tys) = extractHsTyNames_s tys get (HsFunTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2 get (HsPredTy p) = extractHsPredTyNames p @@ -69,7 +72,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 @@ -123,10 +125,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 @@ -147,24 +150,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}