2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnTypes ( rnHsType, rnLHsType, rnContext,
8 rnHsSigType, rnHsTypeFVs,
9 rnLPat, rnPat, rnPatsAndThen, -- Here because it's not part
10 rnLit, rnOverLit, -- of any mutual recursion
11 precParseErr, sectionPrecErr, dupFieldErr, patSigErr, checkTupSize
14 import CmdLineOpts ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
17 import RdrHsSyn ( extractHsRhoRdrTyVars )
18 import RnHsSyn ( extractHsTyNames, parrTyCon_name, tupleTyCon_name,
19 listTyCon_name, charTyCon_name
21 import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
22 lookupLocatedOccRn, lookupLocatedBndrRn,
23 lookupLocatedGlobalOccRn, bindTyVarsRn, lookupFixityRn,
24 mapFvRn, warnUnusedMatches,
25 newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV )
27 import RdrName ( RdrName, elemLocalRdrEnv )
28 import PrelNames ( eqStringName, eqClassName, integralClassName,
29 negateName, minusName, lengthPName, indexPName,
30 plusIntegerName, fromIntegerName, timesIntegerName,
31 ratioDataConName, fromRationalName )
32 import Constants ( mAX_TUPLE_SIZE )
33 import TysWiredIn ( intTyCon )
34 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
35 floatPrimTyCon, doublePrimTyCon )
36 import Name ( Name, NamedThing(..) )
37 import SrcLoc ( Located(..), unLoc )
40 import Literal ( inIntRange, inCharRange )
41 import BasicTypes ( compareFixity )
42 import ListSetOps ( removeDups )
46 #include "HsVersions.h"
49 These type renamers are in a separate module, rather than in (say) RnSource,
50 to break several loop.
52 %*********************************************************
54 \subsection{Renaming types}
56 %*********************************************************
59 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
60 rnHsTypeFVs doc_str ty
61 = rnLHsType doc_str ty `thenM` \ ty' ->
62 returnM (ty', extractHsTyNames ty')
64 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
65 -- rnHsSigType is used for source-language type signatures,
66 -- which use *implicit* universal quantification.
67 rnHsSigType doc_str ty
68 = rnLHsType (text "In the type signature for" <+> doc_str) ty
71 rnHsType is here because we call it from loadInstDecl, and I didn't
72 want a gratuitous knot.
75 rnLHsType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
76 rnLHsType doc = wrapLocM (rnHsType doc)
78 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
80 rnHsType doc (HsForAllTy Implicit _ ctxt ty)
81 -- Implicit quantifiction in source code (no kinds on tyvars)
82 -- Given the signature C => T we universally quantify
83 -- over FV(T) \ {in-scope-tyvars}
84 = getLocalRdrEnv `thenM` \ name_env ->
86 mentioned = extractHsRhoRdrTyVars ctxt ty
88 -- Don't quantify over type variables that are in scope;
89 -- when GlasgowExts is off, there usually won't be any, except for
91 -- class C a where { op :: a -> a }
92 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
93 tyvar_bndrs = [ L loc (UserTyVar v) | (L loc v) <- forall_tyvars ]
95 rnForAll doc Implicit tyvar_bndrs ctxt ty
97 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
98 -- Explicit quantification.
99 -- Check that the forall'd tyvars are actually
100 -- mentioned in the type, and produce a warning if not
102 mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
103 forall_tyvar_names = hsLTyVarLocNames forall_tyvars
105 -- Explicitly quantified but not mentioned in ctxt or tau
106 warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
108 mappM_ (forAllWarn doc tau) warn_guys `thenM_`
109 rnForAll doc Explicit forall_tyvars ctxt tau
111 rnHsType doc (HsTyVar tyvar)
112 = lookupOccRn tyvar `thenM` \ tyvar' ->
113 returnM (HsTyVar tyvar')
115 rnHsType doc (HsOpTy ty1 (L loc op) ty2)
117 lookupOccRn op `thenM` \ op' ->
118 lookupTyFixityRn (L loc op') `thenM` \ fix ->
119 rnLHsType doc ty1 `thenM` \ ty1' ->
120 rnLHsType doc ty2 `thenM` \ ty2' ->
121 mkHsOpTyRn (L loc op') fix ty1' ty2'
124 rnHsType doc (HsParTy ty)
125 = rnLHsType doc ty `thenM` \ ty' ->
126 returnM (HsParTy ty')
128 rnHsType doc (HsNumTy i)
129 | i == 1 = returnM (HsNumTy i)
130 | otherwise = addErr err_msg `thenM_` returnM (HsNumTy i)
132 err_msg = ptext SLIT("Only unit numeric type pattern is valid")
135 rnHsType doc (HsFunTy ty1 ty2)
136 = rnLHsType doc ty1 `thenM` \ ty1' ->
137 -- Might find a for-all as the arg of a function type
138 rnLHsType doc ty2 `thenM` \ ty2' ->
139 -- Or as the result. This happens when reading Prelude.hi
140 -- when we find return :: forall m. Monad m -> forall a. a -> m a
141 returnM (HsFunTy ty1' ty2')
143 rnHsType doc (HsListTy ty)
144 = rnLHsType doc ty `thenM` \ ty' ->
145 returnM (HsListTy ty')
147 rnHsType doc (HsKindSig ty k)
148 = rnLHsType doc ty `thenM` \ ty' ->
149 returnM (HsKindSig ty' k)
151 rnHsType doc (HsPArrTy ty)
152 = rnLHsType doc ty `thenM` \ ty' ->
153 returnM (HsPArrTy ty')
155 -- Unboxed tuples are allowed to have poly-typed arguments. These
156 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
157 rnHsType doc (HsTupleTy tup_con tys)
158 = mappM (rnLHsType doc) tys `thenM` \ tys' ->
159 returnM (HsTupleTy tup_con tys')
161 rnHsType doc (HsAppTy ty1 ty2)
162 = rnLHsType doc ty1 `thenM` \ ty1' ->
163 rnLHsType doc ty2 `thenM` \ ty2' ->
164 returnM (HsAppTy ty1' ty2')
166 rnHsType doc (HsPredTy pred)
167 = rnLPred doc pred `thenM` \ pred' ->
168 returnM (HsPredTy pred')
170 rnLHsTypes doc tys = mappM (rnLHsType doc) tys
175 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName] -> LHsContext RdrName
176 -> LHsType RdrName -> RnM (HsType Name)
178 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
179 -- One reason for this case is that a type like Int#
180 -- starts of as (HsForAllTy Nothing [] Int), in case
181 -- there is some quantification. Now that we have quantified
182 -- and discovered there are no type variables, it's nicer to turn
183 -- it into plain Int. If it were Int# instead of Int, we'd actually
184 -- get an error, because the body of a genuine for-all is
187 rnForAll doc exp forall_tyvars ctxt ty
188 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
189 rnContext doc ctxt `thenM` \ new_ctxt ->
190 rnLHsType doc ty `thenM` \ new_ty ->
191 returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
192 -- Retain the same implicit/explicit flag as before
193 -- so that we can later print it correctly
197 %*********************************************************
199 \subsection{Fixities}
201 %*********************************************************
203 Infix types are read in a *right-associative* way, so that
208 mkHsOpTyRn rearranges where necessary. The two arguments
209 have already been renamed and rearranged. It's made rather tiresome
210 by the presence of ->
213 lookupTyFixityRn (L loc n)
214 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
216 (addSrcSpan loc $ addWarn (infixTyConWarn n)) `thenM_`
219 -- Building (ty1 `op1` (ty21 `op2` ty22))
220 mkHsOpTyRn :: Located Name -> Fixity
221 -> LHsType Name -> LHsType Name
224 mkHsOpTyRn op1 fix1 ty1 ty2@(L loc (HsOpTy ty21 op2 ty22))
225 = lookupTyFixityRn op2 `thenM` \ fix2 ->
227 (nofix_error, associate_right) = compareFixity fix1 fix2
230 addErr (precParseErr (quotes (ppr op1),fix1)
231 (quotes (ppr op2),fix2)) `thenM_`
232 returnM (HsOpTy ty1 op1 ty2)
234 if not associate_right then
235 -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
236 mkHsOpTyRn op1 fix1 ty1 ty21 `thenM` \ new_ty ->
237 returnM (HsOpTy (L loc new_ty) op2 ty22) -- XXX loc is wrong
239 returnM (HsOpTy ty1 op1 ty2)
241 mkHsOpTyRn op fix ty1 ty2 -- Default case, no rearrangment
242 = returnM (HsOpTy ty1 op ty2)
245 %*********************************************************
247 \subsection{Contexts and predicates}
249 %*********************************************************
252 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
253 rnContext doc = wrapLocM (rnContext' doc)
255 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
256 rnContext' doc ctxt = mappM (rnLPred doc) ctxt
258 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
259 rnLPred doc = wrapLocM (rnPred doc)
261 rnPred doc (HsClassP clas tys)
262 = lookupOccRn clas `thenM` \ clas_name ->
263 rnLHsTypes doc tys `thenM` \ tys' ->
264 returnM (HsClassP clas_name tys')
266 rnPred doc (HsIParam n ty)
267 = newIPNameRn n `thenM` \ name ->
268 rnLHsType doc ty `thenM` \ ty' ->
269 returnM (HsIParam name ty')
273 *********************************************************
275 \subsection{Patterns}
277 *********************************************************
280 rnPatsAndThen :: HsMatchContext Name
283 -> ([LPat Name] -> RnM (a, FreeVars))
285 -- Bring into scope all the binders and type variables
286 -- bound by the patterns; then rename the patterns; then
287 -- do the thing inside.
289 -- Note that we do a single bindLocalsRn for all the
290 -- matches together, so that we spot the repeated variable in
293 rnPatsAndThen ctxt repUnused pats thing_inside
294 = bindPatSigTyVarsFV pat_sig_tys $
295 bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs ->
296 rnLPats pats `thenM` \ (pats', pat_fvs) ->
297 thing_inside pats' `thenM` \ (res, res_fvs) ->
300 unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
303 then warnUnusedMatches unused_binders
304 else returnM ()) `thenM_`
305 returnM (res, res_fvs `plusFV` pat_fvs)
307 pat_sig_tys = collectSigTysFromPats pats
308 bndrs = collectLocatedPatsBinders pats
309 doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
311 rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
312 rnLPats ps = mapFvRn rnLPat ps
314 rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
315 rnLPat = wrapLocFstM rnPat
317 -- -----------------------------------------------------------------------------
320 rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
322 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
325 = lookupBndrRn name `thenM` \ vname ->
326 returnM (VarPat vname, emptyFVs)
328 rnPat (SigPatIn pat ty)
329 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
332 then rnLPat pat `thenM` \ (pat', fvs1) ->
333 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
334 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
336 else addErr (patSigErr ty) `thenM_`
337 rnPat (unLoc pat) -- XXX shouldn't throw away the loc
339 doc = text "In a pattern type-signature"
343 returnM (LitPat lit, emptyFVs)
345 rnPat (NPatIn lit mb_neg)
346 = rnOverLit lit `thenM` \ (lit', fvs1) ->
348 Nothing -> returnM (Nothing, emptyFVs)
349 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
350 returnM (Just neg, fvs)
351 ) `thenM` \ (mb_neg', fvs2) ->
352 returnM (NPatIn lit' mb_neg',
353 fvs1 `plusFV` fvs2 `addOneFV` eqClassName)
354 -- Needed to find equality on pattern
356 rnPat (NPlusKPatIn name lit _)
357 = rnOverLit lit `thenM` \ (lit', fvs1) ->
358 lookupLocatedBndrRn name `thenM` \ name' ->
359 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
360 returnM (NPlusKPatIn name' lit' minus,
361 fvs1 `plusFV` fvs2 `addOneFV` integralClassName)
362 -- The Report says that n+k patterns must be in Integral
365 = rnLPat pat `thenM` \ (pat', fvs) ->
366 returnM (LazyPat pat', fvs)
368 rnPat (AsPat name pat)
369 = rnLPat pat `thenM` \ (pat', fvs) ->
370 lookupLocatedBndrRn name `thenM` \ vname ->
371 returnM (AsPat vname pat', fvs)
373 rnPat (ConPatIn con stuff) = rnConPat con stuff
377 = rnLPat pat `thenM` \ (pat', fvs) ->
378 returnM (ParPat pat', fvs)
380 rnPat (ListPat pats _)
381 = rnLPats pats `thenM` \ (patslist, fvs) ->
382 returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
384 rnPat (PArrPat pats _)
385 = rnLPats pats `thenM` \ (patslist, fvs) ->
386 returnM (PArrPat patslist placeHolderType,
387 fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
389 implicit_fvs = mkFVs [lengthPName, indexPName]
391 rnPat (TuplePat pats boxed)
392 = checkTupSize tup_size `thenM_`
393 rnLPats pats `thenM` \ (patslist, fvs) ->
394 returnM (TuplePat patslist boxed, fvs `addOneFV` tycon_name)
396 tup_size = length pats
397 tycon_name = tupleTyCon_name boxed tup_size
399 rnPat (TypePat name) =
400 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
401 returnM (TypePat name', fvs)
403 -- -----------------------------------------------------------------------------
406 rnConPat con (PrefixCon pats)
407 = lookupLocatedOccRn con `thenM` \ con' ->
408 rnLPats pats `thenM` \ (pats', fvs) ->
409 returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con')
411 rnConPat con (RecCon rpats)
412 = lookupLocatedOccRn con `thenM` \ con' ->
413 rnRpats rpats `thenM` \ (rpats', fvs) ->
414 returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con')
416 rnConPat con (InfixCon pat1 pat2)
417 = lookupLocatedOccRn con `thenM` \ con' ->
418 rnLPat pat1 `thenM` \ (pat1', fvs1) ->
419 rnLPat pat2 `thenM` \ (pat2', fvs2) ->
420 lookupFixityRn (unLoc con') `thenM` \ fixity ->
421 mkConOpPatRn con' fixity pat1' pat2' `thenM` \ pat' ->
422 returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con')
424 -- -----------------------------------------------------------------------------
427 rnRpats :: [(Located RdrName, LPat RdrName)]
428 -> RnM ([(Located Name, LPat Name)], FreeVars)
430 = mappM_ field_dup_err dup_fields `thenM_`
431 mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
432 returnM (rpats', fvs)
434 (_, dup_fields) = removeDups compare [ unLoc f | (f,_) <- rpats ]
436 field_dup_err dups = addErr (dupFieldErr "pattern" dups)
439 = lookupLocatedGlobalOccRn field `thenM` \ fieldname ->
440 rnLPat pat `thenM` \ (pat', fvs) ->
441 returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname)
443 -- -----------------------------------------------------------------------------
446 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
449 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
450 = lookupFixityRn (unLoc op1) `thenM` \ fix1 ->
452 (nofix_error, associate_right) = compareFixity fix1 fix2
455 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
456 returnM (ConPatIn op2 (InfixCon p1 p2))
458 if associate_right then
459 mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p ->
460 returnM (ConPatIn op1 (InfixCon p11 (L loc new_p))) -- XXX loc right?
462 returnM (ConPatIn op2 (InfixCon p1 p2))
464 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
465 = ASSERT( not_op_pat (unLoc p2) )
466 returnM (ConPatIn op (InfixCon p1 p2))
468 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
469 not_op_pat other = True
473 %************************************************************************
475 \subsubsection{Literals}
477 %************************************************************************
479 When literals occur we have to make sure
480 that the types and classes they involve
484 rnLit :: HsLit -> RnM ()
485 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
486 rnLit other = returnM ()
488 rnOverLit (HsIntegral i _)
489 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
491 returnM (HsIntegral i from_integer_name, fvs)
493 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
494 -- Big integer literals are built, using + and *,
495 -- out of small integers (DsUtils.mkIntegerLit)
496 -- [NB: plusInteger, timesInteger aren't rebindable...
497 -- they are used to construct the argument to fromInteger,
498 -- which is the rebindable one.]
500 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
502 rnOverLit (HsFractional i _)
503 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
505 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
506 -- We have to make sure that the Ratio type is imported with
507 -- its constructor, because literals of type Ratio t are
508 -- built with that constructor.
509 -- The Rational type is needed too, but that will come in
510 -- as part of the type for fromRational.
511 -- The plus/times integer operations may be needed to construct the numerator
512 -- and denominator (see DsUtils.mkIntegerLit)
514 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
519 %*********************************************************
523 %*********************************************************
526 checkTupSize :: Int -> RnM ()
527 checkTupSize tup_size
528 | tup_size <= mAX_TUPLE_SIZE
531 = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
532 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
533 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
535 forAllWarn doc ty (L loc tyvar)
536 = ifOptM Opt_WarnUnusedMatches $
538 addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
539 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
545 = ptext SLIT("character literal out of range: '\\") <> char c <> char '\''
548 = hang (ptext SLIT("precedence parsing error"))
549 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
551 ptext SLIT("in the same infix expression")])
553 sectionPrecErr op arg_op section
554 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
555 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
556 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
559 = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op)
562 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
563 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
566 = hsep [ptext SLIT("duplicate field name"),
568 ptext SLIT("in record"), text str]
570 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
571 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)