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

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index db49db2..05412f5 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -1,58 +1,52 @@
 %
-% (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, listTyCon, charTyCon )
+import Name		( Name, getName )
+import NameSet
+import BasicTypes	( Boxity )
+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 RenamedContext		= HsContext 		Name
+type RenamedHsDecl		= HsDecl		Name RenamedPat
+type RenamedRuleDecl		= RuleDecl		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 RenamedQual		= Qualifier		Fake Fake Name RenamedPat
+type RenamedHsPred		= HsPred		Name
+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 RenamedDeprecation		= DeprecDecl		Name
 
 type RenamedClassOpPragmas	= ClassOpPragmas	Name
 type RenamedClassPragmas	= ClassPragmas		Name
@@ -67,23 +61,47 @@ 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 :: Boxity -> Int -> Name
+tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
+
+extractHsTyNames   :: RenamedHsType -> NameSet
 extractHsTyNames ty
   = get ty
   where
-    get (MonoTyApp con tys)      = foldr (unionNameSets . get) (unitNameSet con) tys
-    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
+    get (HsAppTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
+    get (HsListTy ty)          = unitNameSet listTyCon_name 
+				   `unionNameSets` get ty
+    get (HsTupleTy (HsTupCon n _) tys) = unitNameSet n
+				   	 `unionNameSets` extractHsTyNames_s tys
+    get (HsFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
+    get (HsPredTy p)	       = extractHsPredTyNames p
+    get (HsUsgForAllTy uv ty)  = get ty
+    get (HsUsgTy u ty)         = get ty
+    get (HsTyVar tv)	       = unitNameSet tv
+    get (HsForAllTy (Just tvs) 
+		    ctxt ty)   = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
 					    `minusNameSet`
-				    mkNameSet (map getTyVarName tvs)
+				    mkNameSet (hsTyVarNames tvs)
+    get ty@(HsForAllTy Nothing _ _) = pprPanic "extractHsTyNames" (ppr ty)
+
+extractHsTyNames_s  :: [RenamedHsType] -> NameSet
+extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
+
+extractHsCtxtTyNames :: RenamedContext -> NameSet
+extractHsCtxtTyNames ctxt = foldr (unionNameSets . extractHsPredTyNames) emptyNameSet ctxt
 
+-- You don't import or export implicit parameters, so don't mention
+-- the IP names
+extractHsPredTyNames (HsPClass cls tys)
+  = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
+extractHsPredTyNames (HsPIParam n ty)
+  = extractHsTyNames ty
 \end{code}