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 PrelMods ( pRELUDE )
60 import BasicTypes ( Module(..), NewOrData, IfaceFlavour(..), Unused )
61 import Name ( ExportFlag(..), pprModule,
62 OccName(..), pprOccName,
63 prefixOccName, NamedThing )
64 import Util ( thenCmp )
65 import CoreSyn ( GenCoreExpr )
66 import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
72 type RdrNameArithSeqInfo = ArithSeqInfo Unused RdrName RdrNamePat
73 type RdrNameBangType = BangType RdrName
74 type RdrNameClassDecl = ClassDecl Unused RdrName RdrNamePat
75 type RdrNameClassOpSig = Sig RdrName
76 type RdrNameConDecl = ConDecl RdrName
77 type RdrNameContext = Context RdrName
78 type RdrNameHsDecl = HsDecl Unused RdrName RdrNamePat
79 type RdrNameSpecDataSig = SpecDataSig RdrName
80 type RdrNameDefaultDecl = DefaultDecl RdrName
81 type RdrNameFixityDecl = FixityDecl RdrName
82 type RdrNameGRHS = GRHS Unused RdrName RdrNamePat
83 type RdrNameGRHSsAndBinds = GRHSsAndBinds Unused RdrName RdrNamePat
84 type RdrNameHsBinds = HsBinds Unused RdrName RdrNamePat
85 type RdrNameHsExpr = HsExpr Unused RdrName RdrNamePat
86 type RdrNameHsModule = HsModule Unused RdrName RdrNamePat
87 type RdrNameIE = IE RdrName
88 type RdrNameImportDecl = ImportDecl RdrName
89 type RdrNameInstDecl = InstDecl Unused RdrName RdrNamePat
90 type RdrNameMatch = Match Unused RdrName RdrNamePat
91 type RdrNameMonoBinds = MonoBinds Unused RdrName RdrNamePat
92 type RdrNamePat = InPat RdrName
93 type RdrNameHsType = HsType RdrName
94 type RdrNameSig = Sig RdrName
95 type RdrNameSpecInstSig = SpecInstSig RdrName
96 type RdrNameStmt = Stmt Unused RdrName RdrNamePat
97 type RdrNameTyDecl = TyDecl RdrName
99 type RdrNameClassOpPragmas = ClassOpPragmas RdrName
100 type RdrNameClassPragmas = ClassPragmas RdrName
101 type RdrNameDataPragmas = DataPragmas RdrName
102 type RdrNameGenPragmas = GenPragmas RdrName
103 type RdrNameInstancePragmas = InstancePragmas RdrName
106 @extractHsTyVars@ looks just for things that could be type variables.
107 It's used when making the for-alls explicit.
110 extractHsTyVars :: HsType RdrName -> [RdrName]
111 extractHsTyVars ty = nub (extract_ty ty [])
113 extractHsCtxtTyVars :: Context RdrName -> [RdrName]
114 extractHsCtxtTyVars ty = nub (extract_ctxt ty [])
116 extract_ctxt ctxt acc = foldr extract_ass [] ctxt
118 extract_ass (cls, tys) acc = foldr extract_ty acc tys
120 extract_ty (MonoTyApp ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
121 extract_ty (MonoListTy tc ty) acc = extract_ty ty acc
122 extract_ty (MonoTupleTy tc tys) acc = foldr extract_ty acc tys
123 extract_ty (MonoFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
124 extract_ty (MonoDictTy cls tys) acc = foldr extract_ty acc tys
125 extract_ty (MonoTyVar tv) acc = insert tv acc
127 -- In (All a => a -> a) -> Int, there are no free tyvars
128 -- We just assume that we quantify over all type variables mentioned in the context.
129 extract_ty (HsPreForAllTy ctxt ty) acc = filter (`notElem` locals) (extract_ty ty [])
132 locals = extract_ctxt ctxt []
134 extract_ty (HsForAllTy tvs ctxt ty) acc = acc ++
135 (filter (`notElem` locals) $
136 extract_ctxt ctxt (extract_ty ty []))
138 locals = map getTyVarName tvs
141 insert (Qual _ _ _) acc = acc
142 insert (Unqual (TCOcc _)) acc = acc
143 insert other acc = other : acc
147 A useful function for building @OpApps@. The operator is always a variable,
148 and we don't know the fixity yet.
151 mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
154 mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
155 by deriving them from the name of the class.
158 mkClassDecl cxt cname tyvars sigs mbinds prags loc
159 = ClassDecl cxt cname tyvars sigs mbinds prags tname dname loc
161 -- The datacon and tycon are called ":C" where the class is C
162 -- This prevents name clashes with user-defined tycons or datacons C
163 (dname, tname) = case cname of
164 Qual m (TCOcc s) hif -> (Qual m (VarOcc s1) hif, Qual m (TCOcc s1) hif)
166 s1 = SLIT(":") _APPEND_ s
168 Unqual (TCOcc s) -> (Unqual (VarOcc s1), Unqual (TCOcc s1))
170 s1 = SLIT(":") _APPEND_ s
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 qual (m,n) = Qual m n HiFile
187 tcQual (m,n) = Qual m (TCOcc n) HiFile
188 varQual (m,n) = Qual m (VarOcc n) HiFile
190 lexTcQual (m,n,hif) = Qual m (TCOcc n) hif
191 lexVarQual (m,n,hif) = Qual m (VarOcc n) hif
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 (VarOcc SLIT("V-DUMMY"))
199 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
201 varUnqual n = Unqual (VarOcc n)
203 isUnqual (Unqual _) = True
204 isUnqual (Qual _ _ _) = False
206 isQual (Unqual _) = False
207 isQual (Qual _ _ _) = True
209 -- Used for adding a prefix to a RdrName
210 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
211 prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
212 prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
214 cmpRdr (Unqual n1) (Unqual n2) = n1 `compare` n2
215 cmpRdr (Unqual n1) (Qual m2 n2 _) = LT
216 cmpRdr (Qual m1 n1 _) (Unqual n2) = GT
217 cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `compare` n2) `thenCmp` (m1 `compare` m2)
218 -- always compare module-names *second*
220 rdrNameOcc :: RdrName -> OccName
221 rdrNameOcc (Unqual occ) = occ
222 rdrNameOcc (Qual _ occ _) = occ
224 ieOcc :: RdrNameIE -> OccName
225 ieOcc ie = rdrNameOcc (ieName ie)
227 instance Text RdrName where -- debugging
228 showsPrec _ rn = showString (showSDoc (ppr rn))
230 instance Eq RdrName where
231 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
232 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
234 instance Ord RdrName where
235 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
236 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
237 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
238 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
239 compare a b = cmpRdr a b
241 instance Outputable RdrName where
242 ppr (Unqual n) = pprOccName n
243 ppr (Qual m n _) = hcat [pprModule m, char '.', pprOccName n]
245 instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
246 getOccName = rdrNameOcc
247 getName = panic "no getName for RdrNames"
249 showRdr rdr = showSDoc (ppr rdr)