2496ee8cd5c83ded5a89c7f3619e499f1d9a9944
[ghc-hetmet.git] / 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 module RnHsSyn where
8
9 #include "HsVersions.h"
10
11 import HsSyn
12 import HsPragmas        ( InstancePragmas, GenPragmas, DataPragmas, ClassPragmas, ClassOpPragmas )
13
14 import Id               ( GenId, Id )
15 import BasicTypes       ( Unused, NewOrData, IfaceFlavour )
16 import Name             ( Name )
17 import Name             ( NameSet, unitNameSet, mkNameSet, minusNameSet, unionNameSets, emptyNameSet )
18 import TyVar            ( GenTyVar )
19 import Unique           ( Unique )
20 import Util
21 import Outputable
22 \end{code}
23
24
25 \begin{code}
26 type RenamedArithSeqInfo        = ArithSeqInfo          Unused Name RenamedPat
27 type RenamedClassDecl           = ClassDecl             Unused Name RenamedPat
28 type RenamedClassOpSig          = Sig                   Name
29 type RenamedConDecl             = ConDecl               Name
30 type RenamedContext             = Context               Name
31 type RenamedHsDecl              = HsDecl                Unused Name RenamedPat
32 type RenamedSpecDataSig         = SpecDataSig           Name
33 type RenamedDefaultDecl         = DefaultDecl           Name
34 type RenamedForeignDecl         = ForeignDecl           Name
35 type RenamedFixityDecl          = FixityDecl            Name
36 type RenamedGRHS                = GRHS                  Unused Name RenamedPat
37 type RenamedGRHSsAndBinds       = GRHSsAndBinds         Unused Name RenamedPat
38 type RenamedHsBinds             = HsBinds               Unused Name RenamedPat
39 type RenamedHsExpr              = HsExpr                Unused Name RenamedPat
40 type RenamedHsModule            = HsModule              Unused Name RenamedPat
41 type RenamedInstDecl            = InstDecl              Unused Name RenamedPat
42 type RenamedMatch               = Match                 Unused Name RenamedPat
43 type RenamedMonoBinds           = MonoBinds             Unused Name RenamedPat
44 type RenamedPat                 = InPat                 Name
45 type RenamedHsType              = HsType                Name
46 type RenamedRecordBinds         = HsRecordBinds         Unused Name RenamedPat
47 type RenamedSig                 = Sig                   Name
48 type RenamedStmt                = Stmt                  Unused Name RenamedPat
49 type RenamedTyDecl              = TyDecl                Name
50
51 type RenamedClassOpPragmas      = ClassOpPragmas        Name
52 type RenamedClassPragmas        = ClassPragmas          Name
53 type RenamedDataPragmas         = DataPragmas           Name
54 type RenamedGenPragmas          = GenPragmas            Name
55 type RenamedInstancePragmas     = InstancePragmas       Name
56 \end{code}
57
58 %************************************************************************
59 %*                                                                      *
60 \subsection{Free variables}
61 %*                                                                      *
62 %************************************************************************
63
64 These free-variable finders returns tycons and classes too.
65
66 \begin{code}
67 extractHsTyNames   :: RenamedHsType -> NameSet
68 extractHsTyNames ty
69   = get ty
70   where
71     get (MonoTyApp ty1 ty2)      = get ty1 `unionNameSets` get ty2
72     get (MonoListTy tc ty)       = unitNameSet tc `unionNameSets` get ty
73     get (MonoTupleTy tc tys)     = unitNameSet tc `unionNameSets` extractHsTyNames_s tys
74     get (MonoFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
75     get (MonoDictTy cls tys)     = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
76     get (MonoTyVar tv)           = unitNameSet tv
77     get (HsForAllTy tvs ctxt ty) = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
78                                             `minusNameSet`
79                                     mkNameSet (map getTyVarName tvs)
80
81 extractHsTyNames_s  :: [RenamedHsType] -> NameSet
82 extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
83
84 extractHsCtxtTyNames :: RenamedContext -> NameSet
85 extractHsCtxtTyNames ctxt = foldr (unionNameSets . get) emptyNameSet ctxt
86   where
87     get (cls, tys) = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
88 \end{code}
89