[project @ 1998-04-06 18:38:36 by sof]

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

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 278fc65..1d52c5f 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -4,58 +4,85 @@
 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
 
 \begin{code}
-#include "HsVersions.h"
-
 module RnHsSyn where
 
-import Ubiq{-uitous-}
+#include "HsVersions.h"
 
 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 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 RenamedClassOpPragmas     = ClassOpPragmas        Name
+type RenamedArithSeqInfo       = ArithSeqInfo          Unused Name RenamedPat
+type RenamedClassDecl          = ClassDecl             Unused Name RenamedPat
 type RenamedClassOpSig         = Sig                   Name
-type RenamedClassPragmas       = ClassPragmas          Name
 type RenamedConDecl            = ConDecl               Name
 type RenamedContext            = Context               Name
-type RenamedDataPragmas                = DataPragmas           Name
+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 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 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 RenamedPolyType           = PolyType              Name
-type RenamedQual               = Qual                  Fake Fake Name RenamedPat
+type RenamedHsType             = HsType                Name
+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
+type RenamedClassPragmas       = ClassPragmas          Name
+type RenamedDataPragmas                = DataPragmas           Name
+type RenamedGenPragmas         = GenPragmas            Name
+type RenamedInstancePragmas    = InstancePragmas       Name
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+\subsection{Free variables}
+%*                                                                     *
+%************************************************************************
+
+These free-variable finders returns tycons and classes too.
+
 \begin{code}
-collectQualBinders :: [RenamedQual] -> [Name]
+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 (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)
+                                           `minusNameSet`
+                                   mkNameSet (map getTyVarName tvs)
 
-collectQualBinders quals
-  = concat (map collect quals)
+extractHsTyNames_s  :: [RenamedHsType] -> NameSet
+extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
+
+extractHsCtxtTyNames :: RenamedContext -> NameSet
+extractHsCtxtTyNames ctxt = foldr (unionNameSets . get) emptyNameSet ctxt
   where
-    collect (GeneratorQual pat _) = collectPatBinders pat
-    collect (FilterQual expr)    = []
-    collect (LetQual    binds)   = collectTopLevelBinders binds
+    get (cls, tys) = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
 \end{code}
+