X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnHsSyn.lhs;h=1d52c5f71bd7a2fe2b0675a029f71f1865d634aa;hb=83817d01dff687643eee23218435b968ba358a25;hp=db49db2daa1038c4333424896db27d7d98bc2ebd;hpb=7a3bd641457666e10d0a47be9f22762e03defbf0;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index db49db2..1d52c5f 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -4,54 +4,47 @@
 \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 Id		( GenId, Id )
+import BasicTypes	( Unused, NewOrData, IfaceFlavour )
 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 Name		( NameSet, unitNameSet, mkNameSet, minusNameSet, unionNameSets, emptyNameSet )
 import TyVar		( GenTyVar )
 import Unique		( Unique )
-import Util		( panic, pprPanic{-, pprTrace ToDo:rm-} )
+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		Unused Name RenamedPat
+type RenamedClassDecl		= ClassDecl		Unused Name RenamedPat
 type RenamedClassOpSig		= Sig			Name
 type RenamedConDecl		= ConDecl		Name
 type RenamedContext		= Context 		Name
-type RenamedHsDecl		= HsDecl		Fake Fake Name RenamedPat
+type RenamedHsDecl		= HsDecl		Unused 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 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 RenamedPat			= InPat			Name
 type RenamedHsType		= HsType		Name
-type RenamedRecordBinds		= HsRecordBinds		Fake Fake Name RenamedPat
-type RenamedQual		= Qualifier		Fake Fake Name RenamedPat
+type RenamedRecordBinds		= HsRecordBinds		Unused Name RenamedPat
 type RenamedSig			= Sig			Name
-type RenamedSpecInstSig		= SpecInstSig 		Name
-type RenamedStmt		= Stmt			Fake Fake Name RenamedPat
+type RenamedStmt		= Stmt			Unused Name RenamedPat
 type RenamedTyDecl		= TyDecl		Name
 
 type RenamedClassOpPragmas	= ClassOpPragmas	Name
@@ -67,23 +60,29 @@ type RenamedInstancePragmas	= InstancePragmas	Name
 %*									*
 %************************************************************************
 
-\begin{code}
-extractCtxtTyNames :: RenamedContext -> NameSet
-extractCtxtTyNames ctxt = foldr (unionNameSets . extractHsTyNames . snd) emptyNameSet ctxt
+These free-variable finders returns tycons and classes too.
 
-extractHsTyNames   :: RenamedHsType  -> NameSet
+\begin{code}
+extractHsTyNames   :: RenamedHsType -> NameSet
 extractHsTyNames ty
   = get ty
   where
-    get (MonoTyApp con tys)      = foldr (unionNameSets . get) (unitNameSet con) tys
+    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 (MonoTupleTy tc tys)     = unitNameSet tc `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}