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...)
38 RdrNameClassOpPragmas,
42 RdrNameInstancePragmas,
43 extractHsTyVars, extractHsCtxtTyVars,
46 qual, varQual, tcQual, varUnqual, lexVarQual, lexTcQual,
47 dummyRdrVarName, dummyRdrTcName,
49 showRdr, rdrNameOcc, rdrNameModule, ieOcc,
50 cmpRdr, prefixRdrName,
55 #include "HsVersions.h"
59 import BasicTypes ( Module(..), IfaceFlavour(..), Unused )
60 import Name ( pprModule, OccName(..), pprOccName,
61 prefixOccName, NamedThing )
62 import Util ( thenCmp )
63 import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
69 type RdrNameArithSeqInfo = ArithSeqInfo Unused RdrName RdrNamePat
70 type RdrNameBangType = BangType RdrName
71 type RdrNameClassDecl = ClassDecl Unused RdrName RdrNamePat
72 type RdrNameClassOpSig = Sig RdrName
73 type RdrNameConDecl = ConDecl RdrName
74 type RdrNameContext = Context RdrName
75 type RdrNameHsDecl = HsDecl Unused RdrName RdrNamePat
76 type RdrNameSpecDataSig = SpecDataSig RdrName
77 type RdrNameDefaultDecl = DefaultDecl RdrName
78 type RdrNameFixityDecl = FixityDecl RdrName
79 type RdrNameGRHS = GRHS Unused RdrName RdrNamePat
80 type RdrNameGRHSsAndBinds = GRHSsAndBinds Unused RdrName RdrNamePat
81 type RdrNameHsBinds = HsBinds Unused RdrName RdrNamePat
82 type RdrNameHsExpr = HsExpr Unused RdrName RdrNamePat
83 type RdrNameHsModule = HsModule Unused RdrName RdrNamePat
84 type RdrNameIE = IE RdrName
85 type RdrNameImportDecl = ImportDecl RdrName
86 type RdrNameInstDecl = InstDecl Unused RdrName RdrNamePat
87 type RdrNameMatch = Match Unused RdrName RdrNamePat
88 type RdrNameMonoBinds = MonoBinds Unused RdrName RdrNamePat
89 type RdrNamePat = InPat RdrName
90 type RdrNameHsType = HsType RdrName
91 type RdrNameSig = Sig RdrName
92 type RdrNameSpecInstSig = SpecInstSig 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
171 %************************************************************************
173 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
175 %************************************************************************
180 | Qual Module OccName IfaceFlavour -- HiBootFile for M!.t (interface files only),
181 -- HiFile for the common M.t
183 qual (m,n) = Qual m n HiFile
184 tcQual (m,n) = Qual m (TCOcc n) HiFile
185 varQual (m,n) = Qual m (VarOcc n) HiFile
187 lexTcQual (m,n,hif) = Qual m (TCOcc n) hif
188 lexVarQual (m,n,hif) = Qual m (VarOcc n) hif
190 -- This guy is used by the reader when HsSyn has a slot for
191 -- an implicit name that's going to be filled in by
192 -- the renamer. We can't just put "error..." because
193 -- we sometimes want to print out stuff after reading but
195 dummyRdrVarName = Unqual (VarOcc SLIT("V-DUMMY"))
196 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
199 varUnqual n = Unqual (VarOcc n)
201 isUnqual (Unqual _) = True
202 isUnqual (Qual _ _ _) = False
204 isQual (Unqual _) = False
205 isQual (Qual _ _ _) = True
207 -- Used for adding a prefix to a RdrName
208 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
209 prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
210 prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
212 cmpRdr (Unqual n1) (Unqual n2) = n1 `compare` n2
213 cmpRdr (Unqual n1) (Qual m2 n2 _) = LT
214 cmpRdr (Qual m1 n1 _) (Unqual n2) = GT
215 cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `compare` n2) `thenCmp` (m1 `compare` m2)
216 -- always compare module-names *second*
218 rdrNameOcc :: RdrName -> OccName
219 rdrNameOcc (Unqual occ) = occ
220 rdrNameOcc (Qual _ occ _) = occ
222 rdrNameModule :: RdrName -> Module
223 rdrNameModule (Qual m _ _) = m
225 ieOcc :: RdrNameIE -> OccName
226 ieOcc ie = rdrNameOcc (ieName ie)
228 instance Text RdrName where -- debugging
229 showsPrec _ rn = showString (showSDoc (ppr rn))
231 instance Eq RdrName where
232 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
233 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
235 instance Ord RdrName where
236 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
237 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
238 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
239 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
240 compare a b = cmpRdr a b
242 instance Outputable RdrName where
243 ppr (Unqual n) = pprOccName n
244 ppr (Qual m n _) = hcat [pprModule m, char '.', pprOccName n]
246 instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
247 getOccName = rdrNameOcc
248 getName = panic "no getName for RdrNames"
250 showRdr rdr = showSDoc (ppr rdr)