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, Opt_ScopedTypeVariables ) )
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 ty@(HsOpTy ty1 (L loc op) ty2)
126 do { ty_ops_ok <- doptM Opt_ScopedTypeVariables -- Badly named option
127 ; checkErr ty_ops_ok (opTyErr op ty)
128 ; op' <- lookupOccRn op
129 ; let l_op' = L loc op'
130 ; fix <- lookupTyFixityRn l_op'
131 ; ty1' <- rnLHsType doc ty1
132 ; ty2' <- rnLHsType doc ty2
133 ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2' }
135 rnHsType doc (HsParTy ty)
136 = rnLHsType doc ty `thenM` \ ty' ->
137 returnM (HsParTy ty')
139 rnHsType doc (HsBangTy b ty)
140 = rnLHsType doc ty `thenM` \ ty' ->
141 returnM (HsBangTy b ty')
143 rnHsType doc (HsNumTy i)
144 | i == 1 = returnM (HsNumTy i)
145 | otherwise = addErr err_msg `thenM_` returnM (HsNumTy i)
147 err_msg = ptext SLIT("Only unit numeric type pattern is valid")
150 rnHsType doc (HsFunTy ty1 ty2)
151 = rnLHsType doc ty1 `thenM` \ ty1' ->
152 -- Might find a for-all as the arg of a function type
153 rnLHsType doc ty2 `thenM` \ ty2' ->
154 -- Or as the result. This happens when reading Prelude.hi
155 -- when we find return :: forall m. Monad m -> forall a. a -> m a
157 -- Check for fixity rearrangements
158 mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2'
160 rnHsType doc (HsListTy ty)
161 = rnLHsType doc ty `thenM` \ ty' ->
162 returnM (HsListTy ty')
164 rnHsType doc (HsKindSig ty k)
165 = rnLHsType doc ty `thenM` \ ty' ->
166 returnM (HsKindSig ty' k)
168 rnHsType doc (HsPArrTy ty)
169 = rnLHsType doc ty `thenM` \ ty' ->
170 returnM (HsPArrTy ty')
172 -- Unboxed tuples are allowed to have poly-typed arguments. These
173 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
174 rnHsType doc (HsTupleTy tup_con tys)
175 = mappM (rnLHsType doc) tys `thenM` \ tys' ->
176 returnM (HsTupleTy tup_con tys')
178 rnHsType doc (HsAppTy ty1 ty2)
179 = rnLHsType doc ty1 `thenM` \ ty1' ->
180 rnLHsType doc ty2 `thenM` \ ty2' ->
181 returnM (HsAppTy ty1' ty2')
183 rnHsType doc (HsPredTy pred)
184 = rnPred doc pred `thenM` \ pred' ->
185 returnM (HsPredTy pred')
187 rnHsType doc (HsSpliceTy _)
188 = do { addErr (ptext SLIT("Type splices are not yet implemented"))
191 rnLHsTypes doc tys = mappM (rnLHsType doc) tys
196 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
197 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
199 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
200 -- One reason for this case is that a type like Int#
201 -- starts off as (HsForAllTy Nothing [] Int), in case
202 -- there is some quantification. Now that we have quantified
203 -- and discovered there are no type variables, it's nicer to turn
204 -- it into plain Int. If it were Int# instead of Int, we'd actually
205 -- get an error, because the body of a genuine for-all is
208 rnForAll doc exp forall_tyvars ctxt ty
209 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
210 rnContext doc ctxt `thenM` \ new_ctxt ->
211 rnLHsType doc ty `thenM` \ new_ty ->
212 returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
213 -- Retain the same implicit/explicit flag as before
214 -- so that we can later print it correctly
218 %************************************************************************
220 Fixities and precedence parsing
222 %************************************************************************
224 @mkOpAppRn@ deals with operator fixities. The argument expressions
225 are assumed to be already correctly arranged. It needs the fixities
226 recorded in the OpApp nodes, because fixity info applies to the things
227 the programmer actually wrote, so you can't find it out from the Name.
229 Furthermore, the second argument is guaranteed not to be another
230 operator application. Why? Because the parser parses all
231 operator appications left-associatively, EXCEPT negation, which
232 we need to handle specially.
233 Infix types are read in a *right-associative* way, so that
238 mkHsOpTyRn rearranges where necessary. The two arguments
239 have already been renamed and rearranged. It's made rather tiresome
240 by the presence of ->, which is a separate syntactic construct.
244 -- Building (ty1 `op1` (ty21 `op2` ty22))
245 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
246 -> SDoc -> Fixity -> LHsType Name -> LHsType Name
249 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
250 = do { fix2 <- lookupTyFixityRn op2
251 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
252 (\t1 t2 -> HsOpTy t1 op2 t2)
253 (ppr op2) fix2 ty21 ty22 loc2 }
255 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
256 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
257 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
259 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 -- Default case, no rearrangment
260 = return (mk1 ty1 ty2)
263 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
264 -> SDoc -> Fixity -> LHsType Name
265 -> (LHsType Name -> LHsType Name -> HsType Name)
266 -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
268 mk_hs_op_ty mk1 pp_op1 fix1 ty1
269 mk2 pp_op2 fix2 ty21 ty22 loc2
270 | nofix_error = do { addErr (precParseErr (quotes pp_op1,fix1)
271 (quotes pp_op2,fix2))
272 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
273 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
274 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
275 new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
276 ; return (mk2 (noLoc new_ty) ty22) }
278 (nofix_error, associate_right) = compareFixity fix1 fix2
281 ---------------------------
282 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
283 -> LHsExpr Name -> Fixity -- Operator and fixity
284 -> LHsExpr Name -- Right operand (not an OpApp, but might
288 -- (e11 `op1` e12) `op2` e2
289 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
291 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
292 returnM (OpApp e1 op2 fix2 e2)
295 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
296 returnM (OpApp e11 op1 fix1 (L loc' new_e))
298 loc'= combineLocs e12 e2
299 (nofix_error, associate_right) = compareFixity fix1 fix2
301 ---------------------------
302 -- (- neg_arg) `op` e2
303 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
305 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
306 returnM (OpApp e1 op2 fix2 e2)
309 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
310 returnM (NegApp (L loc' new_e) neg_name)
312 loc' = combineLocs neg_arg e2
313 (nofix_error, associate_right) = compareFixity negateFixity fix2
315 ---------------------------
317 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right
318 | not associate_right -- We *want* right association
319 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
320 returnM (OpApp e1 op1 fix1 e2)
322 (_, associate_right) = compareFixity fix1 negateFixity
324 ---------------------------
326 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
327 = ASSERT2( right_op_ok fix (unLoc e2),
328 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
330 returnM (OpApp e1 op fix e2)
332 -- Parser left-associates everything, but
333 -- derived instances may have correctly-associated things to
334 -- in the right operarand. So we just check that the right operand is OK
335 right_op_ok fix1 (OpApp _ _ fix2 _)
336 = not error_please && associate_right
338 (error_please, associate_right) = compareFixity fix1 fix2
339 right_op_ok fix1 other
342 -- Parser initially makes negation bind more tightly than any other operator
343 -- And "deriving" code should respect this (use HsPar if not)
344 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
345 mkNegAppRn neg_arg neg_name
346 = ASSERT( not_op_app (unLoc neg_arg) )
347 returnM (NegApp neg_arg neg_name)
349 not_op_app (OpApp _ _ _ _) = False
350 not_op_app other = True
352 ---------------------------
353 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
354 -> LHsExpr Name -> Fixity -- Operator and fixity
355 -> LHsCmdTop Name -- Right operand (not an infix)
358 -- (e11 `op1` e12) `op2` e2
359 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
362 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
363 returnM (HsArrForm op2 (Just fix2) [a1, a2])
366 = mkOpFormRn a12 op2 fix2 a2 `thenM` \ new_c ->
367 returnM (HsArrForm op1 (Just fix1)
368 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
369 -- TODO: locs are wrong
371 (nofix_error, associate_right) = compareFixity fix1 fix2
374 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
375 = returnM (HsArrForm op (Just fix) [arg1, arg2])
378 --------------------------------------
379 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
382 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
383 = lookupFixityRn (unLoc op1) `thenM` \ fix1 ->
385 (nofix_error, associate_right) = compareFixity fix1 fix2
388 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
389 returnM (ConPatIn op2 (InfixCon p1 p2))
391 if associate_right then
392 mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p ->
393 returnM (ConPatIn op1 (InfixCon p11 (L loc new_p))) -- XXX loc right?
395 returnM (ConPatIn op2 (InfixCon p1 p2))
397 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
398 = ASSERT( not_op_pat (unLoc p2) )
399 returnM (ConPatIn op (InfixCon p1 p2))
401 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
402 not_op_pat other = True
404 --------------------------------------
405 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
406 -- True indicates an infix lhs
407 -- See comments with rnExpr (OpApp ...) about "deriving"
409 checkPrecMatch False fn match
411 checkPrecMatch True op (MatchGroup ms _)
414 check (L _ (Match (p1:p2:_) _ _))
415 = checkPrec op (unLoc p1) False `thenM_`
416 checkPrec op (unLoc p2) True
419 -- This can happen. Consider
422 -- The infix flag comes from the first binding of the group
423 -- but the second eqn has no args (an error, but not discovered
424 -- until the type checker). So we don't want to crash on the
427 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
428 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
429 lookupFixityRn (unLoc op1) `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
431 inf_ok = op1_prec > op_prec ||
432 (op1_prec == op_prec &&
433 (op1_dir == InfixR && op_dir == InfixR && right ||
434 op1_dir == InfixL && op_dir == InfixL && not right))
436 info = (ppr_op op, op_fix)
437 info1 = (ppr_op op1, op1_fix)
438 (infol, infor) = if right then (info, info1) else (info1, info)
440 checkErr inf_ok (precParseErr infol infor)
442 checkPrec op pat right
445 -- Check precedence of (arg op) or (op arg) respectively
446 -- If arg is itself an operator application, then either
447 -- (a) its precedence must be higher than that of op
448 -- (b) its precedency & associativity must be the same as that of op
449 checkSectionPrec :: FixityDirection -> HsExpr RdrName
450 -> LHsExpr Name -> LHsExpr Name -> RnM ()
451 checkSectionPrec direction section op arg
453 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
454 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
457 L _ (HsVar op_name) = op
458 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
459 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
460 checkErr (op_prec < arg_prec
461 || op_prec == arg_prec && direction == assoc)
462 (sectionPrecErr (ppr_op op_name, op_fix)
463 (pp_arg_op, arg_fix) section)
466 Precedence-related error messages
470 = hang (ptext SLIT("precedence parsing error"))
471 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
473 ptext SLIT("in the same infix expression")])
475 sectionPrecErr op arg_op section
476 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
477 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
478 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
480 pp_prefix_minus = ptext SLIT("prefix `-'")
481 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
482 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
485 %*********************************************************
487 \subsection{Contexts and predicates}
489 %*********************************************************
492 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
493 rnContext doc = wrapLocM (rnContext' doc)
495 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
496 rnContext' doc ctxt = mappM (rnLPred doc) ctxt
498 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
499 rnLPred doc = wrapLocM (rnPred doc)
501 rnPred doc (HsClassP clas tys)
502 = lookupOccRn clas `thenM` \ clas_name ->
503 rnLHsTypes doc tys `thenM` \ tys' ->
504 returnM (HsClassP clas_name tys')
506 rnPred doc (HsIParam n ty)
507 = newIPNameRn n `thenM` \ name ->
508 rnLHsType doc ty `thenM` \ ty' ->
509 returnM (HsIParam name ty')
513 *********************************************************
515 \subsection{Patterns}
517 *********************************************************
520 rnPatsAndThen :: HsMatchContext Name
522 -> ([LPat Name] -> RnM (a, FreeVars))
524 -- Bring into scope all the binders and type variables
525 -- bound by the patterns; then rename the patterns; then
526 -- do the thing inside.
528 -- Note that we do a single bindLocalsRn for all the
529 -- matches together, so that we spot the repeated variable in
532 rnPatsAndThen ctxt pats thing_inside
533 = bindPatSigTyVarsFV pat_sig_tys $
534 bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs ->
535 rnLPats pats `thenM` \ (pats', pat_fvs) ->
536 thing_inside pats' `thenM` \ (res, res_fvs) ->
539 unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
541 warnUnusedMatches unused_binders `thenM_`
542 returnM (res, res_fvs `plusFV` pat_fvs)
544 pat_sig_tys = collectSigTysFromPats pats
545 bndrs = collectLocatedPatsBinders pats
546 doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
548 rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
549 rnLPats ps = mapFvRn rnLPat ps
551 rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
552 rnLPat = wrapLocFstM rnPat
554 -- -----------------------------------------------------------------------------
557 rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
559 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
562 = lookupBndrRn name `thenM` \ vname ->
563 returnM (VarPat vname, emptyFVs)
565 rnPat (SigPatIn pat ty)
566 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
569 then rnLPat pat `thenM` \ (pat', fvs1) ->
570 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
571 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
573 else addErr (patSigErr ty) `thenM_`
574 rnPat (unLoc pat) -- XXX shouldn't throw away the loc
576 doc = text "In a pattern type-signature"
580 returnM (LitPat lit, emptyFVs)
582 rnPat (NPat lit mb_neg eq _)
583 = rnOverLit lit `thenM` \ (lit', fvs1) ->
585 Nothing -> returnM (Nothing, emptyFVs)
586 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
587 returnM (Just neg, fvs)
588 ) `thenM` \ (mb_neg', fvs2) ->
589 lookupSyntaxName eqName `thenM` \ (eq', fvs3) ->
590 returnM (NPat lit' mb_neg' eq' placeHolderType,
591 fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` eqClassName)
592 -- Needed to find equality on pattern
594 rnPat (NPlusKPat name lit _ _)
595 = rnOverLit lit `thenM` \ (lit', fvs1) ->
596 lookupLocatedBndrRn name `thenM` \ name' ->
597 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
598 lookupSyntaxName geName `thenM` \ (ge, fvs3) ->
599 returnM (NPlusKPat name' lit' ge minus,
600 fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` integralClassName)
601 -- The Report says that n+k patterns must be in Integral
604 = rnLPat pat `thenM` \ (pat', fvs) ->
605 returnM (LazyPat pat', fvs)
608 = rnLPat pat `thenM` \ (pat', fvs) ->
609 returnM (BangPat pat', fvs)
611 rnPat (AsPat name pat)
612 = rnLPat pat `thenM` \ (pat', fvs) ->
613 lookupLocatedBndrRn name `thenM` \ vname ->
614 returnM (AsPat vname pat', fvs)
616 rnPat (ConPatIn con stuff) = rnConPat con stuff
620 = rnLPat pat `thenM` \ (pat', fvs) ->
621 returnM (ParPat pat', fvs)
623 rnPat (ListPat pats _)
624 = rnLPats pats `thenM` \ (patslist, fvs) ->
625 returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
627 rnPat (PArrPat pats _)
628 = rnLPats pats `thenM` \ (patslist, fvs) ->
629 returnM (PArrPat patslist placeHolderType,
630 fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
632 implicit_fvs = mkFVs [lengthPName, indexPName]
634 rnPat (TuplePat pats boxed _)
635 = checkTupSize tup_size `thenM_`
636 rnLPats pats `thenM` \ (patslist, fvs) ->
637 returnM (TuplePat patslist boxed placeHolderType,
638 fvs `addOneFV` tycon_name)
640 tup_size = length pats
641 tycon_name = tupleTyCon_name boxed tup_size
643 rnPat (TypePat name) =
644 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
645 returnM (TypePat name', fvs)
647 -- -----------------------------------------------------------------------------
650 rnConPat con (PrefixCon pats)
651 = lookupLocatedOccRn con `thenM` \ con' ->
652 rnLPats pats `thenM` \ (pats', fvs) ->
653 returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con')
655 rnConPat con (RecCon rpats)
656 = lookupLocatedOccRn con `thenM` \ con' ->
657 rnRpats rpats `thenM` \ (rpats', fvs) ->
658 returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con')
660 rnConPat con (InfixCon pat1 pat2)
661 = lookupLocatedOccRn con `thenM` \ con' ->
662 rnLPat pat1 `thenM` \ (pat1', fvs1) ->
663 rnLPat pat2 `thenM` \ (pat2', fvs2) ->
664 lookupFixityRn (unLoc con') `thenM` \ fixity ->
665 mkConOpPatRn con' fixity pat1' pat2' `thenM` \ pat' ->
666 returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con')
668 -- -----------------------------------------------------------------------------
671 rnRpats :: [(Located RdrName, LPat RdrName)]
672 -> RnM ([(Located Name, LPat Name)], FreeVars)
674 = mappM_ field_dup_err dup_fields `thenM_`
675 mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
676 returnM (rpats', fvs)
678 (_, dup_fields) = removeDups compare [ unLoc f | (f,_) <- rpats ]
680 field_dup_err dups = addErr (dupFieldErr "pattern" dups)
683 = lookupLocatedGlobalOccRn field `thenM` \ fieldname ->
684 rnLPat pat `thenM` \ (pat', fvs) ->
685 returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname)
690 %************************************************************************
692 \subsubsection{Literals}
694 %************************************************************************
696 When literals occur we have to make sure
697 that the types and classes they involve
701 rnLit :: HsLit -> RnM ()
702 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
703 rnLit other = returnM ()
705 rnOverLit (HsIntegral i _)
706 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
708 returnM (HsIntegral i from_integer_name, fvs)
710 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
711 -- Big integer literals are built, using + and *,
712 -- out of small integers (DsUtils.mkIntegerLit)
713 -- [NB: plusInteger, timesInteger aren't rebindable...
714 -- they are used to construct the argument to fromInteger,
715 -- which is the rebindable one.]
717 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
719 rnOverLit (HsFractional i _)
720 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
722 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
723 -- We have to make sure that the Ratio type is imported with
724 -- its constructor, because literals of type Ratio t are
725 -- built with that constructor.
726 -- The Rational type is needed too, but that will come in
727 -- as part of the type for fromRational.
728 -- The plus/times integer operations may be needed to construct the numerator
729 -- and denominator (see DsUtils.mkIntegerLit)
731 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
736 %*********************************************************
740 %*********************************************************
743 checkTupSize :: Int -> RnM ()
744 checkTupSize tup_size
745 | tup_size <= mAX_TUPLE_SIZE
748 = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
749 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
750 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
752 forAllWarn doc ty (L loc tyvar)
753 = ifOptM Opt_WarnUnusedMatches $
754 addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
755 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
760 = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
761 2 (parens (ptext SLIT("Use -fscoped-type-variables to allow operators in types")))
764 = ptext SLIT("character literal out of range: '\\") <> char c <> char '\''
767 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
768 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
771 = hsep [ptext SLIT("duplicate field name"),
773 ptext SLIT("in record"), text str]