[project @ 2002-05-03 11:25:58 by simonmar]

[ghc-hetmet.git] / ghc / compiler / rename / RnHsSyn.lhs

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 58a1acc..2759f54 100644 (file)
--- 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)