[project @ 2002-06-07 07:16:04 by chak]

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

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 539a81e..6b6d949 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -11,6 +11,7 @@ module RnHsSyn where
 import HsSyn
 import HsCore
 import Class           ( FunDep, DefMeth(..) )
+import TyCon           ( visibleDataCons )
 import TysWiredIn      ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
 import Name            ( Name, getName, isTyVarName )
 import NameSet
@@ -81,9 +82,12 @@ extractHsTyNames ty
     get (HsFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
     get (HsPredTy p)          = extractHsPredTyNames p
     get (HsOpTy ty1 tycon ty2) = get ty1 `unionNameSets` get ty2 `unionNameSets`
-                                unitNameSet tycon
+                                case tycon of { HsTyOp n -> unitNameSet n ; 
+                                                HsArrow  -> emptyNameSet }
+    get (HsParTy ty)           = get ty
     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`
@@ -130,9 +134,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)
@@ -154,6 +158,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)