X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnHsSyn.lhs;h=362a810c8d8b2286750345e17202eb2a2405e97f;hb=44f98be5b3bc7aaf2c5961667b16ee8eca3e67c1;hp=278fc6589796e4535bd4843607bf195e6f75578a;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 278fc65..362a810 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -8,54 +8,83 @@
 
 module RnHsSyn where
 
-import Ubiq{-uitous-}
+IMP_Ubiq()
 
 import HsSyn
+#if __GLASGOW_HASKELL__ >= 202
+import HsPragmas
+#endif
+
+import Id		( GenId, SYN_IE(Id) )
+import BasicTypes	( NewOrData )
+import Name		( Name )
+import Outputable	( PprStyle(..), Outputable(..){-instance * []-} )
+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-} )
 \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 RenamedClassOpPragmas	= ClassOpPragmas	Name
 type RenamedClassOpSig		= Sig			Name
-type RenamedClassPragmas	= ClassPragmas		Name
 type RenamedConDecl		= ConDecl		Name
 type RenamedContext		= Context 		Name
-type RenamedDataPragmas		= DataPragmas		Name
+type RenamedHsDecl		= HsDecl		Fake Fake 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 RenamedGenPragmas		= GenPragmas		Name
 type RenamedHsBinds		= HsBinds		Fake Fake Name RenamedPat
 type RenamedHsExpr		= HsExpr		Fake Fake Name RenamedPat
 type RenamedHsModule		= HsModule		Fake Fake Name RenamedPat
-type RenamedRecordBinds		= HsRecordBinds		Fake Fake Name RenamedPat
-type RenamedImportedInterface	= ImportedInterface	Fake Fake Name RenamedPat
 type RenamedInstDecl		= InstDecl		Fake Fake Name RenamedPat
-type RenamedInstancePragmas	= InstancePragmas	Name
-type RenamedInterface		= Interface		Fake Fake Name RenamedPat
 type RenamedMatch		= Match			Fake Fake Name RenamedPat
 type RenamedMonoBinds		= MonoBinds		Fake Fake Name RenamedPat
-type RenamedMonoType		= MonoType		Name
 type RenamedPat			= InPat			Name
-type RenamedPolyType		= PolyType		Name
-type RenamedQual		= Qual			Fake Fake Name RenamedPat
+type RenamedHsType		= HsType		Name
+type RenamedRecordBinds		= HsRecordBinds		Fake Fake Name RenamedPat
 type RenamedSig			= Sig			Name
 type RenamedSpecInstSig		= SpecInstSig 		Name
 type RenamedStmt		= Stmt			Fake Fake Name RenamedPat
 type RenamedTyDecl		= TyDecl		Name
+
+type RenamedClassOpPragmas	= ClassOpPragmas	Name
+type RenamedClassPragmas	= ClassPragmas		Name
+type RenamedDataPragmas		= DataPragmas		Name
+type RenamedGenPragmas		= GenPragmas		Name
+type RenamedInstancePragmas	= InstancePragmas	Name
 \end{code}
 
+%************************************************************************
+%*									*
+\subsection{Free variables}
+%*									*
+%************************************************************************
+
 \begin{code}
-collectQualBinders :: [RenamedQual] -> [Name]
+extractCtxtTyNames :: RenamedContext -> NameSet
+extractCtxtTyNames ctxt = foldr (unionNameSets . extractHsTyNames . snd) emptyNameSet ctxt
 
-collectQualBinders quals
-  = concat (map collect quals)
+extractHsTyNames   :: RenamedHsType  -> NameSet
+extractHsTyNames ty
+  = get ty
   where
-    collect (GeneratorQual pat _) = collectPatBinders pat
-    collect (FilterQual expr)	  = []
-    collect (LetQual    binds)	  = collectTopLevelBinders binds
+    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 (MonoFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
+    get (MonoDictTy cls ty)      = unitNameSet cls `unionNameSets` get ty
+    get (MonoTyVar tv)	         = unitNameSet tv
+    get (HsForAllTy tvs ctxt ty) = foldr (unionNameSets . get . snd) (get ty) ctxt
+					    `minusNameSet`
+				    mkNameSet (map getTyVarName tvs)
+
 \end{code}
+