[project @ 1997-06-13 04:11:47 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..362a810 100644 (file)
--- 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}
+