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, rnPatsAndThen, -- Here because it's not part
14 rnLit, rnOverLit, -- of any mutual recursion
17 -- Precence related stuff
18 mkOpAppRn, mkNegAppRn, mkOpFormRn,
19 checkPrecMatch, checkSectionPrec,
22 patSigErr, checkTupSize
27 import RdrHsSyn ( extractHsRhoRdrTyVars )
28 import RnHsSyn ( extractHsTyNames, parrTyCon_name, tupleTyCon_name,
31 import RnHsDoc ( rnLHsDoc )
32 import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
33 lookupLocatedOccRn, lookupLocatedBndrRn,
34 lookupLocatedGlobalOccRn, bindTyVarsRn,
35 lookupFixityRn, lookupTyFixityRn, lookupConstructorFields,
36 lookupRecordBndr, mapFvRn, warnUnusedMatches,
37 newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV )
40 import PrelNames ( eqClassName, integralClassName, geName, eqName,
41 negateName, minusName, lengthPName, indexPName,
42 plusIntegerName, fromIntegerName, timesIntegerName,
43 ratioDataConName, fromRationalName, fromStringName )
44 import TypeRep ( funTyCon )
45 import Constants ( mAX_TUPLE_SIZE )
50 import Literal ( inIntRange, inCharRange )
51 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
52 Fixity(..), FixityDirection(..) )
53 import ListSetOps ( removeDups, minusList )
56 #include "HsVersions.h"
59 These type renamers are in a separate module, rather than in (say) RnSource,
60 to break several loop.
62 %*********************************************************
64 \subsection{Renaming types}
66 %*********************************************************
69 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
70 rnHsTypeFVs doc_str ty
71 = rnLHsType doc_str ty `thenM` \ ty' ->
72 returnM (ty', extractHsTyNames ty')
74 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
75 -- rnHsSigType is used for source-language type signatures,
76 -- which use *implicit* universal quantification.
77 rnHsSigType doc_str ty
78 = rnLHsType (text "In the type signature for" <+> doc_str) ty
81 rnHsType is here because we call it from loadInstDecl, and I didn't
82 want a gratuitous knot.
85 rnLHsType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
86 rnLHsType doc = wrapLocM (rnHsType doc)
88 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
90 rnHsType doc (HsForAllTy Implicit _ ctxt ty)
91 -- Implicit quantifiction in source code (no kinds on tyvars)
92 -- Given the signature C => T we universally quantify
93 -- over FV(T) \ {in-scope-tyvars}
94 = getLocalRdrEnv `thenM` \ name_env ->
96 mentioned = extractHsRhoRdrTyVars ctxt ty
98 -- Don't quantify over type variables that are in scope;
99 -- when GlasgowExts is off, there usually won't be any, except for
101 -- class C a where { op :: a -> a }
102 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
103 tyvar_bndrs = userHsTyVarBndrs forall_tyvars
105 rnForAll doc Implicit tyvar_bndrs ctxt ty
107 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
108 -- Explicit quantification.
109 -- Check that the forall'd tyvars are actually
110 -- mentioned in the type, and produce a warning if not
112 mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
113 forall_tyvar_names = hsLTyVarLocNames forall_tyvars
115 -- Explicitly quantified but not mentioned in ctxt or tau
116 warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
118 mappM_ (forAllWarn doc tau) warn_guys `thenM_`
119 rnForAll doc Explicit forall_tyvars ctxt tau
121 rnHsType doc (HsTyVar tyvar)
122 = lookupOccRn tyvar `thenM` \ tyvar' ->
123 returnM (HsTyVar tyvar')
125 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
127 do { ty_ops_ok <- doptM Opt_TypeOperators
128 ; checkErr ty_ops_ok (opTyErr op ty)
129 ; op' <- lookupOccRn op
130 ; let l_op' = L loc op'
131 ; fix <- lookupTyFixityRn l_op'
132 ; ty1' <- rnLHsType doc ty1
133 ; ty2' <- rnLHsType doc ty2
134 ; 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 rnHsType doc (HsDocTy ty haddock_doc)
193 = rnLHsType doc ty `thenM` \ ty' ->
194 rnLHsDoc haddock_doc `thenM` \ haddock_doc' ->
195 returnM (HsDocTy ty' haddock_doc')
197 rnLHsTypes doc tys = mappM (rnLHsType doc) tys
202 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
203 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
205 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
206 -- One reason for this case is that a type like Int#
207 -- starts off as (HsForAllTy Nothing [] Int), in case
208 -- there is some quantification. Now that we have quantified
209 -- and discovered there are no type variables, it's nicer to turn
210 -- it into plain Int. If it were Int# instead of Int, we'd actually
211 -- get an error, because the body of a genuine for-all is
214 rnForAll doc exp forall_tyvars ctxt ty
215 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
216 rnContext doc ctxt `thenM` \ new_ctxt ->
217 rnLHsType doc ty `thenM` \ new_ty ->
218 returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
219 -- Retain the same implicit/explicit flag as before
220 -- so that we can later print it correctly
224 %************************************************************************
226 Fixities and precedence parsing
228 %************************************************************************
230 @mkOpAppRn@ deals with operator fixities. The argument expressions
231 are assumed to be already correctly arranged. It needs the fixities
232 recorded in the OpApp nodes, because fixity info applies to the things
233 the programmer actually wrote, so you can't find it out from the Name.
235 Furthermore, the second argument is guaranteed not to be another
236 operator application. Why? Because the parser parses all
237 operator appications left-associatively, EXCEPT negation, which
238 we need to handle specially.
239 Infix types are read in a *right-associative* way, so that
244 mkHsOpTyRn rearranges where necessary. The two arguments
245 have already been renamed and rearranged. It's made rather tiresome
246 by the presence of ->, which is a separate syntactic construct.
250 -- Building (ty1 `op1` (ty21 `op2` ty22))
251 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
252 -> SDoc -> Fixity -> LHsType Name -> LHsType Name
255 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
256 = do { fix2 <- lookupTyFixityRn op2
257 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
258 (\t1 t2 -> HsOpTy t1 op2 t2)
259 (ppr op2) fix2 ty21 ty22 loc2 }
261 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
262 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
263 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
265 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 -- Default case, no rearrangment
266 = return (mk1 ty1 ty2)
269 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
270 -> SDoc -> Fixity -> LHsType Name
271 -> (LHsType Name -> LHsType Name -> HsType Name)
272 -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
274 mk_hs_op_ty mk1 pp_op1 fix1 ty1
275 mk2 pp_op2 fix2 ty21 ty22 loc2
276 | nofix_error = do { addErr (precParseErr (quotes pp_op1,fix1)
277 (quotes pp_op2,fix2))
278 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
279 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
280 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
281 new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
282 ; return (mk2 (noLoc new_ty) ty22) }
284 (nofix_error, associate_right) = compareFixity fix1 fix2
287 ---------------------------
288 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
289 -> LHsExpr Name -> Fixity -- Operator and fixity
290 -> LHsExpr Name -- Right operand (not an OpApp, but might
294 -- (e11 `op1` e12) `op2` e2
295 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
297 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
298 returnM (OpApp e1 op2 fix2 e2)
301 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
302 returnM (OpApp e11 op1 fix1 (L loc' new_e))
304 loc'= combineLocs e12 e2
305 (nofix_error, associate_right) = compareFixity fix1 fix2
307 ---------------------------
308 -- (- neg_arg) `op` e2
309 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
311 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
312 returnM (OpApp e1 op2 fix2 e2)
315 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
316 returnM (NegApp (L loc' new_e) neg_name)
318 loc' = combineLocs neg_arg e2
319 (nofix_error, associate_right) = compareFixity negateFixity fix2
321 ---------------------------
323 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right
324 | not associate_right -- We *want* right association
325 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
326 returnM (OpApp e1 op1 fix1 e2)
328 (_, associate_right) = compareFixity fix1 negateFixity
330 ---------------------------
332 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
333 = ASSERT2( right_op_ok fix (unLoc e2),
334 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
336 returnM (OpApp e1 op fix e2)
338 -- Parser left-associates everything, but
339 -- derived instances may have correctly-associated things to
340 -- in the right operarand. So we just check that the right operand is OK
341 right_op_ok fix1 (OpApp _ _ fix2 _)
342 = not error_please && associate_right
344 (error_please, associate_right) = compareFixity fix1 fix2
345 right_op_ok fix1 other
348 -- Parser initially makes negation bind more tightly than any other operator
349 -- And "deriving" code should respect this (use HsPar if not)
350 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
351 mkNegAppRn neg_arg neg_name
352 = ASSERT( not_op_app (unLoc neg_arg) )
353 returnM (NegApp neg_arg neg_name)
355 not_op_app (OpApp _ _ _ _) = False
356 not_op_app other = True
358 ---------------------------
359 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
360 -> LHsExpr Name -> Fixity -- Operator and fixity
361 -> LHsCmdTop Name -- Right operand (not an infix)
364 -- (e11 `op1` e12) `op2` e2
365 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
368 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
369 returnM (HsArrForm op2 (Just fix2) [a1, a2])
372 = mkOpFormRn a12 op2 fix2 a2 `thenM` \ new_c ->
373 returnM (HsArrForm op1 (Just fix1)
374 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
375 -- TODO: locs are wrong
377 (nofix_error, associate_right) = compareFixity fix1 fix2
380 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
381 = returnM (HsArrForm op (Just fix) [arg1, arg2])
384 --------------------------------------
385 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
388 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
389 = do { fix1 <- lookupFixityRn (unLoc op1)
390 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
392 ; if nofix_error then do
393 { addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
394 ; return (ConPatIn op2 (InfixCon p1 p2)) }
396 else if associate_right then do
397 { new_p <- mkConOpPatRn op2 fix2 p12 p2
398 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
399 else return (ConPatIn op2 (InfixCon p1 p2)) }
401 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
402 = ASSERT( not_op_pat (unLoc p2) )
403 returnM (ConPatIn op (InfixCon p1 p2))
405 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
406 not_op_pat other = True
408 --------------------------------------
409 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
410 -- True indicates an infix lhs
411 -- See comments with rnExpr (OpApp ...) about "deriving"
413 checkPrecMatch False fn match
415 checkPrecMatch True op (MatchGroup ms _)
418 check (L _ (Match (p1:p2:_) _ _))
419 = checkPrec op (unLoc p1) False `thenM_`
420 checkPrec op (unLoc p2) True
423 -- This can happen. Consider
426 -- The infix flag comes from the first binding of the group
427 -- but the second eqn has no args (an error, but not discovered
428 -- until the type checker). So we don't want to crash on the
431 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
432 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
433 lookupFixityRn (unLoc op1) `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
435 inf_ok = op1_prec > op_prec ||
436 (op1_prec == op_prec &&
437 (op1_dir == InfixR && op_dir == InfixR && right ||
438 op1_dir == InfixL && op_dir == InfixL && not right))
440 info = (ppr_op op, op_fix)
441 info1 = (ppr_op op1, op1_fix)
442 (infol, infor) = if right then (info, info1) else (info1, info)
444 checkErr inf_ok (precParseErr infol infor)
446 checkPrec op pat right
449 -- Check precedence of (arg op) or (op arg) respectively
450 -- If arg is itself an operator application, then either
451 -- (a) its precedence must be higher than that of op
452 -- (b) its precedency & associativity must be the same as that of op
453 checkSectionPrec :: FixityDirection -> HsExpr RdrName
454 -> LHsExpr Name -> LHsExpr Name -> RnM ()
455 checkSectionPrec direction section op arg
457 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
458 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
461 L _ (HsVar op_name) = op
462 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
463 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
464 checkErr (op_prec < arg_prec
465 || op_prec == arg_prec && direction == assoc)
466 (sectionPrecErr (ppr_op op_name, op_fix)
467 (pp_arg_op, arg_fix) section)
470 Precedence-related error messages
474 = hang (ptext SLIT("precedence parsing error"))
475 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
477 ptext SLIT("in the same infix expression")])
479 sectionPrecErr op arg_op section
480 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
481 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
482 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
484 pp_prefix_minus = ptext SLIT("prefix `-'")
485 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
486 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
489 %*********************************************************
491 \subsection{Contexts and predicates}
493 %*********************************************************
496 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
497 rnContext doc = wrapLocM (rnContext' doc)
499 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
500 rnContext' doc ctxt = mappM (rnLPred doc) ctxt
502 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
503 rnLPred doc = wrapLocM (rnPred doc)
505 rnPred doc (HsClassP clas tys)
506 = do { clas_name <- lookupOccRn clas
507 ; tys' <- rnLHsTypes doc tys
508 ; returnM (HsClassP clas_name tys')
510 rnPred doc (HsEqualP ty1 ty2)
511 = do { ty1' <- rnLHsType doc ty1
512 ; ty2' <- rnLHsType doc ty2
513 ; returnM (HsEqualP ty1' ty2')
515 rnPred doc (HsIParam n ty)
516 = do { name <- newIPNameRn n
517 ; ty' <- rnLHsType doc ty
518 ; returnM (HsIParam name ty')
523 *********************************************************
525 \subsection{Patterns}
527 *********************************************************
530 rnPatsAndThen :: HsMatchContext Name
532 -> ([LPat Name] -> RnM (a, FreeVars))
534 -- Bring into scope all the binders and type variables
535 -- bound by the patterns; then rename the patterns; then
536 -- do the thing inside.
538 -- Note that we do a single bindLocalsRn for all the
539 -- matches together, so that we spot the repeated variable in
542 rnPatsAndThen ctxt pats thing_inside
543 = bindPatSigTyVarsFV pat_sig_tys $
544 bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs ->
545 rnLPats pats `thenM` \ (pats', pat_fvs) ->
546 thing_inside pats' `thenM` \ (res, res_fvs) ->
548 unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
550 warnUnusedMatches unused_binders `thenM_`
551 returnM (res, res_fvs `plusFV` pat_fvs)
553 pat_sig_tys = collectSigTysFromPats pats
554 bndrs = collectLocatedPatsBinders pats
555 doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
557 rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
558 rnLPats ps = mapFvRn rnLPat ps
560 rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
561 rnLPat = wrapLocFstM rnPat
563 -- -----------------------------------------------------------------------------
566 rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
568 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
571 = lookupBndrRn name `thenM` \ vname ->
572 returnM (VarPat vname, emptyFVs)
574 rnPat (SigPatIn pat ty)
575 = doptM Opt_PatternSignatures `thenM` \ patsigs ->
578 then rnLPat pat `thenM` \ (pat', fvs1) ->
579 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
580 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
582 else addErr (patSigErr ty) `thenM_`
583 rnPat (unLoc pat) -- XXX shouldn't throw away the loc
585 doc = text "In a pattern type-signature"
587 rnPat (LitPat lit@(HsString s))
588 = do { ovlStr <- doptM Opt_OverloadedStrings
589 ; if ovlStr then rnPat (mkNPat (mkHsIsString s) Nothing)
590 else do { rnLit lit; return (LitPat lit, emptyFVs) } } -- Same as below
593 returnM (LitPat lit, emptyFVs)
595 rnPat (NPat lit mb_neg eq _)
596 = rnOverLit lit `thenM` \ (lit', fvs1) ->
598 Nothing -> returnM (Nothing, emptyFVs)
599 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
600 returnM (Just neg, fvs)
601 ) `thenM` \ (mb_neg', fvs2) ->
602 lookupSyntaxName eqName `thenM` \ (eq', fvs3) ->
603 returnM (NPat lit' mb_neg' eq' placeHolderType,
604 fvs1 `plusFV` fvs2 `plusFV` fvs3)
605 -- Needed to find equality on pattern
607 rnPat (NPlusKPat name lit _ _)
608 = rnOverLit lit `thenM` \ (lit', fvs1) ->
609 lookupLocatedBndrRn name `thenM` \ name' ->
610 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
611 lookupSyntaxName geName `thenM` \ (ge, fvs3) ->
612 returnM (NPlusKPat name' lit' ge minus,
613 fvs1 `plusFV` fvs2 `plusFV` fvs3)
614 -- The Report says that n+k patterns must be in Integral
617 = rnLPat pat `thenM` \ (pat', fvs) ->
618 returnM (LazyPat pat', fvs)
621 = rnLPat pat `thenM` \ (pat', fvs) ->
622 returnM (BangPat pat', fvs)
624 rnPat (AsPat name pat)
625 = rnLPat pat `thenM` \ (pat', fvs) ->
626 lookupLocatedBndrRn name `thenM` \ vname ->
627 returnM (AsPat vname pat', fvs)
629 rnPat (ConPatIn con stuff) = rnConPat con stuff
632 = rnLPat pat `thenM` \ (pat', fvs) ->
633 returnM (ParPat pat', fvs)
635 rnPat (ListPat pats _)
636 = rnLPats pats `thenM` \ (patslist, fvs) ->
637 returnM (ListPat patslist placeHolderType, fvs)
639 rnPat (PArrPat pats _)
640 = rnLPats pats `thenM` \ (patslist, fvs) ->
641 returnM (PArrPat patslist placeHolderType,
642 fvs `plusFV` implicit_fvs)
644 implicit_fvs = mkFVs [lengthPName, indexPName]
646 rnPat (TuplePat pats boxed _)
647 = checkTupSize (length pats) `thenM_`
648 rnLPats pats `thenM` \ (patslist, fvs) ->
649 returnM (TuplePat patslist boxed placeHolderType, fvs)
651 rnPat (TypePat name) =
652 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
653 returnM (TypePat name', fvs)
655 -- -----------------------------------------------------------------------------
658 rnConPat :: Located RdrName -> HsConPatDetails RdrName -> RnM (Pat Name, FreeVars)
659 rnConPat con (PrefixCon pats)
660 = do { con' <- lookupLocatedOccRn con
661 ; (pats', fvs) <- rnLPats pats
662 ; return (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con') }
664 rnConPat con (RecCon rpats)
665 = do { con' <- lookupLocatedOccRn con
666 ; (rpats', fvs) <- rnHsRecFields "pattern" (Just con') rnLPat VarPat rpats
667 ; return (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con') }
669 rnConPat con (InfixCon pat1 pat2)
670 = do { con' <- lookupLocatedOccRn con
671 ; (pat1', fvs1) <- rnLPat pat1
672 ; (pat2', fvs2) <- rnLPat pat2
673 ; fixity <- lookupFixityRn (unLoc con')
674 ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
675 ; return (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con') }
677 -- -----------------------------------------------------------------------------
678 rnHsRecFields :: String -- "pattern" or "construction" or "update"
679 -> Maybe (Located Name)
680 -> (Located a -> RnM (Located b, FreeVars))
681 -> (RdrName -> a) -- How to fill in ".."
682 -> HsRecFields RdrName (Located a)
683 -> RnM (HsRecFields Name (Located b), FreeVars)
684 -- Haddock comments for record fields are renamed to Nothing here
685 rnHsRecFields str mb_con rn_thing mk_rhs (HsRecFields fields dd)
686 = do { mappM_ field_dup_err dup_fields
687 ; pun_flag <- doptM Opt_RecordPuns
688 ; (fields1, fvs1) <- mapFvRn (rn_rpat pun_flag) fields
690 Nothing -> return (HsRecFields fields1 dd, fvs1)
691 Just n -> ASSERT( n == length fields ) do
692 { dd_flag <- doptM Opt_RecordWildCards
693 ; checkErr dd_flag (needFlagDotDot str)
695 ; let fld_names1 = map (unLoc . hsRecFieldId) fields1
696 ; (fields2, fvs2) <- dot_dot_fields fld_names1 mb_con
698 ; return (HsRecFields (fields1 ++ fields2) dd, fvs1 `plusFV` fvs2) } }
700 (_, dup_fields) = removeDups compare (map (unLoc . hsRecFieldId) fields)
702 field_dup_err dups = addErr (dupFieldErr str (head dups))
704 rn_rpat pun_ok (HsRecField field pat pun)
705 = do { fieldname <- lookupRecordBndr mb_con field
706 ; checkErr (not pun || pun_ok) (badPun field)
707 ; (pat', fvs) <- rn_thing pat
708 ; return (HsRecField fieldname pat' pun,
709 fvs `addOneFV` unLoc fieldname) }
711 dot_dot_fields fs Nothing = do { addErr (badDotDot str)
712 ; return ([], emptyFVs) }
714 -- Compute the extra fields to be filled in by the dot-dot notation
715 dot_dot_fields fs (Just con)
716 = do { con_fields <- lookupConstructorFields (unLoc con)
717 ; let missing_fields = con_fields `minusList` fs
718 ; loc <- getSrcSpanM -- Rather approximate
719 ; (rhss, fvs_s) <- mapAndUnzipM rn_thing
720 [ L loc (mk_rhs (mkRdrUnqual (getOccName f)))
721 | f <- missing_fields ]
722 ; let new_fs = [ HsRecField (L loc f) r False
723 | (f, r) <- missing_fields `zip` rhss ]
724 ; return (new_fs, plusFVs fvs_s) }
726 needFlagDotDot str = vcat [ptext SLIT("Illegal `..' in record") <+> text str,
727 ptext SLIT("Use -frecord-dot-dot to permit this")]
729 badDotDot str = ptext SLIT("You cannot use `..' in record") <+> text str
731 badPun fld = vcat [ptext SLIT("Illegal use of punning for field") <+> quotes (ppr fld),
732 ptext SLIT("Use -frecord-puns to permit this")]
736 %************************************************************************
738 \subsubsection{Literals}
740 %************************************************************************
742 When literals occur we have to make sure
743 that the types and classes they involve
747 rnLit :: HsLit -> RnM ()
748 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
749 rnLit other = returnM ()
751 rnOverLit (HsIntegral i _)
752 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
754 returnM (HsIntegral i from_integer_name, fvs)
756 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
757 -- Big integer literals are built, using + and *,
758 -- out of small integers (DsUtils.mkIntegerLit)
759 -- [NB: plusInteger, timesInteger aren't rebindable...
760 -- they are used to construct the argument to fromInteger,
761 -- which is the rebindable one.]
763 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
765 rnOverLit (HsFractional i _)
766 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
768 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
769 -- We have to make sure that the Ratio type is imported with
770 -- its constructor, because literals of type Ratio t are
771 -- built with that constructor.
772 -- The Rational type is needed too, but that will come in
773 -- as part of the type for fromRational.
774 -- The plus/times integer operations may be needed to construct the numerator
775 -- and denominator (see DsUtils.mkIntegerLit)
777 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
779 rnOverLit (HsIsString s _)
780 = lookupSyntaxName fromStringName `thenM` \ (from_string_name, fvs) ->
781 returnM (HsIsString s from_string_name, fvs)
786 %*********************************************************
790 %*********************************************************
793 checkTupSize :: Int -> RnM ()
794 checkTupSize tup_size
795 | tup_size <= mAX_TUPLE_SIZE
798 = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
799 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
800 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
802 forAllWarn doc ty (L loc tyvar)
803 = ifOptM Opt_WarnUnusedMatches $
804 addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
805 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
810 = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
811 2 (parens (ptext SLIT("Use -XTypeOperators to allow operators in types")))
814 = ptext SLIT("character literal out of range: '\\") <> char c <> char '\''
817 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
818 $$ nest 4 (ptext SLIT("Use -XPatternSigs to permit it"))
821 = hsep [ptext SLIT("duplicate field name"),
823 ptext SLIT("in record"), text str]