2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
9 rnHsType, rnLHsType, rnLHsTypes, rnContext,
10 rnHsSigType, rnHsTypeFVs,
12 -- Patterns and literals
13 rnLPat, rnPat, rnPatsAndThen, -- Here because it's not part
14 rnLit, rnOverLit, -- of any mutual recursion
16 -- Precence related stuff
17 mkOpAppRn, mkNegAppRn, mkOpFormRn,
18 checkPrecMatch, checkSectionPrec,
21 dupFieldErr, patSigErr, checkTupSize
24 import DynFlags ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
27 import RdrHsSyn ( extractHsRhoRdrTyVars )
28 import RnHsSyn ( extractHsTyNames, parrTyCon_name, tupleTyCon_name,
31 import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
32 lookupLocatedOccRn, lookupLocatedBndrRn,
33 lookupLocatedGlobalOccRn, bindTyVarsRn,
34 lookupFixityRn, lookupTyFixityRn,
35 mapFvRn, warnUnusedMatches,
36 newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV )
38 import RdrName ( RdrName, elemLocalRdrEnv )
39 import PrelNames ( eqClassName, integralClassName, geName, eqName,
40 negateName, minusName, lengthPName, indexPName,
41 plusIntegerName, fromIntegerName, timesIntegerName,
42 ratioDataConName, fromRationalName )
43 import TypeRep ( funTyCon )
44 import Constants ( mAX_TUPLE_SIZE )
46 import SrcLoc ( SrcSpan, Located(..), unLoc, noLoc, combineLocs )
49 import Literal ( inIntRange, inCharRange )
50 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
51 Fixity(..), FixityDirection(..) )
52 import ListSetOps ( removeDups )
55 #include "HsVersions.h"
58 These type renamers are in a separate module, rather than in (say) RnSource,
59 to break several loop.
61 %*********************************************************
63 \subsection{Renaming types}
65 %*********************************************************
68 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
69 rnHsTypeFVs doc_str ty
70 = rnLHsType doc_str ty `thenM` \ ty' ->
71 returnM (ty', extractHsTyNames ty')
73 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
74 -- rnHsSigType is used for source-language type signatures,
75 -- which use *implicit* universal quantification.
76 rnHsSigType doc_str ty
77 = rnLHsType (text "In the type signature for" <+> doc_str) ty
80 rnHsType is here because we call it from loadInstDecl, and I didn't
81 want a gratuitous knot.
84 rnLHsType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
85 rnLHsType doc = wrapLocM (rnHsType doc)
87 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
89 rnHsType doc (HsForAllTy Implicit _ ctxt ty)
90 -- Implicit quantifiction in source code (no kinds on tyvars)
91 -- Given the signature C => T we universally quantify
92 -- over FV(T) \ {in-scope-tyvars}
93 = getLocalRdrEnv `thenM` \ name_env ->
95 mentioned = extractHsRhoRdrTyVars ctxt ty
97 -- Don't quantify over type variables that are in scope;
98 -- when GlasgowExts is off, there usually won't be any, except for
100 -- class C a where { op :: a -> a }
101 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
102 tyvar_bndrs = userHsTyVarBndrs forall_tyvars
104 rnForAll doc Implicit tyvar_bndrs ctxt ty
106 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
107 -- Explicit quantification.
108 -- Check that the forall'd tyvars are actually
109 -- mentioned in the type, and produce a warning if not
111 mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
112 forall_tyvar_names = hsLTyVarLocNames forall_tyvars
114 -- Explicitly quantified but not mentioned in ctxt or tau
115 warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
117 mappM_ (forAllWarn doc tau) warn_guys `thenM_`
118 rnForAll doc Explicit forall_tyvars ctxt tau
120 rnHsType doc (HsTyVar tyvar)
121 = lookupOccRn tyvar `thenM` \ tyvar' ->
122 returnM (HsTyVar tyvar')
124 rnHsType doc (HsOpTy ty1 (L loc op) ty2)
126 lookupOccRn op `thenM` \ op' ->
130 lookupTyFixityRn l_op' `thenM` \ fix ->
131 rnLHsType doc ty1 `thenM` \ ty1' ->
132 rnLHsType doc ty2 `thenM` \ ty2' ->
133 mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2'
136 rnHsType doc (HsParTy ty)
137 = rnLHsType doc ty `thenM` \ ty' ->
138 returnM (HsParTy ty')
140 rnHsType doc (HsBangTy b ty)
141 = rnLHsType doc ty `thenM` \ ty' ->
142 returnM (HsBangTy b ty')
144 rnHsType doc (HsNumTy i)
145 | i == 1 = returnM (HsNumTy i)
146 | otherwise = addErr err_msg `thenM_` returnM (HsNumTy i)
148 err_msg = ptext SLIT("Only unit numeric type pattern is valid")
151 rnHsType doc (HsFunTy ty1 ty2)
152 = rnLHsType doc ty1 `thenM` \ ty1' ->
153 -- Might find a for-all as the arg of a function type
154 rnLHsType doc ty2 `thenM` \ ty2' ->
155 -- Or as the result. This happens when reading Prelude.hi
156 -- when we find return :: forall m. Monad m -> forall a. a -> m a
158 -- Check for fixity rearrangements
159 mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2'
161 rnHsType doc (HsListTy ty)
162 = rnLHsType doc ty `thenM` \ ty' ->
163 returnM (HsListTy ty')
165 rnHsType doc (HsKindSig ty k)
166 = rnLHsType doc ty `thenM` \ ty' ->
167 returnM (HsKindSig ty' k)
169 rnHsType doc (HsPArrTy ty)
170 = rnLHsType doc ty `thenM` \ ty' ->
171 returnM (HsPArrTy ty')
173 -- Unboxed tuples are allowed to have poly-typed arguments. These
174 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
175 rnHsType doc (HsTupleTy tup_con tys)
176 = mappM (rnLHsType doc) tys `thenM` \ tys' ->
177 returnM (HsTupleTy tup_con tys')
179 rnHsType doc (HsAppTy ty1 ty2)
180 = rnLHsType doc ty1 `thenM` \ ty1' ->
181 rnLHsType doc ty2 `thenM` \ ty2' ->
182 returnM (HsAppTy ty1' ty2')
184 rnHsType doc (HsPredTy pred)
185 = rnPred doc pred `thenM` \ pred' ->
186 returnM (HsPredTy pred')
188 rnHsType doc (HsSpliceTy _)
189 = do { addErr (ptext SLIT("Type splices are not yet implemented"))
192 rnLHsTypes doc tys = mappM (rnLHsType doc) tys
197 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
198 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
200 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
201 -- One reason for this case is that a type like Int#
202 -- starts off as (HsForAllTy Nothing [] Int), in case
203 -- there is some quantification. Now that we have quantified
204 -- and discovered there are no type variables, it's nicer to turn
205 -- it into plain Int. If it were Int# instead of Int, we'd actually
206 -- get an error, because the body of a genuine for-all is
209 rnForAll doc exp forall_tyvars ctxt ty
210 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
211 rnContext doc ctxt `thenM` \ new_ctxt ->
212 rnLHsType doc ty `thenM` \ new_ty ->
213 returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
214 -- Retain the same implicit/explicit flag as before
215 -- so that we can later print it correctly
219 %************************************************************************
221 Fixities and precedence parsing
223 %************************************************************************
225 @mkOpAppRn@ deals with operator fixities. The argument expressions
226 are assumed to be already correctly arranged. It needs the fixities
227 recorded in the OpApp nodes, because fixity info applies to the things
228 the programmer actually wrote, so you can't find it out from the Name.
230 Furthermore, the second argument is guaranteed not to be another
231 operator application. Why? Because the parser parses all
232 operator appications left-associatively, EXCEPT negation, which
233 we need to handle specially.
234 Infix types are read in a *right-associative* way, so that
239 mkHsOpTyRn rearranges where necessary. The two arguments
240 have already been renamed and rearranged. It's made rather tiresome
241 by the presence of ->, which is a separate syntactic construct.
245 -- Building (ty1 `op1` (ty21 `op2` ty22))
246 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
247 -> SDoc -> Fixity -> LHsType Name -> LHsType Name
250 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
251 = do { fix2 <- lookupTyFixityRn op2
252 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
253 (\t1 t2 -> HsOpTy t1 op2 t2)
254 (ppr op2) fix2 ty21 ty22 loc2 }
256 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
257 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
258 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
260 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 -- Default case, no rearrangment
261 = return (mk1 ty1 ty2)
264 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
265 -> SDoc -> Fixity -> LHsType Name
266 -> (LHsType Name -> LHsType Name -> HsType Name)
267 -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
269 mk_hs_op_ty mk1 pp_op1 fix1 ty1
270 mk2 pp_op2 fix2 ty21 ty22 loc2
271 | nofix_error = do { addErr (precParseErr (quotes pp_op1,fix1)
272 (quotes pp_op2,fix2))
273 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
274 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
275 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
276 new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
277 ; return (mk2 (noLoc new_ty) ty22) }
279 (nofix_error, associate_right) = compareFixity fix1 fix2
282 ---------------------------
283 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
284 -> LHsExpr Name -> Fixity -- Operator and fixity
285 -> LHsExpr Name -- Right operand (not an OpApp, but might
289 -- (e11 `op1` e12) `op2` e2
290 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
292 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
293 returnM (OpApp e1 op2 fix2 e2)
296 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
297 returnM (OpApp e11 op1 fix1 (L loc' new_e))
299 loc'= combineLocs e12 e2
300 (nofix_error, associate_right) = compareFixity fix1 fix2
302 ---------------------------
303 -- (- neg_arg) `op` e2
304 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
306 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
307 returnM (OpApp e1 op2 fix2 e2)
310 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
311 returnM (NegApp (L loc' new_e) neg_name)
313 loc' = combineLocs neg_arg e2
314 (nofix_error, associate_right) = compareFixity negateFixity fix2
316 ---------------------------
318 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right
319 | not associate_right -- We *want* right association
320 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
321 returnM (OpApp e1 op1 fix1 e2)
323 (_, associate_right) = compareFixity fix1 negateFixity
325 ---------------------------
327 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
328 = ASSERT2( right_op_ok fix (unLoc e2),
329 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
331 returnM (OpApp e1 op fix e2)
333 -- Parser left-associates everything, but
334 -- derived instances may have correctly-associated things to
335 -- in the right operarand. So we just check that the right operand is OK
336 right_op_ok fix1 (OpApp _ _ fix2 _)
337 = not error_please && associate_right
339 (error_please, associate_right) = compareFixity fix1 fix2
340 right_op_ok fix1 other
343 -- Parser initially makes negation bind more tightly than any other operator
344 -- And "deriving" code should respect this (use HsPar if not)
345 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
346 mkNegAppRn neg_arg neg_name
347 = ASSERT( not_op_app (unLoc neg_arg) )
348 returnM (NegApp neg_arg neg_name)
350 not_op_app (OpApp _ _ _ _) = False
351 not_op_app other = True
353 ---------------------------
354 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
355 -> LHsExpr Name -> Fixity -- Operator and fixity
356 -> LHsCmdTop Name -- Right operand (not an infix)
359 -- (e11 `op1` e12) `op2` e2
360 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
363 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
364 returnM (HsArrForm op2 (Just fix2) [a1, a2])
367 = mkOpFormRn a12 op2 fix2 a2 `thenM` \ new_c ->
368 returnM (HsArrForm op1 (Just fix1)
369 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
370 -- TODO: locs are wrong
372 (nofix_error, associate_right) = compareFixity fix1 fix2
375 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
376 = returnM (HsArrForm op (Just fix) [arg1, arg2])
379 --------------------------------------
380 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
383 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
384 = lookupFixityRn (unLoc op1) `thenM` \ fix1 ->
386 (nofix_error, associate_right) = compareFixity fix1 fix2
389 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
390 returnM (ConPatIn op2 (InfixCon p1 p2))
392 if associate_right then
393 mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p ->
394 returnM (ConPatIn op1 (InfixCon p11 (L loc new_p))) -- XXX loc right?
396 returnM (ConPatIn op2 (InfixCon p1 p2))
398 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
399 = ASSERT( not_op_pat (unLoc p2) )
400 returnM (ConPatIn op (InfixCon p1 p2))
402 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
403 not_op_pat other = True
405 --------------------------------------
406 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
407 -- True indicates an infix lhs
408 -- See comments with rnExpr (OpApp ...) about "deriving"
410 checkPrecMatch False fn match
412 checkPrecMatch True op (MatchGroup ms _)
415 check (L _ (Match (p1:p2:_) _ _))
416 = checkPrec op (unLoc p1) False `thenM_`
417 checkPrec op (unLoc p2) True
420 -- This can happen. Consider
423 -- The infix flag comes from the first binding of the group
424 -- but the second eqn has no args (an error, but not discovered
425 -- until the type checker). So we don't want to crash on the
428 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
429 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
430 lookupFixityRn (unLoc op1) `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
432 inf_ok = op1_prec > op_prec ||
433 (op1_prec == op_prec &&
434 (op1_dir == InfixR && op_dir == InfixR && right ||
435 op1_dir == InfixL && op_dir == InfixL && not right))
437 info = (ppr_op op, op_fix)
438 info1 = (ppr_op op1, op1_fix)
439 (infol, infor) = if right then (info, info1) else (info1, info)
441 checkErr inf_ok (precParseErr infol infor)
443 checkPrec op pat right
446 -- Check precedence of (arg op) or (op arg) respectively
447 -- If arg is itself an operator application, then either
448 -- (a) its precedence must be higher than that of op
449 -- (b) its precedency & associativity must be the same as that of op
450 checkSectionPrec :: FixityDirection -> HsExpr RdrName
451 -> LHsExpr Name -> LHsExpr Name -> RnM ()
452 checkSectionPrec direction section op arg
454 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
455 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
458 L _ (HsVar op_name) = op
459 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
460 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
461 checkErr (op_prec < arg_prec
462 || op_prec == arg_prec && direction == assoc)
463 (sectionPrecErr (ppr_op op_name, op_fix)
464 (pp_arg_op, arg_fix) section)
467 Precedence-related error messages
471 = hang (ptext SLIT("precedence parsing error"))
472 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
474 ptext SLIT("in the same infix expression")])
476 sectionPrecErr op arg_op section
477 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
478 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
479 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
481 pp_prefix_minus = ptext SLIT("prefix `-'")
482 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
483 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
486 %*********************************************************
488 \subsection{Contexts and predicates}
490 %*********************************************************
493 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
494 rnContext doc = wrapLocM (rnContext' doc)
496 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
497 rnContext' doc ctxt = mappM (rnLPred doc) ctxt
499 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
500 rnLPred doc = wrapLocM (rnPred doc)
502 rnPred doc (HsClassP clas tys)
503 = lookupOccRn clas `thenM` \ clas_name ->
504 rnLHsTypes doc tys `thenM` \ tys' ->
505 returnM (HsClassP clas_name tys')
507 rnPred doc (HsIParam n ty)
508 = newIPNameRn n `thenM` \ name ->
509 rnLHsType doc ty `thenM` \ ty' ->
510 returnM (HsIParam name ty')
514 *********************************************************
516 \subsection{Patterns}
518 *********************************************************
521 rnPatsAndThen :: HsMatchContext Name
523 -> ([LPat Name] -> RnM (a, FreeVars))
525 -- Bring into scope all the binders and type variables
526 -- bound by the patterns; then rename the patterns; then
527 -- do the thing inside.
529 -- Note that we do a single bindLocalsRn for all the
530 -- matches together, so that we spot the repeated variable in
533 rnPatsAndThen ctxt pats thing_inside
534 = bindPatSigTyVarsFV pat_sig_tys $
535 bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs ->
536 rnLPats pats `thenM` \ (pats', pat_fvs) ->
537 thing_inside pats' `thenM` \ (res, res_fvs) ->
540 unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
542 warnUnusedMatches unused_binders `thenM_`
543 returnM (res, res_fvs `plusFV` pat_fvs)
545 pat_sig_tys = collectSigTysFromPats pats
546 bndrs = collectLocatedPatsBinders pats
547 doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
549 rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
550 rnLPats ps = mapFvRn rnLPat ps
552 rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
553 rnLPat = wrapLocFstM rnPat
555 -- -----------------------------------------------------------------------------
558 rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
560 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
563 = lookupBndrRn name `thenM` \ vname ->
564 returnM (VarPat vname, emptyFVs)
566 rnPat (SigPatIn pat ty)
567 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
570 then rnLPat pat `thenM` \ (pat', fvs1) ->
571 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
572 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
574 else addErr (patSigErr ty) `thenM_`
575 rnPat (unLoc pat) -- XXX shouldn't throw away the loc
577 doc = text "In a pattern type-signature"
581 returnM (LitPat lit, emptyFVs)
583 rnPat (NPat lit mb_neg eq _)
584 = rnOverLit lit `thenM` \ (lit', fvs1) ->
586 Nothing -> returnM (Nothing, emptyFVs)
587 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
588 returnM (Just neg, fvs)
589 ) `thenM` \ (mb_neg', fvs2) ->
590 lookupSyntaxName eqName `thenM` \ (eq', fvs3) ->
591 returnM (NPat lit' mb_neg' eq' placeHolderType,
592 fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` eqClassName)
593 -- Needed to find equality on pattern
595 rnPat (NPlusKPat name lit _ _)
596 = rnOverLit lit `thenM` \ (lit', fvs1) ->
597 lookupLocatedBndrRn name `thenM` \ name' ->
598 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
599 lookupSyntaxName geName `thenM` \ (ge, fvs3) ->
600 returnM (NPlusKPat name' lit' ge minus,
601 fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` integralClassName)
602 -- The Report says that n+k patterns must be in Integral
605 = rnLPat pat `thenM` \ (pat', fvs) ->
606 returnM (LazyPat pat', fvs)
609 = rnLPat pat `thenM` \ (pat', fvs) ->
610 returnM (BangPat pat', fvs)
612 rnPat (AsPat name pat)
613 = rnLPat pat `thenM` \ (pat', fvs) ->
614 lookupLocatedBndrRn name `thenM` \ vname ->
615 returnM (AsPat vname pat', fvs)
617 rnPat (ConPatIn con stuff) = rnConPat con stuff
621 = rnLPat pat `thenM` \ (pat', fvs) ->
622 returnM (ParPat pat', fvs)
624 rnPat (ListPat pats _)
625 = rnLPats pats `thenM` \ (patslist, fvs) ->
626 returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
628 rnPat (PArrPat pats _)
629 = rnLPats pats `thenM` \ (patslist, fvs) ->
630 returnM (PArrPat patslist placeHolderType,
631 fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
633 implicit_fvs = mkFVs [lengthPName, indexPName]
635 rnPat (TuplePat pats boxed _)
636 = checkTupSize tup_size `thenM_`
637 rnLPats pats `thenM` \ (patslist, fvs) ->
638 returnM (TuplePat patslist boxed placeHolderType,
639 fvs `addOneFV` tycon_name)
641 tup_size = length pats
642 tycon_name = tupleTyCon_name boxed tup_size
644 rnPat (TypePat name) =
645 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
646 returnM (TypePat name', fvs)
648 -- -----------------------------------------------------------------------------
651 rnConPat con (PrefixCon pats)
652 = lookupLocatedOccRn con `thenM` \ con' ->
653 rnLPats pats `thenM` \ (pats', fvs) ->
654 returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con')
656 rnConPat con (RecCon rpats)
657 = lookupLocatedOccRn con `thenM` \ con' ->
658 rnRpats rpats `thenM` \ (rpats', fvs) ->
659 returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con')
661 rnConPat con (InfixCon pat1 pat2)
662 = lookupLocatedOccRn con `thenM` \ con' ->
663 rnLPat pat1 `thenM` \ (pat1', fvs1) ->
664 rnLPat pat2 `thenM` \ (pat2', fvs2) ->
665 lookupFixityRn (unLoc con') `thenM` \ fixity ->
666 mkConOpPatRn con' fixity pat1' pat2' `thenM` \ pat' ->
667 returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con')
669 -- -----------------------------------------------------------------------------
672 rnRpats :: [(Located RdrName, LPat RdrName)]
673 -> RnM ([(Located Name, LPat Name)], FreeVars)
675 = mappM_ field_dup_err dup_fields `thenM_`
676 mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
677 returnM (rpats', fvs)
679 (_, dup_fields) = removeDups compare [ unLoc f | (f,_) <- rpats ]
681 field_dup_err dups = addErr (dupFieldErr "pattern" dups)
684 = lookupLocatedGlobalOccRn field `thenM` \ fieldname ->
685 rnLPat pat `thenM` \ (pat', fvs) ->
686 returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname)
691 %************************************************************************
693 \subsubsection{Literals}
695 %************************************************************************
697 When literals occur we have to make sure
698 that the types and classes they involve
702 rnLit :: HsLit -> RnM ()
703 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
704 rnLit other = returnM ()
706 rnOverLit (HsIntegral i _)
707 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
709 returnM (HsIntegral i from_integer_name, fvs)
711 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
712 -- Big integer literals are built, using + and *,
713 -- out of small integers (DsUtils.mkIntegerLit)
714 -- [NB: plusInteger, timesInteger aren't rebindable...
715 -- they are used to construct the argument to fromInteger,
716 -- which is the rebindable one.]
718 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
720 rnOverLit (HsFractional i _)
721 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
723 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
724 -- We have to make sure that the Ratio type is imported with
725 -- its constructor, because literals of type Ratio t are
726 -- built with that constructor.
727 -- The Rational type is needed too, but that will come in
728 -- as part of the type for fromRational.
729 -- The plus/times integer operations may be needed to construct the numerator
730 -- and denominator (see DsUtils.mkIntegerLit)
732 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
737 %*********************************************************
741 %*********************************************************
744 checkTupSize :: Int -> RnM ()
745 checkTupSize tup_size
746 | tup_size <= mAX_TUPLE_SIZE
749 = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
750 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
751 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
753 forAllWarn doc ty (L loc tyvar)
754 = ifOptM Opt_WarnUnusedMatches $
755 addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
756 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
761 = ptext SLIT("character literal out of range: '\\") <> char c <> char '\''
764 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
765 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
768 = hsep [ptext SLIT("duplicate field name"),
770 ptext SLIT("in record"), text str]