ghc/compiler/rename/RnHsSyn.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   3 %
   4 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnHsSyn where
  10
  11 IMP_Ubiq()
  12
  13 import HsSyn
  14 #if __GLASGOW_HASKELL__ >= 202
  15 import HsPragmas
  16 #endif
  17
  18 import Id               ( GenId, SYN_IE(Id) )
  19 import Name             ( Name )
  20 import Outputable       ( Outputable(..){-instance * []-} )
  21 import PprStyle         ( PprStyle(..) )
  22 import PprType          ( GenType, GenTyVar, TyCon )
  23 import Pretty
  24 import Name             ( SYN_IE(NameSet), unitNameSet, mkNameSet, minusNameSet, unionNameSets, emptyNameSet )
  25 import TyCon            ( TyCon )
  26 import TyVar            ( GenTyVar )
  27 import Unique           ( Unique )
  28 import Util             ( panic, pprPanic{-, pprTrace ToDo:rm-} )
  29 \end{code}
  30
  31
  32 \begin{code}
  33 type RenamedArithSeqInfo        = ArithSeqInfo          Fake Fake Name RenamedPat
  34 type RenamedClassDecl           = ClassDecl             Fake Fake Name RenamedPat
  35 type RenamedClassOpSig          = Sig                   Name
  36 type RenamedConDecl             = ConDecl               Name
  37 type RenamedContext             = Context               Name
  38 type RenamedHsDecl              = HsDecl                Fake Fake Name RenamedPat
  39 type RenamedSpecDataSig         = SpecDataSig           Name
  40 type RenamedDefaultDecl         = DefaultDecl           Name
  41 type RenamedFixityDecl          = FixityDecl            Name
  42 type RenamedGRHS                = GRHS                  Fake Fake Name RenamedPat
  43 type RenamedGRHSsAndBinds       = GRHSsAndBinds         Fake Fake Name RenamedPat
  44 type RenamedHsBinds             = HsBinds               Fake Fake Name RenamedPat
  45 type RenamedHsExpr              = HsExpr                Fake Fake Name RenamedPat
  46 type RenamedHsModule            = HsModule              Fake Fake Name RenamedPat
  47 type RenamedInstDecl            = InstDecl              Fake Fake Name RenamedPat
  48 type RenamedMatch               = Match                 Fake Fake Name RenamedPat
  49 type RenamedMonoBinds           = MonoBinds             Fake Fake Name RenamedPat
  50 type RenamedPat                 = InPat                 Name
  51 type RenamedHsType              = HsType                Name
  52 type RenamedRecordBinds         = HsRecordBinds         Fake Fake Name RenamedPat
  53 type RenamedSig                 = Sig                   Name
  54 type RenamedSpecInstSig         = SpecInstSig           Name
  55 type RenamedStmt                = Stmt                  Fake Fake Name RenamedPat
  56 type RenamedTyDecl              = TyDecl                Name
  57
  58 type RenamedClassOpPragmas      = ClassOpPragmas        Name
  59 type RenamedClassPragmas        = ClassPragmas          Name
  60 type RenamedDataPragmas         = DataPragmas           Name
  61 type RenamedGenPragmas          = GenPragmas            Name
  62 type RenamedInstancePragmas     = InstancePragmas       Name
  63 \end{code}
  64
  65 %************************************************************************
  66 %*                                                                      *
  67 \subsection{Free variables}
  68 %*                                                                      *
  69 %************************************************************************
  70
  71 \begin{code}
  72 extractCtxtTyNames :: RenamedContext -> NameSet
  73 extractCtxtTyNames ctxt = foldr (unionNameSets . extractHsTyNames . snd) emptyNameSet ctxt
  74
  75 extractHsTyNames   :: RenamedHsType  -> NameSet
  76 extractHsTyNames ty
  77   = get ty
  78   where
  79     get (MonoTyApp ty1 ty2)      = get ty1 `unionNameSets` get ty2
  80     get (MonoListTy tc ty)       = unitNameSet tc `unionNameSets` get ty
  81     get (MonoTupleTy tc tys)     = foldr (unionNameSets . get) (unitNameSet tc) tys
  82     get (MonoFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
  83     get (MonoDictTy cls ty)      = unitNameSet cls `unionNameSets` get ty
  84     get (MonoTyVar tv)           = unitNameSet tv
  85     get (HsForAllTy tvs ctxt ty) = foldr (unionNameSets . get . snd) (get ty) ctxt
  86                                             `minusNameSet`
  87                                     mkNameSet (map getTyVarName tvs)
  88
  89 \end{code}
  90