2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
7 #include "HsVersions.h"
15 import Id ( GenId, Id(..) )
16 import Name ( isLocalName, nameUnique, Name, RdrName )
17 import Outputable ( Outputable(..){-instance * []-} )
18 import PprStyle ( PprStyle(..) )
19 import PprType ( GenType, GenTyVar, TyCon )
21 import TyCon ( TyCon )
22 import TyVar ( GenTyVar )
23 import Unique ( Unique )
24 import Util ( panic, pprPanic )
31 | RnName Name -- funtions/binders/tyvars
32 | RnSyn Name -- type synonym
33 | RnData Name [Name] -- data type (with constrs)
34 | RnConstr Name Name -- constructor (with data type)
35 | RnClass Name [Name] -- class (with class ops)
36 | RnClassOp Name Name -- class op (with class)
37 | RnImplicit Name -- implicitly imported
38 | RnImplicitTyCon Name -- implicitly imported
39 | RnImplicitClass Name -- implicitly imported
40 | RnUnbound RdrName -- place holder
43 mkRnImplicit = RnImplicit
44 mkRnImplicitTyCon = RnImplicitTyCon
45 mkRnImplicitClass = RnImplicitClass
46 mkRnUnbound = RnUnbound
48 isRnWired (WiredInId _) = True
49 isRnWired (WiredInTyCon _) = True
52 isRnLocal (RnName n) = isLocalName n
56 isRnTyCon (WiredInTyCon _) = True
57 isRnTyCon (RnSyn _) = True
58 isRnTyCon (RnData _ _) = True
59 isRnTyCon (RnImplicitTyCon _) = True
62 isRnClass (RnClass _ _) = True
63 isRnClass (RnImplicitClass _) = True
66 isRnClassOp cls (RnClassOp _ op_cls) = eqUniqsNamed cls op_cls
67 isRnClassOp cls (RnImplicit _) = True -- ho hummm ...
68 isRnClassOp cls _ = False
70 isRnImplicit (RnImplicit _) = True
71 isRnImplicit (RnImplicitTyCon _) = True
72 isRnImplicit (RnImplicitClass _) = True
73 isRnImplicit _ = False
75 isRnUnbound (RnUnbound _) = True
78 -- Very general NamedThing comparison, used when comparing
79 -- Uniquable things with different types
81 eqUniqsNamed n1 n2 = uniqueOf n1 == uniqueOf n2
82 cmpUniqsNamed n1 n2 = uniqueOf n1 `cmp` uniqueOf n2
84 instance Eq RnName where
85 a == b = eqUniqsNamed a b
87 instance Ord3 RnName where
88 a `cmp` b = cmpUniqsNamed a b
90 instance Uniquable RnName where
91 uniqueOf = nameUnique . getName
93 instance NamedThing RnName where
94 getName (WiredInId id) = getName id
95 getName (WiredInTyCon tc) = getName tc
96 getName (RnName n) = n
98 getName (RnData n _) = n
99 getName (RnConstr n _) = n
100 getName (RnClass n _) = n
101 getName (RnClassOp n _) = n
102 getName (RnImplicit n) = n
103 getName (RnUnbound occ) = pprPanic "getRnName:RnUnbound" (ppr PprDebug occ)
105 instance Outputable RnName where
107 ppr sty@PprShowAll (RnData n cs) = ppBesides [ppr sty n, ppStr "{-", ppr sty cs, ppStr "-}"]
108 ppr sty@PprShowAll (RnConstr n d) = ppBesides [ppr sty n, ppStr "{-", ppr sty d, ppStr "-}"]
109 ppr sty@PprShowAll (RnClass n ops) = ppBesides [ppr sty n, ppStr "{-", ppr sty ops, ppStr "-}"]
110 ppr sty@PprShowAll (RnClassOp n c) = ppBesides [ppr sty n, ppStr "{-", ppr sty c, ppStr "-}"]
112 ppr sty (WiredInId id) = ppr sty id
113 ppr sty (WiredInTyCon tycon)= ppr sty tycon
114 ppr sty (RnUnbound occ) = ppBeside (ppr sty occ) (ppPStr SLIT("{-UNBOUND-}"))
115 ppr sty rn_name = ppr sty (getName rn_name)
119 type RenamedArithSeqInfo = ArithSeqInfo Fake Fake RnName RenamedPat
120 type RenamedBind = Bind Fake Fake RnName RenamedPat
121 type RenamedClassDecl = ClassDecl Fake Fake RnName RenamedPat
122 type RenamedClassOpSig = Sig RnName
123 type RenamedConDecl = ConDecl RnName
124 type RenamedContext = Context RnName
125 type RenamedSpecDataSig = SpecDataSig RnName
126 type RenamedDefaultDecl = DefaultDecl RnName
127 type RenamedFixityDecl = FixityDecl RnName
128 type RenamedGRHS = GRHS Fake Fake RnName RenamedPat
129 type RenamedGRHSsAndBinds = GRHSsAndBinds Fake Fake RnName RenamedPat
130 type RenamedHsBinds = HsBinds Fake Fake RnName RenamedPat
131 type RenamedHsExpr = HsExpr Fake Fake RnName RenamedPat
132 type RenamedHsModule = HsModule Fake Fake RnName RenamedPat
133 type RenamedInstDecl = InstDecl Fake Fake RnName RenamedPat
134 type RenamedMatch = Match Fake Fake RnName RenamedPat
135 type RenamedMonoBinds = MonoBinds Fake Fake RnName RenamedPat
136 type RenamedMonoType = MonoType RnName
137 type RenamedPat = InPat RnName
138 type RenamedPolyType = PolyType RnName
139 type RenamedRecordBinds = HsRecordBinds Fake Fake RnName RenamedPat
140 type RenamedQual = Qual Fake Fake RnName RenamedPat
141 type RenamedSig = Sig RnName
142 type RenamedSpecInstSig = SpecInstSig RnName
143 type RenamedStmt = Stmt Fake Fake RnName RenamedPat
144 type RenamedTyDecl = TyDecl RnName
146 type RenamedClassOpPragmas = ClassOpPragmas RnName
147 type RenamedClassPragmas = ClassPragmas RnName
148 type RenamedDataPragmas = DataPragmas RnName
149 type RenamedGenPragmas = GenPragmas RnName
150 type RenamedInstancePragmas = InstancePragmas RnName
154 collectQualBinders :: [RenamedQual] -> [RnName]
156 collectQualBinders quals
157 = concat (map collect quals)
159 collect (GeneratorQual pat _) = collectPatBinders pat
160 collect (FilterQual expr) = []
161 collect (LetQual binds) = collectTopLevelBinders binds