2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnTypes ( rnHsType, rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs,
8 rnContext, precParseErr, sectionPrecErr ) where
10 import CmdLineOpts ( DynFlag(Opt_WarnMisc, Opt_WarnUnusedMatches, Opt_GlasgowExts) )
13 import RdrHsSyn ( RdrNameContext, RdrNameHsType, extractHsTyRdrTyVars, extractHsCtxtRdrTyVars )
14 import RnHsSyn ( RenamedContext, RenamedHsType, extractHsTyNames, tupleTyCon_name )
15 import RnEnv ( lookupOccRn, newIPName, bindTyVarsRn, lookupFixityRn )
18 import PrelInfo ( cCallishClassKeys )
19 import RdrName ( elemRdrEnv )
20 import NameSet ( FreeVars )
21 import Unique ( Uniquable(..) )
23 import BasicTypes ( compareFixity, arrowFixity )
25 import ListSetOps ( removeDupsEq )
28 #include "HsVersions.h"
31 These type renamers are in a separate module, rather than in (say) RnSource,
32 to break several loop.
34 %*********************************************************
36 \subsection{Renaming types}
38 %*********************************************************
41 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
42 rnHsTypeFVs doc_str ty
43 = rnHsType doc_str ty `thenRn` \ ty' ->
44 returnRn (ty', extractHsTyNames ty')
46 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
47 rnHsSigTypeFVs doc_str ty
48 = rnHsSigType doc_str ty `thenRn` \ ty' ->
49 returnRn (ty', extractHsTyNames ty')
51 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
52 -- rnHsSigType is used for source-language type signatures,
53 -- which use *implicit* universal quantification.
54 rnHsSigType doc_str ty
55 = rnHsType (text "In the type signature for" <+> doc_str) ty
58 rnHsType is here because we call it from loadInstDecl, and I didn't
59 want a gratuitous knot.
62 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
64 rnHsType doc (HsForAllTy Nothing ctxt ty)
65 -- Implicit quantifiction in source code (no kinds on tyvars)
66 -- Given the signature C => T we universally quantify
67 -- over FV(T) \ {in-scope-tyvars}
68 = getLocalNameEnv `thenRn` \ name_env ->
70 mentioned_in_tau = extractHsTyRdrTyVars ty
71 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
72 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
74 -- Don't quantify over type variables that are in scope;
75 -- when GlasgowExts is off, there usually won't be any, except for
77 -- class C a where { op :: a -> a }
78 forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
80 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
82 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
83 -- Explicit quantification.
84 -- Check that the forall'd tyvars are actually
85 -- mentioned in the type, and produce a warning if not
87 mentioned_in_tau = extractHsTyRdrTyVars tau
88 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
89 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
90 forall_tyvar_names = hsTyVarNames forall_tyvars
92 -- Explicitly quantified but not mentioned in ctxt or tau
93 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
95 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
96 rnForAll doc forall_tyvars ctxt tau
98 rnHsType doc (HsTyVar tyvar)
99 = lookupOccRn tyvar `thenRn` \ tyvar' ->
100 returnRn (HsTyVar tyvar')
102 rnHsType doc (HsOpTy ty1 op ty2)
104 HsArrow -> returnRn HsArrow
105 HsTyOp n -> lookupOccRn n `thenRn` \ n' ->
108 rnHsType doc ty1 `thenRn` \ ty1' ->
109 rnHsType doc ty2 `thenRn` \ ty2' ->
110 lookupTyFixityRn op' `thenRn` \ fix ->
111 mkHsOpTyRn op' fix ty1' ty2'
113 rnHsType doc (HsParTy ty)
114 = rnHsType doc ty `thenRn` \ ty' ->
115 returnRn (HsParTy ty')
117 rnHsType doc (HsNumTy i)
118 | i == 1 = returnRn (HsNumTy i)
119 | otherwise = failWithRn (HsNumTy i)
120 (ptext SLIT("Only unit numeric type pattern is valid"))
122 rnHsType doc (HsFunTy ty1 ty2)
123 = rnHsType doc ty1 `thenRn` \ ty1' ->
124 -- Might find a for-all as the arg of a function type
125 rnHsType doc ty2 `thenRn` \ ty2' ->
126 -- Or as the result. This happens when reading Prelude.hi
127 -- when we find return :: forall m. Monad m -> forall a. a -> m a
128 returnRn (HsFunTy ty1' ty2')
130 rnHsType doc (HsListTy ty)
131 = rnHsType doc ty `thenRn` \ ty' ->
132 returnRn (HsListTy ty')
134 rnHsType doc (HsKindSig ty k)
135 = rnHsType doc ty `thenRn` \ ty' ->
136 returnRn (HsKindSig ty' k)
138 rnHsType doc (HsPArrTy ty)
139 = rnHsType doc ty `thenRn` \ ty' ->
140 returnRn (HsPArrTy ty')
142 -- Unboxed tuples are allowed to have poly-typed arguments. These
143 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
144 rnHsType doc (HsTupleTy (HsTupCon _ boxity arity) tys)
145 -- Don't do lookupOccRn, because this is built-in syntax
146 -- so it doesn't need to be in scope
147 = mapRn (rnHsType doc) tys `thenRn` \ tys' ->
148 returnRn (HsTupleTy (HsTupCon tup_name boxity arity) tys')
150 tup_name = tupleTyCon_name boxity arity
153 rnHsType doc (HsAppTy ty1 ty2)
154 = rnHsType doc ty1 `thenRn` \ ty1' ->
155 rnHsType doc ty2 `thenRn` \ ty2' ->
156 returnRn (HsAppTy ty1' ty2')
158 rnHsType doc (HsPredTy pred)
159 = rnPred doc pred `thenRn` \ pred' ->
160 returnRn (HsPredTy pred')
162 rnHsTypes doc tys = mapRn (rnHsType doc) tys
167 rnForAll doc forall_tyvars ctxt ty
168 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
169 rnContext doc ctxt `thenRn` \ new_ctxt ->
170 rnHsType doc ty `thenRn` \ new_ty ->
171 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
175 %*********************************************************
177 \subsection{Fixities}
179 %*********************************************************
181 Infix types are read in a *right-associative* way, so that
186 mkHsOpTyRn rearranges where necessary. The two arguments
187 have already been renamed and rearranged. It's made rather tiresome
188 by the presence of ->
191 lookupTyFixityRn HsArrow = returnRn arrowFixity
192 lookupTyFixityRn (HsTyOp n)
193 = doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
194 warnCheckRn glaExts (infixTyConWarn n) `thenRn_`
197 -- Building (ty1 `op1` (ty21 `op2` ty22))
198 mkHsOpTyRn :: HsTyOp Name -> Fixity
199 -> RenamedHsType -> RenamedHsType
200 -> RnMS RenamedHsType
202 mkHsOpTyRn op1 fix1 ty1 ty2@(HsOpTy ty21 op2 ty22)
203 = lookupTyFixityRn op2 `thenRn` \ fix2 ->
205 (nofix_error, associate_right) = compareFixity fix1 fix2
208 addErrRn (precParseErr (quotes (ppr op1),fix1)
209 (quotes (ppr op2),fix2)) `thenRn_`
210 returnRn (HsOpTy ty1 op1 ty2)
212 if not associate_right then
213 -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
214 mkHsOpTyRn op1 fix1 ty1 ty21 `thenRn` \ new_ty ->
215 returnRn (HsOpTy new_ty op2 ty22)
217 returnRn (HsOpTy ty1 op1 ty2)
219 mkHsOpTyRn op fix ty1 ty2 -- Default case, no rearrangment
220 = returnRn (HsOpTy ty1 op ty2)
222 mkHsFunTyRn ty1 ty2 -- Precedence of function arrow is 0
223 = returnRn (HsFunTy ty1 ty2) -- so no rearrangement reqd. Change
224 -- this if fixity of -> increases.
226 not_op_ty (HsOpTy _ _ _) = False
227 not_op_ty other = True
230 %*********************************************************
232 \subsection{Contexts and predicates}
234 %*********************************************************
237 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
239 = mapRn rn_pred ctxt `thenRn` \ theta ->
241 -- Check for duplicate assertions
242 -- If this isn't an error, then it ought to be:
243 ifOptRn Opt_WarnMisc (
245 (_, dups) = removeDupsEq theta
246 -- We only have equality, not ordering
248 mapRn (addWarnRn . dupClassAssertWarn theta) dups
253 --Someone discovered that @CCallable@ and @CReturnable@
254 -- could be used in contexts such as:
255 -- foo :: CCallable a => a -> PrimIO Int
256 -- Doing this utterly wrecks the whole point of introducing these
257 -- classes so we specifically check that this isn't being done.
258 rn_pred pred = rnPred doc pred `thenRn` \ pred'->
259 checkRn (not (bad_pred pred'))
260 (naughtyCCallContextErr pred') `thenRn_`
263 bad_pred (HsClassP clas _) = getUnique clas `elem` cCallishClassKeys
264 bad_pred other = False
267 rnPred doc (HsClassP clas tys)
268 = lookupOccRn clas `thenRn` \ clas_name ->
269 rnHsTypes doc tys `thenRn` \ tys' ->
270 returnRn (HsClassP clas_name tys')
272 rnPred doc (HsIParam n ty)
273 = newIPName n `thenRn` \ name ->
274 rnHsType doc ty `thenRn` \ ty' ->
275 returnRn (HsIParam name ty')
279 %*********************************************************
283 %*********************************************************
287 forAllWarn doc ty tyvar
288 = ifOptRn Opt_WarnUnusedMatches $
289 getModeRn `thenRn` \ mode ->
292 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
293 -- unless DEBUG is on, in which case it is slightly
294 -- informative. They can arise from mkRhsTyLam,
295 #endif -- leading to (say) f :: forall a b. [b] -> [b]
298 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
299 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
305 dupClassAssertWarn ctxt (assertion : dups)
306 = sep [hsep [ptext SLIT("Duplicate class assertion"),
307 quotes (ppr assertion),
308 ptext SLIT("in the context:")],
309 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
311 naughtyCCallContextErr (HsClassP clas _)
312 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
313 ptext SLIT("in a context")]
316 = hang (ptext SLIT("precedence parsing error"))
317 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
319 ptext SLIT("in the same infix expression")])
321 sectionPrecErr op arg_op section
322 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
323 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
324 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
327 = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op)
329 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)