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