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 RenamedSig                 = Sig                   Name
  52 type RenamedSpecInstSig         = SpecInstSig           Name
  53 type RenamedStmt                = Stmt                  Fake Fake Name RenamedPat
  54 type RenamedTyDecl              = TyDecl                Name
  55
  56 type RenamedClassOpPragmas      = ClassOpPragmas        Name
  57 type RenamedClassPragmas        = ClassPragmas          Name
  58 type RenamedDataPragmas         = DataPragmas           Name
  59 type RenamedGenPragmas          = GenPragmas            Name
  60 type RenamedInstancePragmas     = InstancePragmas       Name
  61 \end{code}
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection{Free variables}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 extractCtxtTyNames :: RenamedContext -> NameSet
  71 extractCtxtTyNames ctxt = foldr (unionNameSets . extractHsTyNames . snd) emptyNameSet ctxt
  72
  73 extractHsTyNames   :: RenamedHsType  -> NameSet
  74 extractHsTyNames ty
  75   = get ty
  76   where
  77     get (MonoTyApp ty1 ty2)      = get ty1 `unionNameSets` get ty2
  78     get (MonoListTy tc ty)       = unitNameSet tc `unionNameSets` get ty
  79     get (MonoTupleTy tc tys)     = foldr (unionNameSets . get) (unitNameSet tc) tys
  80     get (MonoFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
  81     get (MonoDictTy cls ty)      = unitNameSet cls `unionNameSets` get ty
  82     get (MonoTyVar tv)           = unitNameSet tv
  83     get (HsForAllTy tvs ctxt ty) = foldr (unionNameSets . get . snd) (get ty) ctxt
  84                                             `minusNameSet`
  85                                     mkNameSet (map getTyVarName tvs)
  86
  87 \end{code}
  88