2 % (c) The AQUA Project, Glasgow University, 1996-1998
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...)
36 RdrNameClassOpPragmas,
40 RdrNameInstancePragmas,
41 extractHsTyVars, extractHsCtxtTyVars, extractPatsTyVars,
44 qual, varQual, tcQual, varUnqual,
45 dummyRdrVarName, dummyRdrTcName,
47 rdrNameOcc, rdrNameModule, ieOcc,
53 #include "HsVersions.h"
56 import BasicTypes ( IfaceFlavour(..), Unused )
57 import Name ( NamedThing(..),
58 Module, pprModule, mkModuleFS,
59 OccName, srcTCOcc, srcVarOcc, isTvOcc,
60 pprOccName, mkClassTyConOcc, mkClassDataConOcc
62 import PrelMods ( mkTupNameStr, mkUbxTupNameStr )
63 import Util ( thenCmp )
64 import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
70 type RdrNameArithSeqInfo = ArithSeqInfo RdrName RdrNamePat
71 type RdrNameBangType = BangType RdrName
72 type RdrNameClassOpSig = Sig RdrName
73 type RdrNameConDecl = ConDecl RdrName
74 type RdrNameContext = Context RdrName
75 type RdrNameHsDecl = HsDecl RdrName RdrNamePat
76 type RdrNameSpecDataSig = SpecDataSig RdrName
77 type RdrNameDefaultDecl = DefaultDecl RdrName
78 type RdrNameForeignDecl = ForeignDecl RdrName
79 type RdrNameGRHS = GRHS RdrName RdrNamePat
80 type RdrNameGRHSs = GRHSs RdrName RdrNamePat
81 type RdrNameHsBinds = HsBinds RdrName RdrNamePat
82 type RdrNameHsExpr = HsExpr RdrName RdrNamePat
83 type RdrNameHsModule = HsModule RdrName RdrNamePat
84 type RdrNameIE = IE RdrName
85 type RdrNameImportDecl = ImportDecl RdrName
86 type RdrNameInstDecl = InstDecl RdrName RdrNamePat
87 type RdrNameMatch = Match RdrName RdrNamePat
88 type RdrNameMonoBinds = MonoBinds RdrName RdrNamePat
89 type RdrNamePat = InPat RdrName
90 type RdrNameHsType = HsType RdrName
91 type RdrNameSig = Sig RdrName
92 type RdrNameStmt = Stmt RdrName RdrNamePat
93 type RdrNameTyClDecl = TyClDecl RdrName RdrNamePat
95 type RdrNameClassOpPragmas = ClassOpPragmas RdrName
96 type RdrNameClassPragmas = ClassPragmas RdrName
97 type RdrNameDataPragmas = DataPragmas RdrName
98 type RdrNameGenPragmas = GenPragmas RdrName
99 type RdrNameInstancePragmas = InstancePragmas RdrName
102 @extractHsTyVars@ looks just for things that could be type variables.
103 It's used when making the for-alls explicit.
106 extractHsTyVars :: HsType RdrName -> [RdrName]
107 extractHsTyVars ty = nub (extract_ty ty [])
109 extractHsCtxtTyVars :: Context RdrName -> [RdrName]
110 extractHsCtxtTyVars ty = nub (extract_ctxt ty [])
112 extract_ctxt ctxt acc = foldr extract_ass acc ctxt
114 extract_ass (cls, tys) acc = foldr extract_ty acc tys
116 extract_ty (MonoTyApp ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
117 extract_ty (MonoListTy ty) acc = extract_ty ty acc
118 extract_ty (MonoTupleTy tys _) acc = foldr extract_ty acc tys
119 extract_ty (MonoFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
120 extract_ty (MonoDictTy cls tys) acc = foldr extract_ty acc tys
121 extract_ty (MonoTyVar tv) acc = insertTV tv acc
122 extract_ty (HsForAllTy tvs ctxt ty) acc = acc ++
123 (filter (`notElem` locals) $
124 extract_ctxt ctxt (extract_ty ty []))
126 locals = map getTyVarName tvs
128 insertTV name@(Unqual occ) acc | isTvOcc occ = name : acc
129 insertTV other acc = acc
131 extractPatsTyVars :: [RdrNamePat] -> [RdrName]
132 extractPatsTyVars pats = nub (foldr extract_pat [] pats)
134 extract_pat (SigPatIn pat ty) acc = extract_ty ty acc
135 extract_pat WildPatIn acc = acc
136 extract_pat (VarPatIn var) acc = acc
137 extract_pat (LitPatIn _) acc = acc
138 extract_pat (LazyPatIn pat) acc = extract_pat pat acc
139 extract_pat (AsPatIn a pat) acc = extract_pat pat acc
140 extract_pat (NPlusKPatIn n _) acc = acc
141 extract_pat (ConPatIn c pats) acc = foldr extract_pat acc pats
142 extract_pat (ConOpPatIn p1 c f p2) acc = extract_pat p1 (extract_pat p2 acc)
143 extract_pat (NegPatIn pat) acc = extract_pat pat acc
144 extract_pat (ParPatIn pat) acc = extract_pat pat acc
145 extract_pat (ListPatIn pats) acc = foldr extract_pat acc pats
146 extract_pat (TuplePatIn pats _) acc = foldr extract_pat acc pats
147 extract_pat (RecPatIn c fields) acc = foldr (\ (f,pat,_) acc -> extract_pat pat acc) acc fields
151 A useful function for building @OpApps@. The operator is always a variable,
152 and we don't know the fixity yet.
155 mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
158 mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
159 by deriving them from the name of the class.
162 mkClassDecl cxt cname tyvars sigs mbinds prags loc
163 = ClassDecl cxt cname tyvars sigs mbinds prags tname dname loc
165 -- The datacon and tycon are called "_DC" and "_TC", where the class is C
166 -- This prevents name clashes with user-defined tycons or datacons C
167 (dname, tname) = case cname of
168 Qual m occ hif -> (Qual m (mkClassDataConOcc occ) hif,
169 Qual m (mkClassTyConOcc occ) hif)
170 Unqual occ -> (Unqual (mkClassDataConOcc occ),
171 Unqual (mkClassTyConOcc occ))
174 %************************************************************************
176 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
178 %************************************************************************
183 | Qual Module OccName IfaceFlavour -- HiBootFile for M!.t (interface files only),
184 -- HiFile for the common M.t
186 -- These ones are used for making RdrNames for known-key things,
187 -- Or in code constructed from derivings
188 qual (m,n) = Qual m n HiFile
189 tcQual (m,n) = Qual m (srcTCOcc n) HiFile
190 varQual (m,n) = Qual m (srcVarOcc n) HiFile
191 varUnqual n = Unqual (srcVarOcc n)
193 -- This guy is used by the reader when HsSyn has a slot for
194 -- an implicit name that's going to be filled in by
195 -- the renamer. We can't just put "error..." because
196 -- we sometimes want to print out stuff after reading but
198 dummyRdrVarName = Unqual (srcVarOcc SLIT("V-DUMMY"))
199 dummyRdrTcName = Unqual (srcVarOcc SLIT("TC-DUMMY"))
202 isUnqual (Unqual _) = True
203 isUnqual (Qual _ _ _) = False
205 isQual (Unqual _) = False
206 isQual (Qual _ _ _) = True
209 cmpRdr (Unqual n1) (Unqual n2) = n1 `compare` n2
210 cmpRdr (Unqual n1) (Qual m2 n2 _) = LT
211 cmpRdr (Qual m1 n1 _) (Unqual n2) = GT
212 cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `compare` n2) `thenCmp` (m1 `compare` m2)
213 -- always compare module-names *second*
215 rdrNameOcc :: RdrName -> OccName
216 rdrNameOcc (Unqual occ) = occ
217 rdrNameOcc (Qual _ occ _) = occ
219 rdrNameModule :: RdrName -> Module
220 rdrNameModule (Qual m _ _) = m
222 ieOcc :: RdrNameIE -> OccName
223 ieOcc ie = rdrNameOcc (ieName ie)
225 instance Show RdrName where -- debugging
226 showsPrec p rn = showsPrecSDoc p (ppr rn)
228 instance Eq RdrName where
229 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
230 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
232 instance Ord RdrName where
233 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
234 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
235 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
236 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
237 compare a b = cmpRdr a b
239 instance Outputable RdrName where
240 ppr (Unqual n) = pprOccName n
241 ppr (Qual m n _) = hcat [pprModule m, char '.', pprOccName n]
243 instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
244 getOccName = rdrNameOcc
245 getName = panic "no getName for RdrNames"