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, lexVarQual, lexTcQual,
50 dummyRdrVarName, dummyRdrTcName,
52 showRdr, rdrNameOcc, ieOcc,
53 cmpRdr, prefixRdrName,
62 import PrelMods ( pRELUDE )
63 import BasicTypes ( Module(..), NewOrData, IfaceFlavour(..) )
64 import Name ( ExportFlag(..), pprModule,
65 OccName(..), pprOccName,
66 prefixOccName, SYN_IE(NamedThing) )
68 import Outputable ( PprStyle(..) )
69 import Util --( cmpPString, panic, thenCmp )
71 #if __GLASGOW_HASKELL__ >= 202
72 import CoreSyn ( GenCoreExpr )
73 import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
78 type RdrNameArithSeqInfo = ArithSeqInfo Fake Fake RdrName RdrNamePat
79 type RdrNameBangType = BangType RdrName
80 type RdrNameClassDecl = ClassDecl Fake Fake RdrName RdrNamePat
81 type RdrNameClassOpSig = Sig RdrName
82 type RdrNameConDecl = ConDecl RdrName
83 type RdrNameContext = Context RdrName
84 type RdrNameHsDecl = HsDecl Fake Fake RdrName RdrNamePat
85 type RdrNameSpecDataSig = SpecDataSig RdrName
86 type RdrNameDefaultDecl = DefaultDecl RdrName
87 type RdrNameFixityDecl = FixityDecl RdrName
88 type RdrNameGRHS = GRHS Fake Fake RdrName RdrNamePat
89 type RdrNameGRHSsAndBinds = GRHSsAndBinds Fake Fake RdrName RdrNamePat
90 type RdrNameHsBinds = HsBinds Fake Fake RdrName RdrNamePat
91 type RdrNameHsExpr = HsExpr Fake Fake RdrName RdrNamePat
92 type RdrNameHsModule = HsModule Fake Fake RdrName RdrNamePat
93 type RdrNameIE = IE RdrName
94 type RdrNameImportDecl = ImportDecl RdrName
95 type RdrNameInstDecl = InstDecl Fake Fake RdrName RdrNamePat
96 type RdrNameMatch = Match Fake Fake RdrName RdrNamePat
97 type RdrNameMonoBinds = MonoBinds Fake Fake RdrName RdrNamePat
98 type RdrNamePat = InPat RdrName
99 type RdrNameHsType = HsType RdrName
100 type RdrNameSig = Sig RdrName
101 type RdrNameSpecInstSig = SpecInstSig RdrName
102 type RdrNameStmt = Stmt Fake Fake RdrName RdrNamePat
103 type RdrNameTyDecl = TyDecl RdrName
105 type RdrNameClassOpPragmas = ClassOpPragmas RdrName
106 type RdrNameClassPragmas = ClassPragmas RdrName
107 type RdrNameDataPragmas = DataPragmas RdrName
108 type RdrNameGenPragmas = GenPragmas RdrName
109 type RdrNameInstancePragmas = InstancePragmas RdrName
110 type RdrNameCoreExpr = GenCoreExpr RdrName RdrName RdrName RdrName
113 @extractHsTyVars@ looks just for things that could be type variables.
114 It's used when making the for-alls explicit.
117 extractHsTyVars :: HsType RdrName -> [RdrName]
121 get (MonoTyApp ty1 ty2) acc = get ty1 (get ty2 acc)
122 get (MonoListTy tc ty) acc = get ty acc
123 get (MonoTupleTy tc tys) acc = foldr get acc tys
124 get (MonoFunTy ty1 ty2) acc = get ty1 (get ty2 acc)
125 get (MonoDictTy cls ty) acc = get ty acc
126 get (MonoTyVar tv) acc = insert tv acc
128 -- In (All a => a -> a) -> Int, there are no free tyvars
129 -- We just assume that we quantify over all type variables mentioned in the context.
130 get (HsPreForAllTy ctxt ty) acc = filter (`notElem` locals) (get ty [])
133 locals = foldr (get . snd) [] ctxt
135 get (HsForAllTy tvs ctxt ty) acc = (filter (`notElem` locals) $
136 foldr (get . snd) (get ty []) ctxt)
139 locals = map getTyVarName tvs
141 insert (Qual _ _ _) acc = acc
142 insert (Unqual (TCOcc _)) acc = acc
143 insert other acc | other `elem` acc = acc
144 | otherwise = other : acc
148 A useful function for building @OpApps@. The operator is always a variable,
149 and we don't know the fixity yet.
152 mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
156 %************************************************************************
158 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
160 %************************************************************************
165 | Qual Module OccName IfaceFlavour -- HiBootFile for M!.t (interface files only),
166 -- HiFile for the common M.t
168 qual (m,n) = Qual m n HiFile
169 tcQual (m,n) = Qual m (TCOcc n) HiFile
170 varQual (m,n) = Qual m (VarOcc n) HiFile
172 lexTcQual (m,n,hif) = Qual m (TCOcc n) hif
173 lexVarQual (m,n,hif) = Qual m (VarOcc n) hif
175 -- This guy is used by the reader when HsSyn has a slot for
176 -- an implicit name that's going to be filled in by
177 -- the renamer. We can't just put "error..." because
178 -- we sometimes want to print out stuff after reading but
180 dummyRdrVarName = Unqual (VarOcc SLIT("V-DUMMY"))
181 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
183 varUnqual n = Unqual (VarOcc n)
185 isUnqual (Unqual _) = True
186 isUnqual (Qual _ _ _) = False
188 isQual (Unqual _) = False
189 isQual (Qual _ _ _) = True
191 -- Used for adding a prefix to a RdrName
192 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
193 prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
194 prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
196 cmpRdr (Unqual n1) (Unqual n2) = n1 `cmp` n2
197 cmpRdr (Unqual n1) (Qual m2 n2 _) = LT_
198 cmpRdr (Qual m1 n1 _) (Unqual n2) = GT_
199 cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
200 -- always compare module-names *second*
202 rdrNameOcc :: RdrName -> OccName
203 rdrNameOcc (Unqual occ) = occ
204 rdrNameOcc (Qual _ occ _) = occ
206 ieOcc :: RdrNameIE -> OccName
207 ieOcc ie = rdrNameOcc (ieName ie)
209 instance Text RdrName where -- debugging
210 showsPrec _ rn = showString (show (ppr PprDebug rn))
212 instance Eq RdrName where
213 a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
214 a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
216 instance Ord RdrName where
217 a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
218 a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
219 a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
220 a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
222 instance Ord3 RdrName where
225 instance Outputable RdrName where
226 ppr sty (Unqual n) = pprQuote sty $ \ sty -> pprOccName sty n
227 ppr sty (Qual m n _) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]
229 instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
230 getOccName = rdrNameOcc
231 getName = panic "no getName for RdrNames"
233 showRdr sty rdr = render (ppr sty rdr)