2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnTypes ( rnHsType, rnContext,
8 rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs,
9 rnPat, rnPats, rnPatsAndThen, -- Here because it's not part
10 rnOverLit, litFVs, -- of any mutual recursion
11 precParseErr, sectionPrecErr, dupFieldErr, patSigErr, checkTupSize
14 import CmdLineOpts ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
17 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNamePat,
18 extractHsRhoRdrTyVars )
19 import RnHsSyn ( RenamedContext, RenamedHsType, RenamedPat,
21 parrTyCon_name, tupleTyCon_name, listTyCon_name, charTyCon_name )
22 import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName, lookupGlobalOccRn,
23 bindTyVarsRn, lookupFixityRn, mapFvRn, newIPNameRn,
24 bindPatSigTyVarsFV, bindLocalsFV, warnUnusedMatches )
26 import RdrName ( elemLocalRdrEnv )
27 import PrelNames( eqStringName, eqClassName, integralClassName,
28 negateName, minusName, lengthPName, indexPName, plusIntegerName, fromIntegerName,
29 timesIntegerName, ratioDataConName, fromRationalName )
30 import Constants ( mAX_TUPLE_SIZE )
31 import TysWiredIn ( intTyCon )
32 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
33 floatPrimTyCon, doublePrimTyCon )
34 import Name ( Name, NamedThing(..) )
37 import Literal ( inIntRange, inCharRange )
38 import BasicTypes ( compareFixity )
39 import ListSetOps ( removeDups )
42 #include "HsVersions.h"
45 These type renamers are in a separate module, rather than in (say) RnSource,
46 to break several loop.
48 %*********************************************************
50 \subsection{Renaming types}
52 %*********************************************************
55 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnM (RenamedHsType, FreeVars)
56 rnHsTypeFVs doc_str ty
57 = rnHsType doc_str ty `thenM` \ ty' ->
58 returnM (ty', extractHsTyNames ty')
60 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnM (RenamedHsType, FreeVars)
61 rnHsSigTypeFVs doc_str ty
62 = rnHsSigType doc_str ty `thenM` \ ty' ->
63 returnM (ty', extractHsTyNames ty')
65 rnHsSigType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
66 -- rnHsSigType is used for source-language type signatures,
67 -- which use *implicit* universal quantification.
68 rnHsSigType doc_str ty
69 = rnHsType (text "In the type signature for" <+> doc_str) ty
72 rnHsType is here because we call it from loadInstDecl, and I didn't
73 want a gratuitous knot.
76 rnHsType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
78 rnHsType doc (HsForAllTy Implicit _ ctxt ty)
79 -- Implicit quantifiction in source code (no kinds on tyvars)
80 -- Given the signature C => T we universally quantify
81 -- over FV(T) \ {in-scope-tyvars}
82 = getLocalRdrEnv `thenM` \ name_env ->
84 mentioned = extractHsRhoRdrTyVars ctxt ty
86 -- Don't quantify over type variables that are in scope;
87 -- when GlasgowExts is off, there usually won't be any, except for
89 -- class C a where { op :: a -> a }
90 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env)) mentioned
92 rnForAll doc Implicit (map UserTyVar forall_tyvars) ctxt ty
94 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
95 -- Explicit quantification.
96 -- Check that the forall'd tyvars are actually
97 -- mentioned in the type, and produce a warning if not
99 mentioned = extractHsRhoRdrTyVars ctxt tau
100 forall_tyvar_names = hsTyVarNames forall_tyvars
102 -- Explicitly quantified but not mentioned in ctxt or tau
103 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
105 mappM_ (forAllWarn doc tau) warn_guys `thenM_`
106 rnForAll doc Explicit forall_tyvars ctxt tau
108 rnHsType doc (HsTyVar tyvar)
109 = lookupOccRn tyvar `thenM` \ tyvar' ->
110 returnM (HsTyVar tyvar')
112 rnHsType doc (HsOpTy ty1 op ty2)
113 = lookupOccRn op `thenM` \ op' ->
114 rnHsType doc ty1 `thenM` \ ty1' ->
115 rnHsType doc ty2 `thenM` \ ty2' ->
116 lookupTyFixityRn op' `thenM` \ fix ->
117 mkHsOpTyRn op' fix ty1' ty2'
119 rnHsType doc (HsParTy ty)
120 = rnHsType doc ty `thenM` \ ty' ->
121 returnM (HsParTy ty')
123 rnHsType doc (HsNumTy i)
124 | i == 1 = returnM (HsNumTy i)
125 | otherwise = addErr err_msg `thenM_` returnM (HsNumTy i)
127 err_msg = ptext SLIT("Only unit numeric type pattern is valid")
130 rnHsType doc (HsFunTy ty1 ty2)
131 = rnHsType doc ty1 `thenM` \ ty1' ->
132 -- Might find a for-all as the arg of a function type
133 rnHsType doc ty2 `thenM` \ ty2' ->
134 -- Or as the result. This happens when reading Prelude.hi
135 -- when we find return :: forall m. Monad m -> forall a. a -> m a
136 returnM (HsFunTy ty1' ty2')
138 rnHsType doc (HsListTy ty)
139 = rnHsType doc ty `thenM` \ ty' ->
140 returnM (HsListTy ty')
142 rnHsType doc (HsKindSig ty k)
143 = rnHsType doc ty `thenM` \ ty' ->
144 returnM (HsKindSig ty' k)
146 rnHsType doc (HsPArrTy ty)
147 = rnHsType doc ty `thenM` \ ty' ->
148 returnM (HsPArrTy ty')
150 -- Unboxed tuples are allowed to have poly-typed arguments. These
151 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
152 rnHsType doc (HsTupleTy tup_con tys)
153 = mappM (rnHsType doc) tys `thenM` \ tys' ->
154 returnM (HsTupleTy tup_con tys')
156 rnHsType doc (HsAppTy ty1 ty2)
157 = rnHsType doc ty1 `thenM` \ ty1' ->
158 rnHsType doc ty2 `thenM` \ ty2' ->
159 returnM (HsAppTy ty1' ty2')
161 rnHsType doc (HsPredTy pred)
162 = rnPred doc pred `thenM` \ pred' ->
163 returnM (HsPredTy pred')
165 rnHsTypes doc tys = mappM (rnHsType doc) tys
170 rnForAll doc exp [] [] ty = rnHsType doc ty
171 -- One reason for this case is that a type like Int#
172 -- starts of as (HsForAllTy Nothing [] Int), in case
173 -- there is some quantification. Now that we have quantified
174 -- and discovered there are no type variables, it's nicer to turn
175 -- it into plain Int. If it were Int# instead of Int, we'd actually
176 -- get an error, because the body of a genuine for-all is
179 rnForAll doc exp forall_tyvars ctxt ty
180 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
181 rnContext doc ctxt `thenM` \ new_ctxt ->
182 rnHsType doc ty `thenM` \ new_ty ->
183 returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
184 -- Retain the same implicit/explicit flag as before
185 -- so that we can later print it correctly
189 %*********************************************************
191 \subsection{Fixities}
193 %*********************************************************
195 Infix types are read in a *right-associative* way, so that
200 mkHsOpTyRn rearranges where necessary. The two arguments
201 have already been renamed and rearranged. It's made rather tiresome
202 by the presence of ->
206 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
207 warnIf (not glaExts) (infixTyConWarn n) `thenM_`
210 -- Building (ty1 `op1` (ty21 `op2` ty22))
211 mkHsOpTyRn :: Name -> Fixity
212 -> RenamedHsType -> RenamedHsType
215 mkHsOpTyRn op1 fix1 ty1 ty2@(HsOpTy ty21 op2 ty22)
216 = lookupTyFixityRn op2 `thenM` \ fix2 ->
218 (nofix_error, associate_right) = compareFixity fix1 fix2
221 addErr (precParseErr (quotes (ppr op1),fix1)
222 (quotes (ppr op2),fix2)) `thenM_`
223 returnM (HsOpTy ty1 op1 ty2)
225 if not associate_right then
226 -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
227 mkHsOpTyRn op1 fix1 ty1 ty21 `thenM` \ new_ty ->
228 returnM (HsOpTy new_ty op2 ty22)
230 returnM (HsOpTy ty1 op1 ty2)
232 mkHsOpTyRn op fix ty1 ty2 -- Default case, no rearrangment
233 = returnM (HsOpTy ty1 op ty2)
236 %*********************************************************
238 \subsection{Contexts and predicates}
240 %*********************************************************
243 rnContext :: SDoc -> RdrNameContext -> RnM RenamedContext
244 rnContext doc ctxt = mappM (rnPred doc) ctxt
246 rnPred doc (HsClassP clas tys)
247 = lookupOccRn clas `thenM` \ clas_name ->
248 rnHsTypes doc tys `thenM` \ tys' ->
249 returnM (HsClassP clas_name tys')
251 rnPred doc (HsIParam n ty)
252 = newIPNameRn n `thenM` \ name ->
253 rnHsType doc ty `thenM` \ ty' ->
254 returnM (HsIParam name ty')
258 *********************************************************
260 \subsection{Patterns}
262 *********************************************************
265 rnPatsAndThen :: HsMatchContext Name
268 -> ([RenamedPat] -> RnM (a, FreeVars))
270 -- Bring into scope all the binders and type variables
271 -- bound by the patterns; then rename the patterns; then
272 -- do the thing inside.
274 -- Note that we do a single bindLocalsRn for all the
275 -- matches together, so that we spot the repeated variable in
278 rnPatsAndThen ctxt repUnused pats thing_inside
279 = bindPatSigTyVarsFV pat_sig_tys $
280 bindLocalsFV doc_pat bndrs $ \ new_bndrs ->
281 rnPats pats `thenM` \ (pats', pat_fvs) ->
282 thing_inside pats' `thenM` \ (res, res_fvs) ->
285 unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
288 then warnUnusedMatches unused_binders
289 else returnM ()) `thenM_`
290 returnM (res, res_fvs `plusFV` pat_fvs)
292 pat_sig_tys = collectSigTysFromPats pats
293 bndrs = collectPatsBinders pats
294 doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
296 rnPats :: [RdrNamePat] -> RnM ([RenamedPat], FreeVars)
297 rnPats ps = mapFvRn rnPat ps
299 rnPat :: RdrNamePat -> RnM (RenamedPat, FreeVars)
301 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
304 = lookupBndrRn name `thenM` \ vname ->
305 returnM (VarPat vname, emptyFVs)
307 rnPat (SigPatIn pat ty)
308 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
311 then rnPat pat `thenM` \ (pat', fvs1) ->
312 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
313 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
315 else addErr (patSigErr ty) `thenM_`
318 doc = text "In a pattern type-signature"
320 rnPat (LitPat s@(HsString _))
321 = returnM (LitPat s, unitFV eqStringName)
324 = litFVs lit `thenM` \ fvs ->
325 returnM (LitPat lit, fvs)
327 rnPat (NPatIn lit mb_neg)
328 = rnOverLit lit `thenM` \ (lit', fvs1) ->
330 Nothing -> returnM (Nothing, emptyFVs)
331 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
332 returnM (Just neg, fvs)
333 ) `thenM` \ (mb_neg', fvs2) ->
334 returnM (NPatIn lit' mb_neg',
335 fvs1 `plusFV` fvs2 `addOneFV` eqClassName)
336 -- Needed to find equality on pattern
338 rnPat (NPlusKPatIn name lit _)
339 = rnOverLit lit `thenM` \ (lit', fvs1) ->
340 lookupBndrRn name `thenM` \ name' ->
341 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
342 returnM (NPlusKPatIn name' lit' minus,
343 fvs1 `plusFV` fvs2 `addOneFV` integralClassName)
344 -- The Report says that n+k patterns must be in Integral
347 = rnPat pat `thenM` \ (pat', fvs) ->
348 returnM (LazyPat pat', fvs)
350 rnPat (AsPat name pat)
351 = rnPat pat `thenM` \ (pat', fvs) ->
352 lookupBndrRn name `thenM` \ vname ->
353 returnM (AsPat vname pat', fvs)
355 rnPat (ConPatIn con stuff) = rnConPat con stuff
359 = rnPat pat `thenM` \ (pat', fvs) ->
360 returnM (ParPat pat', fvs)
362 rnPat (ListPat pats _)
363 = rnPats pats `thenM` \ (patslist, fvs) ->
364 returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
366 rnPat (PArrPat pats _)
367 = rnPats pats `thenM` \ (patslist, fvs) ->
368 returnM (PArrPat patslist placeHolderType,
369 fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
371 implicit_fvs = mkFVs [lengthPName, indexPName]
373 rnPat (TuplePat pats boxed)
374 = checkTupSize tup_size `thenM_`
375 rnPats pats `thenM` \ (patslist, fvs) ->
376 returnM (TuplePat patslist boxed, fvs `addOneFV` tycon_name)
378 tup_size = length pats
379 tycon_name = tupleTyCon_name boxed tup_size
381 rnPat (TypePat name) =
382 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
383 returnM (TypePat name', fvs)
385 ------------------------------
386 rnConPat con (PrefixCon pats)
387 = lookupOccRn con `thenM` \ con' ->
388 rnPats pats `thenM` \ (pats', fvs) ->
389 returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` con')
391 rnConPat con (RecCon rpats)
392 = lookupOccRn con `thenM` \ con' ->
393 rnRpats rpats `thenM` \ (rpats', fvs) ->
394 returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` con')
396 rnConPat con (InfixCon pat1 pat2)
397 = lookupOccRn con `thenM` \ con' ->
398 rnPat pat1 `thenM` \ (pat1', fvs1) ->
399 rnPat pat2 `thenM` \ (pat2', fvs2) ->
400 lookupFixityRn con' `thenM` \ fixity ->
401 mkConOpPatRn con' fixity pat1' pat2' `thenM` \ pat' ->
402 returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
404 ------------------------
406 = mappM_ field_dup_err dup_fields `thenM_`
407 mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
408 returnM (rpats', fvs)
410 (_, dup_fields) = removeDups compare [ f | (f,_) <- rpats ]
412 field_dup_err dups = addErr (dupFieldErr "pattern" dups)
415 = lookupGlobalOccRn field `thenM` \ fieldname ->
416 rnPat pat `thenM` \ (pat', fvs) ->
417 returnM ((fieldname, pat'), fvs `addOneFV` fieldname)
421 mkConOpPatRn :: Name -> Fixity -> RenamedPat -> RenamedPat
424 mkConOpPatRn op2 fix2 p1@(ConPatIn op1 (InfixCon p11 p12)) p2
425 = lookupFixityRn op1 `thenM` \ fix1 ->
427 (nofix_error, associate_right) = compareFixity fix1 fix2
430 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
431 returnM (ConPatIn op2 (InfixCon p1 p2))
433 if associate_right then
434 mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p ->
435 returnM (ConPatIn op1 (InfixCon p11 new_p))
437 returnM (ConPatIn op2 (InfixCon p1 p2))
439 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
440 = ASSERT( not_op_pat p2 )
441 returnM (ConPatIn op (InfixCon p1 p2))
443 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
444 not_op_pat other = True
448 %************************************************************************
450 \subsubsection{Literals}
452 %************************************************************************
454 When literals occur we have to make sure
455 that the types and classes they involve
460 = checkErr (inCharRange c) (bogusCharError c) `thenM_`
461 returnM (unitFV charTyCon_name)
463 litFVs (HsCharPrim c) = returnM (unitFV (getName charPrimTyCon))
464 litFVs (HsString s) = returnM (mkFVs [listTyCon_name, charTyCon_name])
465 litFVs (HsStringPrim s) = returnM (unitFV (getName addrPrimTyCon))
466 litFVs (HsInt i) = returnM (unitFV (getName intTyCon))
467 litFVs (HsIntPrim i) = returnM (unitFV (getName intPrimTyCon))
468 litFVs (HsFloatPrim f) = returnM (unitFV (getName floatPrimTyCon))
469 litFVs (HsDoublePrim d) = returnM (unitFV (getName doublePrimTyCon))
470 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
471 -- in post-typechecker translations
473 = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
475 rnOverLit (HsIntegral i _)
476 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
478 returnM (HsIntegral i from_integer_name, fvs)
480 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
481 -- Big integer literals are built, using + and *,
482 -- out of small integers (DsUtils.mkIntegerLit)
483 -- [NB: plusInteger, timesInteger aren't rebindable...
484 -- they are used to construct the argument to fromInteger,
485 -- which is the rebindable one.]
487 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
489 rnOverLit (HsFractional i _)
490 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
492 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
493 -- We have to make sure that the Ratio type is imported with
494 -- its constructor, because literals of type Ratio t are
495 -- built with that constructor.
496 -- The Rational type is needed too, but that will come in
497 -- as part of the type for fromRational.
498 -- The plus/times integer operations may be needed to construct the numerator
499 -- and denominator (see DsUtils.mkIntegerLit)
501 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
506 %*********************************************************
510 %*********************************************************
513 checkTupSize :: Int -> RnM ()
514 checkTupSize tup_size
515 | tup_size <= mAX_TUPLE_SIZE
518 = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
519 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
520 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
522 forAllWarn doc ty tyvar
523 = ifOptM Opt_WarnUnusedMatches $
524 addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
525 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
531 = hang (ptext SLIT("precedence parsing error"))
532 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
534 ptext SLIT("in the same infix expression")])
536 sectionPrecErr op arg_op section
537 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
538 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
539 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
542 = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op)
545 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
546 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
548 dupFieldErr str (dup:rest)
549 = hsep [ptext SLIT("duplicate field name"),
551 ptext SLIT("in record"), text str]
553 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
554 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)