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...)
37 RdrNameClassOpPragmas,
41 RdrNameInstancePragmas,
42 extractHsTyVars, extractHsCtxtTyVars,
45 qual, varQual, tcQual, varUnqual, lexVarQual, lexTcQual,
46 dummyRdrVarName, dummyRdrTcName,
48 showRdr, rdrNameOcc, rdrNameModule, ieOcc,
49 cmpRdr, prefixRdrName,
50 mkOpApp, mkClassDecl, isClassDataConRdrName
54 #include "HsVersions.h"
58 import BasicTypes ( Module, IfaceFlavour(..), Unused )
59 import Name ( pprModule, OccName(..), pprOccName,
60 prefixOccName, NamedThing(..) )
61 import Util ( thenCmp )
62 import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
66 import Char ( isUpper )
70 type RdrNameArithSeqInfo = ArithSeqInfo Unused RdrName RdrNamePat
71 type RdrNameBangType = BangType RdrName
72 type RdrNameClassDecl = ClassDecl Unused RdrName RdrNamePat
73 type RdrNameClassOpSig = Sig RdrName
74 type RdrNameConDecl = ConDecl RdrName
75 type RdrNameContext = Context RdrName
76 type RdrNameHsDecl = HsDecl Unused RdrName RdrNamePat
77 type RdrNameSpecDataSig = SpecDataSig RdrName
78 type RdrNameDefaultDecl = DefaultDecl RdrName
79 type RdrNameFixityDecl = FixityDecl RdrName
80 type RdrNameGRHS = GRHS Unused RdrName RdrNamePat
81 type RdrNameGRHSsAndBinds = GRHSsAndBinds Unused RdrName RdrNamePat
82 type RdrNameHsBinds = HsBinds Unused RdrName RdrNamePat
83 type RdrNameHsExpr = HsExpr Unused RdrName RdrNamePat
84 type RdrNameHsModule = HsModule Unused RdrName RdrNamePat
85 type RdrNameIE = IE RdrName
86 type RdrNameImportDecl = ImportDecl RdrName
87 type RdrNameInstDecl = InstDecl Unused RdrName RdrNamePat
88 type RdrNameMatch = Match Unused RdrName RdrNamePat
89 type RdrNameMonoBinds = MonoBinds Unused RdrName RdrNamePat
90 type RdrNamePat = InPat RdrName
91 type RdrNameHsType = HsType RdrName
92 type RdrNameSig = Sig RdrName
93 type RdrNameStmt = Stmt Unused RdrName RdrNamePat
94 type RdrNameTyDecl = TyDecl RdrName
96 type RdrNameClassOpPragmas = ClassOpPragmas RdrName
97 type RdrNameClassPragmas = ClassPragmas RdrName
98 type RdrNameDataPragmas = DataPragmas RdrName
99 type RdrNameGenPragmas = GenPragmas RdrName
100 type RdrNameInstancePragmas = InstancePragmas RdrName
103 @extractHsTyVars@ looks just for things that could be type variables.
104 It's used when making the for-alls explicit.
107 extractHsTyVars :: HsType RdrName -> [RdrName]
108 extractHsTyVars ty = nub (extract_ty ty [])
110 extractHsCtxtTyVars :: Context RdrName -> [RdrName]
111 extractHsCtxtTyVars ty = nub (extract_ctxt ty [])
113 extract_ctxt ctxt acc = foldr extract_ass [] ctxt
115 extract_ass (cls, tys) acc = foldr extract_ty acc tys
117 extract_ty (MonoTyApp ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
118 extract_ty (MonoListTy tc ty) acc = extract_ty ty acc
119 extract_ty (MonoTupleTy tc tys) acc = foldr extract_ty acc tys
120 extract_ty (MonoFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
121 extract_ty (MonoDictTy cls tys) acc = foldr extract_ty acc tys
122 extract_ty (MonoTyVar tv) acc = insert tv acc
124 -- In (All a => a -> a) -> Int, there are no free tyvars
125 -- We just assume that we quantify over all type variables mentioned in the context.
126 extract_ty (HsPreForAllTy ctxt ty) acc = filter (`notElem` locals) (extract_ty ty [])
129 locals = extract_ctxt ctxt []
131 extract_ty (HsForAllTy tvs ctxt ty) acc = acc ++
132 (filter (`notElem` locals) $
133 extract_ctxt ctxt (extract_ty ty []))
135 locals = map getTyVarName tvs
138 insert (Qual _ _ _) acc = acc
139 insert (Unqual (TCOcc _)) acc = acc
140 insert other acc = other : acc
144 A useful function for building @OpApps@. The operator is always a variable,
145 and we don't know the fixity yet.
148 mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
151 mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
152 by deriving them from the name of the class.
155 mkClassDecl cxt cname tyvars sigs mbinds prags loc
156 = ClassDecl cxt cname tyvars sigs mbinds prags tname dname loc
158 -- The datacon and tycon are called ":C" where the class is C
159 -- This prevents name clashes with user-defined tycons or datacons C
160 (dname, tname) = case cname of
161 Qual m (TCOcc s) hif -> (Qual m (VarOcc s1) hif, Qual m (TCOcc s1) hif)
163 s1 = SLIT(":") _APPEND_ s
165 Unqual (TCOcc s) -> (Unqual (VarOcc s1), Unqual (TCOcc s1))
167 s1 = SLIT(":") _APPEND_ s
169 -- This nasty little function tests for whether a RdrName was
170 -- constructed by the above process. It's used only for filtering
171 -- out duff error messages. Maybe there's a tidier way of doing this
172 -- but I can't work up the energy to find it.
174 isClassDataConRdrName rdr_name
175 = case rdrNameOcc rdr_name of
176 TCOcc s -> case _UNPK_ s of
177 ':' : c : _ -> isUpper c
182 %************************************************************************
184 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
186 %************************************************************************
191 | Qual Module OccName IfaceFlavour -- HiBootFile for M!.t (interface files only),
192 -- HiFile for the common M.t
194 qual (m,n) = Qual m n HiFile
195 tcQual (m,n) = Qual m (TCOcc n) HiFile
196 varQual (m,n) = Qual m (VarOcc n) HiFile
198 lexTcQual (m,n,hif) = Qual m (TCOcc n) hif
199 lexVarQual (m,n,hif) = Qual m (VarOcc n) hif
201 -- This guy is used by the reader when HsSyn has a slot for
202 -- an implicit name that's going to be filled in by
203 -- the renamer. We can't just put "error..." because
204 -- we sometimes want to print out stuff after reading but
206 dummyRdrVarName = Unqual (VarOcc SLIT("V-DUMMY"))
207 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
210 varUnqual n = Unqual (VarOcc n)
212 isUnqual (Unqual _) = True
213 isUnqual (Qual _ _ _) = False
215 isQual (Unqual _) = False
216 isQual (Qual _ _ _) = True
218 -- Used for adding a prefix to a RdrName
219 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
220 prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
221 prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
223 cmpRdr (Unqual n1) (Unqual n2) = n1 `compare` n2
224 cmpRdr (Unqual n1) (Qual m2 n2 _) = LT
225 cmpRdr (Qual m1 n1 _) (Unqual n2) = GT
226 cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `compare` n2) `thenCmp` (m1 `compare` m2)
227 -- always compare module-names *second*
229 rdrNameOcc :: RdrName -> OccName
230 rdrNameOcc (Unqual occ) = occ
231 rdrNameOcc (Qual _ occ _) = occ
233 rdrNameModule :: RdrName -> Module
234 rdrNameModule (Qual m _ _) = m
236 ieOcc :: RdrNameIE -> OccName
237 ieOcc ie = rdrNameOcc (ieName ie)
239 instance Text RdrName where -- debugging
240 showsPrec _ rn = showString (showSDoc (ppr rn))
242 instance Eq RdrName where
243 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
244 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
246 instance Ord RdrName where
247 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
248 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
249 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
250 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
251 compare a b = cmpRdr a b
253 instance Outputable RdrName where
254 ppr (Unqual n) = pprOccName n
255 ppr (Qual m n _) = hcat [pprModule m, char '.', pprOccName n]
257 instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
258 getOccName = rdrNameOcc
259 getName = panic "no getName for RdrNames"
261 showRdr rdr = showSDoc (ppr rdr)