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, 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"))
198 varUnqual n = Unqual (VarOcc n)
200 isUnqual (Unqual _) = True
201 isUnqual (Qual _ _ _) = False
203 isQual (Unqual _) = False
204 isQual (Qual _ _ _) = True
206 -- Used for adding a prefix to a RdrName
207 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
208 prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
209 prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
211 cmpRdr (Unqual n1) (Unqual n2) = n1 `compare` n2
212 cmpRdr (Unqual n1) (Qual m2 n2 _) = LT
213 cmpRdr (Qual m1 n1 _) (Unqual n2) = GT
214 cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `compare` n2) `thenCmp` (m1 `compare` m2)
215 -- always compare module-names *second*
217 rdrNameOcc :: RdrName -> OccName
218 rdrNameOcc (Unqual occ) = occ
219 rdrNameOcc (Qual _ occ _) = occ
221 ieOcc :: RdrNameIE -> OccName
222 ieOcc ie = rdrNameOcc (ieName ie)
224 instance Text RdrName where -- debugging
225 showsPrec _ rn = showString (showSDoc (ppr rn))
227 instance Eq RdrName where
228 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
229 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
231 instance Ord RdrName where
232 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
233 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
234 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
235 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
236 compare a b = cmpRdr a b
238 instance Outputable RdrName where
239 ppr (Unqual n) = pprOccName n
240 ppr (Qual m n _) = hcat [pprModule m, char '.', pprOccName n]
242 instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
243 getOccName = rdrNameOcc
244 getName = panic "no getName for RdrNames"
246 showRdr rdr = showSDoc (ppr rdr)