X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnHsSyn.lhs;h=9e6cb9d519b4cc8af0218f545eb0ad401da8fafb;hb=9241ac84d10f7e6b23841da2c0765275072ad7c1;hp=7d785362668723966b650ffbfcbd30feb6c91fd0;hpb=432b9c9322181a3644083e3c19b7e240d90659e7;p=ghc-hetmet.git

diff --git a/compiler/rename/RnHsSyn.lhs b/compiler/rename/RnHsSyn.lhs
index 7d78536..9e6cb9d 100644
--- a/compiler/rename/RnHsSyn.lhs
+++ b/compiler/rename/RnHsSyn.lhs
@@ -11,20 +11,18 @@ module RnHsSyn(
         extractFunDepNames, extractHsCtxtTyNames, extractHsPredTyNames,
 
         -- Free variables
-        hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs,
-
-        maybeGenericMatch
+        hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs
   ) where
 
 #include "HsVersions.h"
 
 import HsSyn
 import Class            ( FunDep )
-import TysWiredIn       ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
+import TysWiredIn       ( tupleTyCon, listTyCon, parrTyCon, hetMetCodeTypeTyCon, charTyCon )
 import Name             ( Name, getName, isTyVarName )
 import NameSet
 import BasicTypes       ( Boxity )
-import SrcLoc           ( Located(..), unLoc )
+import SrcLoc
 \end{code}
 
 %************************************************************************
@@ -40,6 +38,8 @@ charTyCon_name, listTyCon_name, parrTyCon_name :: Name
 charTyCon_name    = getName charTyCon
 listTyCon_name    = getName listTyCon
 parrTyCon_name    = getName parrTyCon
+hetMetCodeTypeTyCon_name :: Name
+hetMetCodeTypeTyCon_name  = getName hetMetCodeTypeTyCon
 
 tupleTyCon_name :: Boxity -> Int -> Name
 tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
@@ -59,6 +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 (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
@@ -66,9 +72,9 @@ 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 _)         = emptyNameSet   -- Type splices mention no type variables
+    get (HsSpliceTy _ fvs _)   = fvs
+    get (HsQuasiQuoteTy {})    = emptyNameSet
     get (HsKindSig ty _)       = getl ty
     get (HsForAllTy _ tvs
                     ctxt ty)   = (extractHsCtxtTyNames ctxt
@@ -76,6 +82,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
@@ -117,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
@@ -141,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}