X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnHsSyn.lhs;h=d723fd4895480522356dbeee296f2dc9a6fdc62a;hb=3160f854580e6d8df412c8cd34d93bae27175d67;hp=953d8add83dc4962d09c3663b83d178331ba0521;hpb=1fb1ab5d53a09607e7f6d2450806760688396387;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 953d8ad..d723fd4 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -1,57 +1,49 @@
 %
-% (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}
 
 \begin{code}
-#include "HsVersions.h"
-
 module RnHsSyn where
 
-IMP_Ubiq()
+#include "HsVersions.h"
 
 import HsSyn
+import HsPragmas	( InstancePragmas, GenPragmas, DataPragmas, ClassPragmas, ClassOpPragmas )
 
-import Id		( GenId, SYN_IE(Id) )
-import Name		( Name )
-import Outputable	( Outputable(..){-instance * []-} )
-import PprStyle		( PprStyle(..) )
-import PprType		( GenType, GenTyVar, TyCon )
-import Pretty
-import Name		( SYN_IE(NameSet), unitNameSet, mkNameSet, minusNameSet, unionNameSets, emptyNameSet )
-import TyCon		( TyCon )
-import TyVar		( GenTyVar )
-import Unique		( Unique )
-import Util		( panic, pprPanic{-, pprTrace ToDo:rm-} )
+import TysWiredIn	( tupleTyCon, unboxedTupleTyCon, 
+			  listTyCon, charTyCon )
+import Name		( Name, getName )
+import NameSet
+import Util
+import Outputable
 \end{code}
 
 
 \begin{code}
-type RenamedArithSeqInfo	= ArithSeqInfo		Fake Fake Name RenamedPat
-type RenamedBind		= Bind			Fake Fake Name RenamedPat
-type RenamedClassDecl		= ClassDecl		Fake Fake Name RenamedPat
+type RenamedArithSeqInfo	= ArithSeqInfo		Name RenamedPat
 type RenamedClassOpSig		= Sig			Name
 type RenamedConDecl		= ConDecl		Name
 type RenamedContext		= Context 		Name
-type RenamedHsDecl		= HsDecl		Fake Fake Name RenamedPat
+type RenamedHsDecl		= HsDecl		Name RenamedPat
+type RenamedTyClDecl		= TyClDecl		Name RenamedPat
 type RenamedSpecDataSig		= SpecDataSig		Name
 type RenamedDefaultDecl		= DefaultDecl		Name
-type RenamedFixityDecl		= FixityDecl		Name
-type RenamedGRHS		= GRHS			Fake Fake Name RenamedPat
-type RenamedGRHSsAndBinds	= GRHSsAndBinds		Fake Fake Name RenamedPat
-type RenamedHsBinds		= HsBinds		Fake Fake Name RenamedPat
-type RenamedHsExpr		= HsExpr		Fake Fake Name RenamedPat
-type RenamedHsModule		= HsModule		Fake Fake Name RenamedPat
-type RenamedInstDecl		= InstDecl		Fake Fake Name RenamedPat
-type RenamedMatch		= Match			Fake Fake Name RenamedPat
-type RenamedMonoBinds		= MonoBinds		Fake Fake Name RenamedPat
+type RenamedForeignDecl		= ForeignDecl		Name
+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		Fake Fake Name RenamedPat
+type RenamedRecordBinds		= HsRecordBinds		Name RenamedPat
 type RenamedSig			= Sig			Name
-type RenamedSpecInstSig		= SpecInstSig 		Name
-type RenamedStmt		= Stmt			Fake Fake Name RenamedPat
-type RenamedTyDecl		= TyDecl		Name
+type RenamedStmt		= Stmt			Name RenamedPat
+type RenamedFixitySig		= FixitySig		Name
 
 type RenamedClassOpPragmas	= ClassOpPragmas	Name
 type RenamedClassPragmas	= ClassPragmas		Name
@@ -66,23 +58,39 @@ type RenamedInstancePragmas	= InstancePragmas	Name
 %*									*
 %************************************************************************
 
+These free-variable finders returns tycons and classes too.
+
 \begin{code}
-extractCtxtTyNames :: RenamedContext -> NameSet
-extractCtxtTyNames ctxt = foldr (unionNameSets . extractHsTyNames . snd) emptyNameSet ctxt
+charTyCon_name, listTyCon_name :: Name
+charTyCon_name    = getName charTyCon
+listTyCon_name    = getName listTyCon
 
-extractHsTyNames   :: RenamedHsType  -> NameSet
+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)     = foldr (unionNameSets . get) (unitNameSet tc) 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 ty)      = unitNameSet cls `unionNameSets` get ty
+    get (MonoDictTy cls tys)     = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
     get (MonoTyVar tv)	         = unitNameSet tv
-    get (HsForAllTy tvs ctxt ty) = foldr (unionNameSets . get . snd) (get ty) ctxt
+    get (HsForAllTy tvs ctxt ty) = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
 					    `minusNameSet`
 				    mkNameSet (map getTyVarName tvs)
 
+extractHsTyNames_s  :: [RenamedHsType] -> NameSet
+extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
+
+extractHsCtxtTyNames :: RenamedContext -> NameSet
+extractHsCtxtTyNames ctxt = foldr (unionNameSets . get) emptyNameSet ctxt
+  where
+    get (cls, tys) = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
 \end{code}