2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[RdrHsSyn]{Specialisations of the @HsSyn@ syntax for the reader}
6 (Well, really, for specialisations involving @RdrName@s, even if
7 they are used somewhat later on in the compiler...)
10 #include "HsVersions.h"
13 SYN_IE(RdrNameArithSeqInfo),
14 SYN_IE(RdrNameBangType),
15 SYN_IE(RdrNameClassDecl),
16 SYN_IE(RdrNameClassOpSig),
17 SYN_IE(RdrNameConDecl),
18 SYN_IE(RdrNameContext),
19 SYN_IE(RdrNameSpecDataSig),
20 SYN_IE(RdrNameDefaultDecl),
21 SYN_IE(RdrNameFixityDecl),
23 SYN_IE(RdrNameGRHSsAndBinds),
24 SYN_IE(RdrNameHsBinds),
25 SYN_IE(RdrNameHsDecl),
26 SYN_IE(RdrNameHsExpr),
27 SYN_IE(RdrNameHsModule),
29 SYN_IE(RdrNameImportDecl),
30 SYN_IE(RdrNameInstDecl),
32 SYN_IE(RdrNameMonoBinds),
34 SYN_IE(RdrNameHsType),
36 SYN_IE(RdrNameSpecInstSig),
38 SYN_IE(RdrNameTyDecl),
40 SYN_IE(RdrNameClassOpPragmas),
41 SYN_IE(RdrNameClassPragmas),
42 SYN_IE(RdrNameDataPragmas),
43 SYN_IE(RdrNameGenPragmas),
44 SYN_IE(RdrNameInstancePragmas),
45 SYN_IE(RdrNameCoreExpr),
49 qual, varQual, tcQual, varUnqual,
50 dummyRdrVarName, dummyRdrTcName,
52 showRdr, rdrNameOcc, ieOcc,
53 cmpRdr, prefixRdrName,
62 import PrelMods ( pRELUDE )
63 import Name {- ( ExportFlag(..), Module(..), pprModule,
64 OccName(..), pprOccName, prefixOccName ) -}
66 import PprStyle ( PprStyle(..) )
67 import Util --( cmpPString, panic, thenCmp )
69 #if __GLASGOW_HASKELL__ >= 202
70 import CoreSyn ( GenCoreExpr )
71 import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
76 type RdrNameArithSeqInfo = ArithSeqInfo Fake Fake RdrName RdrNamePat
77 type RdrNameBangType = BangType RdrName
78 type RdrNameClassDecl = ClassDecl Fake Fake RdrName RdrNamePat
79 type RdrNameClassOpSig = Sig RdrName
80 type RdrNameConDecl = ConDecl RdrName
81 type RdrNameContext = Context RdrName
82 type RdrNameHsDecl = HsDecl Fake Fake RdrName RdrNamePat
83 type RdrNameSpecDataSig = SpecDataSig RdrName
84 type RdrNameDefaultDecl = DefaultDecl RdrName
85 type RdrNameFixityDecl = FixityDecl RdrName
86 type RdrNameGRHS = GRHS Fake Fake RdrName RdrNamePat
87 type RdrNameGRHSsAndBinds = GRHSsAndBinds Fake Fake RdrName RdrNamePat
88 type RdrNameHsBinds = HsBinds Fake Fake RdrName RdrNamePat
89 type RdrNameHsExpr = HsExpr Fake Fake RdrName RdrNamePat
90 type RdrNameHsModule = HsModule Fake Fake RdrName RdrNamePat
91 type RdrNameIE = IE RdrName
92 type RdrNameImportDecl = ImportDecl RdrName
93 type RdrNameInstDecl = InstDecl Fake Fake RdrName RdrNamePat
94 type RdrNameMatch = Match Fake Fake RdrName RdrNamePat
95 type RdrNameMonoBinds = MonoBinds Fake Fake RdrName RdrNamePat
96 type RdrNamePat = InPat RdrName
97 type RdrNameHsType = HsType RdrName
98 type RdrNameSig = Sig RdrName
99 type RdrNameSpecInstSig = SpecInstSig RdrName
100 type RdrNameStmt = Stmt Fake Fake RdrName RdrNamePat
101 type RdrNameTyDecl = TyDecl RdrName
103 type RdrNameClassOpPragmas = ClassOpPragmas RdrName
104 type RdrNameClassPragmas = ClassPragmas RdrName
105 type RdrNameDataPragmas = DataPragmas RdrName
106 type RdrNameGenPragmas = GenPragmas RdrName
107 type RdrNameInstancePragmas = InstancePragmas RdrName
108 type RdrNameCoreExpr = GenCoreExpr RdrName RdrName RdrName RdrName
111 @extractHsTyVars@ looks just for things that could be type variables.
112 It's used when making the for-alls explicit.
115 extractHsTyVars :: HsType RdrName -> [RdrName]
119 get (MonoTyApp ty1 ty2) acc = get ty1 (get ty2 acc)
120 get (MonoListTy tc ty) acc = get ty acc
121 get (MonoTupleTy tc tys) acc = foldr get acc tys
122 get (MonoFunTy ty1 ty2) acc = get ty1 (get ty2 acc)
123 get (MonoDictTy cls ty) acc = get ty acc
124 get (MonoTyVar tv) acc = insert tv acc
125 get (HsPreForAllTy ctxt ty) acc = foldr (get . snd) (get ty acc) ctxt
126 get (HsForAllTy tvs ctxt ty) acc = filter (`notElem` locals) $
127 foldr (get . snd) (get ty acc) ctxt
129 locals = map getTyVarName tvs
131 insert (Qual _ _) acc = acc
132 insert (Unqual (TCOcc _)) acc = acc
133 insert other acc | other `elem` acc = acc
134 | otherwise = other : acc
138 A useful function for building @OpApps@. The operator is always a variable,
139 and we don't know the fixity yet.
142 mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
146 %************************************************************************
148 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
150 %************************************************************************
155 | Qual Module OccName
157 qual (m,n) = Qual m n
158 tcQual (m,n) = Qual m (TCOcc n)
159 varQual (m,n) = Qual m (VarOcc n)
161 -- This guy is used by the reader when HsSyn has a slot for
162 -- an implicit name that's going to be filled in by
163 -- the renamer. We can't just put "error..." because
164 -- we sometimes want to print out stuff after reading but
166 dummyRdrVarName = Unqual (VarOcc SLIT("V-DUMMY"))
167 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
169 varUnqual n = Unqual (VarOcc n)
171 isUnqual (Unqual _) = True
172 isUnqual (Qual _ _) = False
174 isQual (Unqual _) = False
175 isQual (Qual _ _) = True
177 -- Used for adding a prefix to a RdrName
178 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
179 prefixRdrName prefix (Qual m n) = Qual m (prefixOccName prefix n)
180 prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
182 cmpRdr (Unqual n1) (Unqual n2) = n1 `cmp` n2
183 cmpRdr (Unqual n1) (Qual m2 n2) = LT_
184 cmpRdr (Qual m1 n1) (Unqual n2) = GT_
185 cmpRdr (Qual m1 n1) (Qual m2 n2) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
186 -- always compare module-names *second*
188 rdrNameOcc :: RdrName -> OccName
189 rdrNameOcc (Unqual occ) = occ
190 rdrNameOcc (Qual _ occ) = occ
192 ieOcc :: RdrNameIE -> OccName
193 ieOcc ie = rdrNameOcc (ieName ie)
195 instance Text RdrName where -- debugging
196 showsPrec _ rn = showString (show (ppr PprDebug rn))
198 instance Eq RdrName where
199 a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
200 a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
202 instance Ord RdrName where
203 a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
204 a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
205 a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
206 a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
208 instance Ord3 RdrName where
211 instance Outputable RdrName where
212 ppr sty (Unqual n) = pprQuote sty $ \ sty -> pprOccName sty n
213 ppr sty (Qual m n) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]
215 instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
216 getOccName = rdrNameOcc
217 getName = panic "no getName for RdrNames"
219 showRdr sty rdr = render (ppr sty rdr)