X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnHsSyn.lhs;h=2759f54c8c762bf7e1a430503cc36703ccbdf5d2;hb=8288caf065f2a73dc8987b23c5c5a5e2852d23be;hp=58a1acc024776e1ea155777987d3cbd049e7e79c;hpb=37a47dd0a3a72f199a03016513758e5ab82ae760;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 58a1acc..2759f54 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -11,7 +11,8 @@ module RnHsSyn where
 import HsSyn
 import HsCore
 import Class		( FunDep, DefMeth(..) )
-import TysWiredIn	( tupleTyCon, listTyCon, charTyCon )
+import TyCon		( visibleDataCons )
+import TysWiredIn	( tupleTyCon, listTyCon, parrTyCon, charTyCon )
 import Name		( Name, getName, isTyVarName )
 import NameSet
 import BasicTypes	( Boxity )
@@ -56,9 +57,10 @@ type RenamedDeprecation		= DeprecDecl		Name
 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)
@@ -75,6 +77,7 @@ extractHsTyNames ty
   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
@@ -82,6 +85,7 @@ extractHsTyNames ty
 				 unitNameSet tycon
     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`
@@ -128,9 +132,9 @@ tyClDeclFVs (IfaceSig {tcdType = ty, tcdIdInfo = id_infos})
     plusFVs (map hsIdInfoFVs id_infos)
 
 tyClDeclFVs (TyData {tcdCtxt = context, tcdTyVars = tyvars, tcdCons = condecls})
-  = delFVs (map hsTyVarName tyvars) $
-    extractHsCtxtTyNames context		`plusFV`
-    plusFVs (map conDeclFVs condecls)
+  = delFVs (map hsTyVarName tyvars)	$
+    extractHsCtxtTyNames context	`plusFV`
+    plusFVs (map conDeclFVs (visibleDataCons condecls))
 
 tyClDeclFVs (TySynonym {tcdTyVars = tyvars, tcdSynRhs = ty})
   = delFVs (map hsTyVarName tyvars) (extractHsTyNames ty)
@@ -152,6 +156,9 @@ tyClDeclFVs (ClassDecl {tcdCtxt = context, tcdTyVars = tyvars, tcdFDs = fds,
 		Just _ -> emptyFVs	-- Source code, so the default methods
 					-- are *bound* not *free*
 
+tyClDeclFVs (CoreDecl {tcdType = ty, tcdRhs = rhs})
+  = extractHsTyNames ty `plusFV` ufExprFVs rhs
+
 ----------------
 hsSigsFVs sigs = plusFVs (map hsSigFVs sigs)