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_WarnMisc, Opt_WarnUnusedMatches, Opt_GlasgowExts) )
17 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNamePat,
18 extractHsTyRdrTyVars, extractHsCtxtRdrTyVars )
19 import RnHsSyn ( RenamedContext, RenamedHsType, RenamedPat,
21 parrTyCon_name, tupleTyCon_name, listTyCon_name, charTyCon_name )
22 import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName, lookupGlobalOccRn,
23 newIPName, bindTyVarsRn, lookupFixityRn, mapFvRn,
24 bindPatSigTyVarsFV, bindLocalsFV, warnUnusedMatches )
27 import PrelNames( cCallishClassKeys, eqStringName, eqClassName, integralClassName,
28 negateName, minusName, lengthPName, indexPName, plusIntegerName, fromIntegerName,
29 timesIntegerName, ratioDataConName, fromRationalName, cCallableClassName )
30 import Constants ( mAX_TUPLE_SIZE )
31 import TysWiredIn ( intTyCon )
32 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
33 floatPrimTyCon, doublePrimTyCon )
34 import RdrName ( elemRdrEnv )
35 import Name ( Name, NamedThing(..) )
37 import Unique ( Uniquable(..) )
39 import Literal ( inIntRange, inCharRange )
40 import BasicTypes ( compareFixity, arrowFixity )
42 import ListSetOps ( removeDupsEq, removeDups )
45 #include "HsVersions.h"
48 These type renamers are in a separate module, rather than in (say) RnSource,
49 to break several loop.
51 %*********************************************************
53 \subsection{Renaming types}
55 %*********************************************************
58 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnM (RenamedHsType, FreeVars)
59 rnHsTypeFVs doc_str ty
60 = rnHsType doc_str ty `thenM` \ ty' ->
61 returnM (ty', extractHsTyNames ty')
63 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnM (RenamedHsType, FreeVars)
64 rnHsSigTypeFVs doc_str ty
65 = rnHsSigType doc_str ty `thenM` \ ty' ->
66 returnM (ty', extractHsTyNames ty')
68 rnHsSigType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
69 -- rnHsSigType is used for source-language type signatures,
70 -- which use *implicit* universal quantification.
71 rnHsSigType doc_str ty
72 = rnHsType (text "In the type signature for" <+> doc_str) ty
75 rnHsType is here because we call it from loadInstDecl, and I didn't
76 want a gratuitous knot.
79 rnHsType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
81 rnHsType doc (HsForAllTy Nothing ctxt ty)
82 -- Implicit quantifiction in source code (no kinds on tyvars)
83 -- Given the signature C => T we universally quantify
84 -- over FV(T) \ {in-scope-tyvars}
85 = getLocalRdrEnv `thenM` \ name_env ->
87 mentioned_in_tau = extractHsTyRdrTyVars ty
88 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
89 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
91 -- Don't quantify over type variables that are in scope;
92 -- when GlasgowExts is off, there usually won't be any, except for
94 -- class C a where { op :: a -> a }
95 forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
97 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
99 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
100 -- Explicit quantification.
101 -- Check that the forall'd tyvars are actually
102 -- mentioned in the type, and produce a warning if not
104 mentioned_in_tau = extractHsTyRdrTyVars tau
105 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
106 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
107 forall_tyvar_names = hsTyVarNames forall_tyvars
109 -- Explicitly quantified but not mentioned in ctxt or tau
110 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
112 mappM_ (forAllWarn doc tau) warn_guys `thenM_`
113 rnForAll doc forall_tyvars ctxt tau
115 rnHsType doc (HsTyVar tyvar)
116 = lookupOccRn tyvar `thenM` \ tyvar' ->
117 returnM (HsTyVar tyvar')
119 rnHsType doc (HsOpTy ty1 op ty2)
121 HsArrow -> returnM HsArrow
122 HsTyOp n -> lookupOccRn n `thenM` \ n' ->
125 rnHsType doc ty1 `thenM` \ ty1' ->
126 rnHsType doc ty2 `thenM` \ ty2' ->
127 lookupTyFixityRn op' `thenM` \ fix ->
128 mkHsOpTyRn op' fix ty1' ty2'
130 rnHsType doc (HsParTy ty)
131 = rnHsType doc ty `thenM` \ ty' ->
132 returnM (HsParTy ty')
134 rnHsType doc (HsNumTy i)
135 | i == 1 = returnM (HsNumTy i)
136 | otherwise = addErr err_msg `thenM_` returnM (HsNumTy i)
138 err_msg = ptext SLIT("Only unit numeric type pattern is valid")
141 rnHsType doc (HsFunTy ty1 ty2)
142 = rnHsType doc ty1 `thenM` \ ty1' ->
143 -- Might find a for-all as the arg of a function type
144 rnHsType doc ty2 `thenM` \ ty2' ->
145 -- Or as the result. This happens when reading Prelude.hi
146 -- when we find return :: forall m. Monad m -> forall a. a -> m a
147 returnM (HsFunTy ty1' ty2')
149 rnHsType doc (HsListTy ty)
150 = rnHsType doc ty `thenM` \ ty' ->
151 returnM (HsListTy ty')
153 rnHsType doc (HsKindSig ty k)
154 = rnHsType doc ty `thenM` \ ty' ->
155 returnM (HsKindSig ty' k)
157 rnHsType doc (HsPArrTy ty)
158 = rnHsType doc ty `thenM` \ ty' ->
159 returnM (HsPArrTy ty')
161 -- Unboxed tuples are allowed to have poly-typed arguments. These
162 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
163 rnHsType doc (HsTupleTy tup_con tys)
164 = mappM (rnHsType doc) tys `thenM` \ tys' ->
165 returnM (HsTupleTy tup_con tys')
167 rnHsType doc (HsAppTy ty1 ty2)
168 = rnHsType doc ty1 `thenM` \ ty1' ->
169 rnHsType doc ty2 `thenM` \ ty2' ->
170 returnM (HsAppTy ty1' ty2')
172 rnHsType doc (HsPredTy pred)
173 = rnPred doc pred `thenM` \ pred' ->
174 returnM (HsPredTy pred')
176 rnHsTypes doc tys = mappM (rnHsType doc) tys
181 rnForAll doc forall_tyvars ctxt ty
182 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
183 rnContext doc ctxt `thenM` \ new_ctxt ->
184 rnHsType doc ty `thenM` \ new_ty ->
185 returnM (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
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 ->
205 lookupTyFixityRn HsArrow = returnM arrowFixity
206 lookupTyFixityRn (HsTyOp n)
207 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
208 warnIf (not glaExts) (infixTyConWarn n) `thenM_`
211 -- Building (ty1 `op1` (ty21 `op2` ty22))
212 mkHsOpTyRn :: HsTyOp Name -> Fixity
213 -> RenamedHsType -> RenamedHsType
216 mkHsOpTyRn op1 fix1 ty1 ty2@(HsOpTy ty21 op2 ty22)
217 = lookupTyFixityRn op2 `thenM` \ fix2 ->
219 (nofix_error, associate_right) = compareFixity fix1 fix2
222 addErr (precParseErr (quotes (ppr op1),fix1)
223 (quotes (ppr op2),fix2)) `thenM_`
224 returnM (HsOpTy ty1 op1 ty2)
226 if not associate_right then
227 -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
228 mkHsOpTyRn op1 fix1 ty1 ty21 `thenM` \ new_ty ->
229 returnM (HsOpTy new_ty op2 ty22)
231 returnM (HsOpTy ty1 op1 ty2)
233 mkHsOpTyRn op fix ty1 ty2 -- Default case, no rearrangment
234 = returnM (HsOpTy ty1 op ty2)
236 mkHsFunTyRn ty1 ty2 -- Precedence of function arrow is 0
237 = returnM (HsFunTy ty1 ty2) -- so no rearrangement reqd. Change
238 -- this if fixity of -> increases.
240 not_op_ty (HsOpTy _ _ _) = False
241 not_op_ty other = True
244 %*********************************************************
246 \subsection{Contexts and predicates}
248 %*********************************************************
251 rnContext :: SDoc -> RdrNameContext -> RnM RenamedContext
253 = mappM rn_pred ctxt `thenM` \ theta ->
255 -- Check for duplicate assertions
256 -- If this isn't an error, then it ought to be:
257 ifOptM Opt_WarnMisc (
259 (_, dups) = removeDupsEq theta
260 -- We only have equality, not ordering
262 mappM_ (addWarn . dupClassAssertWarn theta) dups
267 --Someone discovered that @CCallable@ and @CReturnable@
268 -- could be used in contexts such as:
269 -- foo :: CCallable a => a -> PrimIO Int
270 -- Doing this utterly wrecks the whole point of introducing these
271 -- classes so we specifically check that this isn't being done.
272 rn_pred pred = rnPred doc pred `thenM` \ pred'->
273 checkErr (not (bad_pred pred'))
274 (naughtyCCallContextErr pred') `thenM_`
277 bad_pred (HsClassP clas _) = getUnique clas `elem` cCallishClassKeys
278 bad_pred other = False
281 rnPred doc (HsClassP clas tys)
282 = lookupOccRn clas `thenM` \ clas_name ->
283 rnHsTypes doc tys `thenM` \ tys' ->
284 returnM (HsClassP clas_name tys')
286 rnPred doc (HsIParam n ty)
287 = newIPName n `thenM` \ name ->
288 rnHsType doc ty `thenM` \ ty' ->
289 returnM (HsIParam name ty')
293 *********************************************************
295 \subsection{Patterns}
297 *********************************************************
300 rnPatsAndThen :: HsMatchContext Name
302 -> ([RenamedPat] -> RnM (a, FreeVars))
304 -- Bring into scope all the binders and type variables
305 -- bound by the patterns; then rename the patterns; then
306 -- do the thing inside.
308 -- Note that we do a single bindLocalsRn for all the
309 -- matches together, so that we spot the repeated variable in
312 rnPatsAndThen ctxt pats thing_inside
313 = bindPatSigTyVarsFV pat_sig_tys $
314 bindLocalsFV doc_pat bndrs $ \ new_bndrs ->
315 rnPats pats `thenM` \ (pats', pat_fvs) ->
316 thing_inside pats' `thenM` \ (res, res_fvs) ->
319 unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
321 warnUnusedMatches unused_binders `thenM_`
323 returnM (res, res_fvs `plusFV` pat_fvs)
325 pat_sig_tys = collectSigTysFromPats pats
326 bndrs = collectPatsBinders pats
327 doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
329 rnPats :: [RdrNamePat] -> RnM ([RenamedPat], FreeVars)
330 rnPats ps = mapFvRn rnPat ps
332 rnPat :: RdrNamePat -> RnM (RenamedPat, FreeVars)
334 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
337 = lookupBndrRn name `thenM` \ vname ->
338 returnM (VarPat vname, emptyFVs)
340 rnPat (SigPatIn pat ty)
341 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
344 then rnPat pat `thenM` \ (pat', fvs1) ->
345 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
346 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
348 else addErr (patSigErr ty) `thenM_`
351 doc = text "In a pattern type-signature"
353 rnPat (LitPat s@(HsString _))
354 = returnM (LitPat s, unitFV eqStringName)
357 = litFVs lit `thenM` \ fvs ->
358 returnM (LitPat lit, fvs)
360 rnPat (NPatIn lit mb_neg)
361 = rnOverLit lit `thenM` \ (lit', fvs1) ->
363 Nothing -> returnM (Nothing, emptyFVs)
364 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
365 returnM (Just neg, fvs)
366 ) `thenM` \ (mb_neg', fvs2) ->
367 returnM (NPatIn lit' mb_neg',
368 fvs1 `plusFV` fvs2 `addOneFV` eqClassName)
369 -- Needed to find equality on pattern
371 rnPat (NPlusKPatIn name lit _)
372 = rnOverLit lit `thenM` \ (lit', fvs1) ->
373 lookupBndrRn name `thenM` \ name' ->
374 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
375 returnM (NPlusKPatIn name' lit' minus,
376 fvs1 `plusFV` fvs2 `addOneFV` integralClassName)
377 -- The Report says that n+k patterns must be in Integral
380 = rnPat pat `thenM` \ (pat', fvs) ->
381 returnM (LazyPat pat', fvs)
383 rnPat (AsPat name pat)
384 = rnPat pat `thenM` \ (pat', fvs) ->
385 lookupBndrRn name `thenM` \ vname ->
386 returnM (AsPat vname pat', fvs)
388 rnPat (ConPatIn con stuff) = rnConPat con stuff
392 = rnPat pat `thenM` \ (pat', fvs) ->
393 returnM (ParPat pat', fvs)
395 rnPat (ListPat pats _)
396 = rnPats pats `thenM` \ (patslist, fvs) ->
397 returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
399 rnPat (PArrPat pats _)
400 = rnPats pats `thenM` \ (patslist, fvs) ->
401 returnM (PArrPat patslist placeHolderType,
402 fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
404 implicit_fvs = mkFVs [lengthPName, indexPName]
406 rnPat (TuplePat pats boxed)
407 = checkTupSize tup_size `thenM_`
408 rnPats pats `thenM` \ (patslist, fvs) ->
409 returnM (TuplePat patslist boxed, fvs `addOneFV` tycon_name)
411 tup_size = length pats
412 tycon_name = tupleTyCon_name boxed tup_size
414 rnPat (TypePat name) =
415 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
416 returnM (TypePat name', fvs)
418 ------------------------------
419 rnConPat con (PrefixCon pats)
420 = lookupOccRn con `thenM` \ con' ->
421 rnPats pats `thenM` \ (pats', fvs) ->
422 returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` con')
424 rnConPat con (RecCon rpats)
425 = lookupOccRn con `thenM` \ con' ->
426 rnRpats rpats `thenM` \ (rpats', fvs) ->
427 returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` con')
429 rnConPat con (InfixCon pat1 pat2)
430 = lookupOccRn con `thenM` \ con' ->
431 rnPat pat1 `thenM` \ (pat1', fvs1) ->
432 rnPat pat2 `thenM` \ (pat2', fvs2) ->
434 getModeRn `thenM` \ mode ->
435 -- See comments with rnExpr (OpApp ...)
436 (if isInterfaceMode mode
437 then returnM (ConPatIn con' (InfixCon pat1' pat2'))
438 else lookupFixityRn con' `thenM` \ fixity ->
439 mkConOpPatRn con' fixity pat1' pat2'
441 returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
443 ------------------------
445 = mappM_ field_dup_err dup_fields `thenM_`
446 mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
447 returnM (rpats', fvs)
449 (_, dup_fields) = removeDups compare [ f | (f,_) <- rpats ]
451 field_dup_err dups = addErr (dupFieldErr "pattern" dups)
454 = lookupGlobalOccRn field `thenM` \ fieldname ->
455 rnPat pat `thenM` \ (pat', fvs) ->
456 returnM ((fieldname, pat'), fvs `addOneFV` fieldname)
460 mkConOpPatRn :: Name -> Fixity -> RenamedPat -> RenamedPat
463 mkConOpPatRn op2 fix2 p1@(ConPatIn op1 (InfixCon p11 p12)) p2
464 = lookupFixityRn op1 `thenM` \ fix1 ->
466 (nofix_error, associate_right) = compareFixity fix1 fix2
469 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
470 returnM (ConPatIn op2 (InfixCon p1 p2))
472 if associate_right then
473 mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p ->
474 returnM (ConPatIn op1 (InfixCon p11 new_p))
476 returnM (ConPatIn op2 (InfixCon p1 p2))
478 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
479 = ASSERT( not_op_pat p2 )
480 returnM (ConPatIn op (InfixCon p1 p2))
482 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
483 not_op_pat other = True
487 %************************************************************************
489 \subsubsection{Literals}
491 %************************************************************************
493 When literals occur we have to make sure
494 that the types and classes they involve
499 = checkErr (inCharRange c) (bogusCharError c) `thenM_`
500 returnM (unitFV charTyCon_name)
502 litFVs (HsCharPrim c) = returnM (unitFV (getName charPrimTyCon))
503 litFVs (HsString s) = returnM (mkFVs [listTyCon_name, charTyCon_name])
504 litFVs (HsStringPrim s) = returnM (unitFV (getName addrPrimTyCon))
505 litFVs (HsInt i) = returnM (unitFV (getName intTyCon))
506 litFVs (HsIntPrim i) = returnM (unitFV (getName intPrimTyCon))
507 litFVs (HsFloatPrim f) = returnM (unitFV (getName floatPrimTyCon))
508 litFVs (HsDoublePrim d) = returnM (unitFV (getName doublePrimTyCon))
509 litFVs (HsLitLit l bogus_ty) = returnM (unitFV cCallableClassName)
510 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
511 -- in post-typechecker translations
513 = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
515 rnOverLit (HsIntegral i _)
516 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
518 returnM (HsIntegral i from_integer_name, fvs)
520 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
521 -- Big integer literals are built, using + and *,
522 -- out of small integers (DsUtils.mkIntegerLit)
523 -- [NB: plusInteger, timesInteger aren't rebindable...
524 -- they are used to construct the argument to fromInteger,
525 -- which is the rebindable one.]
527 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
529 rnOverLit (HsFractional i _)
530 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
532 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
533 -- We have to make sure that the Ratio type is imported with
534 -- its constructor, because literals of type Ratio t are
535 -- built with that constructor.
536 -- The Rational type is needed too, but that will come in
537 -- as part of the type for fromRational.
538 -- The plus/times integer operations may be needed to construct the numerator
539 -- and denominator (see DsUtils.mkIntegerLit)
541 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
546 %*********************************************************
550 %*********************************************************
553 checkTupSize :: Int -> RnM ()
554 checkTupSize tup_size
555 | tup_size <= mAX_TUPLE_SIZE
558 = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
559 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
560 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
562 forAllWarn doc ty tyvar
563 = ifOptM Opt_WarnUnusedMatches $
564 getModeRn `thenM` \ mode ->
567 InterfaceMode _ -> returnM () ; -- Don't warn of unused tyvars in interface files
568 -- unless DEBUG is on, in which case it is slightly
569 -- informative. They can arise from mkRhsTyLam,
570 #endif -- leading to (say) f :: forall a b. [b] -> [b]
573 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
574 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
580 dupClassAssertWarn ctxt (assertion : dups)
581 = sep [hsep [ptext SLIT("Duplicate class assertion"),
582 quotes (ppr assertion),
583 ptext SLIT("in the context:")],
584 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
586 naughtyCCallContextErr (HsClassP clas _)
587 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
588 ptext SLIT("in a context")]
591 = hang (ptext SLIT("precedence parsing error"))
592 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
594 ptext SLIT("in the same infix expression")])
596 sectionPrecErr op arg_op section
597 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
598 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
599 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
602 = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op)
605 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
606 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
608 dupFieldErr str (dup:rest)
609 = hsep [ptext SLIT("duplicate field name"),
611 ptext SLIT("in record"), text str]
613 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
614 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)