[project @ 1999-05-18 14:56:06 by simonpj]

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

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 2496ee8..496a518 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
 %
 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
 
@@ -11,42 +11,40 @@ module RnHsSyn where
 import HsSyn
 import HsPragmas       ( InstancePragmas, GenPragmas, DataPragmas, ClassPragmas, ClassOpPragmas )
 
-import Id              ( GenId, Id )
-import BasicTypes      ( Unused, NewOrData, IfaceFlavour )
-import Name            ( Name )
-import Name            ( NameSet, unitNameSet, mkNameSet, minusNameSet, unionNameSets, emptyNameSet )
-import TyVar           ( GenTyVar )
-import Unique          ( Unique )
+import TysWiredIn      ( tupleTyCon, unboxedTupleTyCon, 
+                         listTyCon, charTyCon )
+import Name            ( Name, getName )
+import NameSet
 import Util
 import Outputable
 \end{code}
 
 
 \begin{code}
-type RenamedArithSeqInfo       = ArithSeqInfo          Unused Name RenamedPat
-type RenamedClassDecl          = ClassDecl             Unused Name RenamedPat
+type RenamedArithSeqInfo       = ArithSeqInfo          Name RenamedPat
 type RenamedClassOpSig         = Sig                   Name
 type RenamedConDecl            = ConDecl               Name
 type RenamedContext            = Context               Name
-type RenamedHsDecl             = HsDecl                Unused Name RenamedPat
+type RenamedHsDecl             = HsDecl                Name RenamedPat
+type RenamedRuleDecl           = RuleDecl              Name RenamedPat
+type RenamedTyClDecl           = TyClDecl              Name RenamedPat
 type RenamedSpecDataSig                = SpecDataSig           Name
 type RenamedDefaultDecl                = DefaultDecl           Name
 type RenamedForeignDecl                = ForeignDecl           Name
-type RenamedFixityDecl         = FixityDecl            Name
-type RenamedGRHS               = GRHS                  Unused Name RenamedPat
-type RenamedGRHSsAndBinds      = GRHSsAndBinds         Unused Name RenamedPat
-type RenamedHsBinds            = HsBinds               Unused Name RenamedPat
-type RenamedHsExpr             = HsExpr                Unused Name RenamedPat
-type RenamedHsModule           = HsModule              Unused Name RenamedPat
-type RenamedInstDecl           = InstDecl              Unused Name RenamedPat
-type RenamedMatch              = Match                 Unused Name RenamedPat
-type RenamedMonoBinds          = MonoBinds             Unused Name RenamedPat
+type RenamedGRHS               = GRHS                  Name RenamedPat
+type RenamedGRHSs              = GRHSs                 Name RenamedPat
+type RenamedHsBinds            = HsBinds               Name RenamedPat
+type RenamedHsExpr             = HsExpr                Name RenamedPat
+type RenamedHsModule           = HsModule              Name RenamedPat
+type RenamedInstDecl           = InstDecl              Name RenamedPat
+type RenamedMatch              = Match                 Name RenamedPat
+type RenamedMonoBinds          = MonoBinds             Name RenamedPat
 type RenamedPat                        = InPat                 Name
 type RenamedHsType             = HsType                Name
-type RenamedRecordBinds                = HsRecordBinds         Unused Name RenamedPat
+type RenamedRecordBinds                = HsRecordBinds         Name RenamedPat
 type RenamedSig                        = Sig                   Name
-type RenamedStmt               = Stmt                  Unused Name RenamedPat
-type RenamedTyDecl             = TyDecl                Name
+type RenamedStmt               = Stmt                  Name RenamedPat
+type RenamedFixitySig          = FixitySig             Name
 
 type RenamedClassOpPragmas     = ClassOpPragmas        Name
 type RenamedClassPragmas       = ClassPragmas          Name
@@ -64,19 +62,31 @@ type RenamedInstancePragmas = InstancePragmas       Name
 These free-variable finders returns tycons and classes too.
 
 \begin{code}
+charTyCon_name, listTyCon_name :: Name
+charTyCon_name    = getName charTyCon
+listTyCon_name    = getName listTyCon
+
+tupleTyCon_name :: Bool -> Int -> Name
+tupleTyCon_name True  n = getName (tupleTyCon n)
+tupleTyCon_name False n = getName (unboxedTupleTyCon n)
+
 extractHsTyNames   :: RenamedHsType -> NameSet
 extractHsTyNames ty
   = get ty
   where
     get (MonoTyApp ty1 ty2)      = get ty1 `unionNameSets` get ty2
-    get (MonoListTy tc ty)       = unitNameSet tc `unionNameSets` get ty
-    get (MonoTupleTy tc tys)     = unitNameSet tc `unionNameSets` extractHsTyNames_s tys
+    get (MonoListTy ty)          = unitNameSet listTyCon_name 
+                                  `unionNameSets` get ty
+    get (MonoTupleTy tys boxed)  = unitNameSet (tupleTyCon_name boxed (length tys)) 
+                                  `unionNameSets` extractHsTyNames_s tys
     get (MonoFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
     get (MonoDictTy cls tys)     = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
     get (MonoTyVar tv)          = unitNameSet tv
-    get (HsForAllTy tvs ctxt ty) = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
+    get (HsForAllTy (Just tvs) 
+                   ctxt ty)     = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
                                            `minusNameSet`
                                    mkNameSet (map getTyVarName tvs)
+    get ty@(HsForAllTy Nothing _ _) = pprPanic "extractHsTyNames" (ppr ty)
 
 extractHsTyNames_s  :: [RenamedHsType] -> NameSet
 extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys