2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 rnHsType, rnLHsType, rnLHsTypes, rnContext,
17 rnHsSigType, rnHsTypeFVs,
19 -- Patterns and literals
20 rnLPat, rnPatsAndThen, -- Here because it's not part
21 rnLit, rnOverLit, -- of any mutual recursion
24 -- Precence related stuff
25 mkOpAppRn, mkNegAppRn, mkOpFormRn,
26 checkPrecMatch, checkSectionPrec,
29 patSigErr, checkTupSize
34 import RdrHsSyn ( extractHsRhoRdrTyVars )
35 import RnHsSyn ( extractHsTyNames, parrTyCon_name, tupleTyCon_name,
38 import RnHsDoc ( rnLHsDoc )
39 import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
40 lookupLocatedOccRn, lookupLocatedBndrRn,
41 lookupLocatedGlobalOccRn, bindTyVarsRn,
42 lookupFixityRn, lookupTyFixityRn, lookupConstructorFields,
43 lookupRecordBndr, mapFvRn, warnUnusedMatches,
44 newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV )
47 import PrelNames ( eqClassName, integralClassName, geName, eqName,
48 negateName, minusName, lengthPName, indexPName,
49 plusIntegerName, fromIntegerName, timesIntegerName,
50 ratioDataConName, fromRationalName, fromStringName )
51 import TypeRep ( funTyCon )
52 import Constants ( mAX_TUPLE_SIZE )
57 import Literal ( inIntRange, inCharRange )
58 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
59 Fixity(..), FixityDirection(..) )
60 import ListSetOps ( removeDups, minusList )
63 #include "HsVersions.h"
66 These type renamers are in a separate module, rather than in (say) RnSource,
67 to break several loop.
69 %*********************************************************
71 \subsection{Renaming types}
73 %*********************************************************
76 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
77 rnHsTypeFVs doc_str ty
78 = rnLHsType doc_str ty `thenM` \ ty' ->
79 returnM (ty', extractHsTyNames ty')
81 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
82 -- rnHsSigType is used for source-language type signatures,
83 -- which use *implicit* universal quantification.
84 rnHsSigType doc_str ty
85 = rnLHsType (text "In the type signature for" <+> doc_str) ty
88 rnHsType is here because we call it from loadInstDecl, and I didn't
89 want a gratuitous knot.
92 rnLHsType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
93 rnLHsType doc = wrapLocM (rnHsType doc)
95 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
97 rnHsType doc (HsForAllTy Implicit _ ctxt ty)
98 -- Implicit quantifiction in source code (no kinds on tyvars)
99 -- Given the signature C => T we universally quantify
100 -- over FV(T) \ {in-scope-tyvars}
101 = getLocalRdrEnv `thenM` \ name_env ->
103 mentioned = extractHsRhoRdrTyVars ctxt ty
105 -- Don't quantify over type variables that are in scope;
106 -- when GlasgowExts is off, there usually won't be any, except for
108 -- class C a where { op :: a -> a }
109 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
110 tyvar_bndrs = userHsTyVarBndrs forall_tyvars
112 rnForAll doc Implicit tyvar_bndrs ctxt ty
114 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
115 -- Explicit quantification.
116 -- Check that the forall'd tyvars are actually
117 -- mentioned in the type, and produce a warning if not
119 mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
120 forall_tyvar_names = hsLTyVarLocNames forall_tyvars
122 -- Explicitly quantified but not mentioned in ctxt or tau
123 warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
125 mappM_ (forAllWarn doc tau) warn_guys `thenM_`
126 rnForAll doc Explicit forall_tyvars ctxt tau
128 rnHsType doc (HsTyVar tyvar)
129 = lookupOccRn tyvar `thenM` \ tyvar' ->
130 returnM (HsTyVar tyvar')
132 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
134 do { ty_ops_ok <- doptM Opt_TypeOperators
135 ; checkErr ty_ops_ok (opTyErr op ty)
136 ; op' <- lookupOccRn op
137 ; let l_op' = L loc op'
138 ; fix <- lookupTyFixityRn l_op'
139 ; ty1' <- rnLHsType doc ty1
140 ; ty2' <- rnLHsType doc ty2
141 ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2' }
143 rnHsType doc (HsParTy ty)
144 = rnLHsType doc ty `thenM` \ ty' ->
145 returnM (HsParTy ty')
147 rnHsType doc (HsBangTy b ty)
148 = rnLHsType doc ty `thenM` \ ty' ->
149 returnM (HsBangTy b ty')
151 rnHsType doc (HsNumTy i)
152 | i == 1 = returnM (HsNumTy i)
153 | otherwise = addErr err_msg `thenM_` returnM (HsNumTy i)
155 err_msg = ptext SLIT("Only unit numeric type pattern is valid")
158 rnHsType doc (HsFunTy ty1 ty2)
159 = rnLHsType doc ty1 `thenM` \ ty1' ->
160 -- Might find a for-all as the arg of a function type
161 rnLHsType doc ty2 `thenM` \ ty2' ->
162 -- Or as the result. This happens when reading Prelude.hi
163 -- when we find return :: forall m. Monad m -> forall a. a -> m a
165 -- Check for fixity rearrangements
166 mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2'
168 rnHsType doc (HsListTy ty)
169 = rnLHsType doc ty `thenM` \ ty' ->
170 returnM (HsListTy ty')
172 rnHsType doc (HsKindSig ty k)
173 = rnLHsType doc ty `thenM` \ ty' ->
174 returnM (HsKindSig ty' k)
176 rnHsType doc (HsPArrTy ty)
177 = rnLHsType doc ty `thenM` \ ty' ->
178 returnM (HsPArrTy ty')
180 -- Unboxed tuples are allowed to have poly-typed arguments. These
181 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
182 rnHsType doc (HsTupleTy tup_con tys)
183 = mappM (rnLHsType doc) tys `thenM` \ tys' ->
184 returnM (HsTupleTy tup_con tys')
186 rnHsType doc (HsAppTy ty1 ty2)
187 = rnLHsType doc ty1 `thenM` \ ty1' ->
188 rnLHsType doc ty2 `thenM` \ ty2' ->
189 returnM (HsAppTy ty1' ty2')
191 rnHsType doc (HsPredTy pred)
192 = rnPred doc pred `thenM` \ pred' ->
193 returnM (HsPredTy pred')
195 rnHsType doc (HsSpliceTy _)
196 = do { addErr (ptext SLIT("Type splices are not yet implemented"))
199 rnHsType doc (HsDocTy ty haddock_doc)
200 = rnLHsType doc ty `thenM` \ ty' ->
201 rnLHsDoc haddock_doc `thenM` \ haddock_doc' ->
202 returnM (HsDocTy ty' haddock_doc')
204 rnLHsTypes doc tys = mappM (rnLHsType doc) tys
209 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
210 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
212 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
213 -- One reason for this case is that a type like Int#
214 -- starts off as (HsForAllTy Nothing [] Int), in case
215 -- there is some quantification. Now that we have quantified
216 -- and discovered there are no type variables, it's nicer to turn
217 -- it into plain Int. If it were Int# instead of Int, we'd actually
218 -- get an error, because the body of a genuine for-all is
221 rnForAll doc exp forall_tyvars ctxt ty
222 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
223 rnContext doc ctxt `thenM` \ new_ctxt ->
224 rnLHsType doc ty `thenM` \ new_ty ->
225 returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
226 -- Retain the same implicit/explicit flag as before
227 -- so that we can later print it correctly
231 %************************************************************************
233 Fixities and precedence parsing
235 %************************************************************************
237 @mkOpAppRn@ deals with operator fixities. The argument expressions
238 are assumed to be already correctly arranged. It needs the fixities
239 recorded in the OpApp nodes, because fixity info applies to the things
240 the programmer actually wrote, so you can't find it out from the Name.
242 Furthermore, the second argument is guaranteed not to be another
243 operator application. Why? Because the parser parses all
244 operator appications left-associatively, EXCEPT negation, which
245 we need to handle specially.
246 Infix types are read in a *right-associative* way, so that
251 mkHsOpTyRn rearranges where necessary. The two arguments
252 have already been renamed and rearranged. It's made rather tiresome
253 by the presence of ->, which is a separate syntactic construct.
257 -- Building (ty1 `op1` (ty21 `op2` ty22))
258 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
259 -> SDoc -> Fixity -> LHsType Name -> LHsType Name
262 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
263 = do { fix2 <- lookupTyFixityRn op2
264 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
265 (\t1 t2 -> HsOpTy t1 op2 t2)
266 (ppr op2) fix2 ty21 ty22 loc2 }
268 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
269 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
270 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
272 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 -- Default case, no rearrangment
273 = return (mk1 ty1 ty2)
276 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
277 -> SDoc -> Fixity -> LHsType Name
278 -> (LHsType Name -> LHsType Name -> HsType Name)
279 -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
281 mk_hs_op_ty mk1 pp_op1 fix1 ty1
282 mk2 pp_op2 fix2 ty21 ty22 loc2
283 | nofix_error = do { addErr (precParseErr (quotes pp_op1,fix1)
284 (quotes pp_op2,fix2))
285 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
286 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
287 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
288 new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
289 ; return (mk2 (noLoc new_ty) ty22) }
291 (nofix_error, associate_right) = compareFixity fix1 fix2
294 ---------------------------
295 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
296 -> LHsExpr Name -> Fixity -- Operator and fixity
297 -> LHsExpr Name -- Right operand (not an OpApp, but might
301 -- (e11 `op1` e12) `op2` e2
302 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
304 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
305 returnM (OpApp e1 op2 fix2 e2)
308 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
309 returnM (OpApp e11 op1 fix1 (L loc' new_e))
311 loc'= combineLocs e12 e2
312 (nofix_error, associate_right) = compareFixity fix1 fix2
314 ---------------------------
315 -- (- neg_arg) `op` e2
316 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
318 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
319 returnM (OpApp e1 op2 fix2 e2)
322 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
323 returnM (NegApp (L loc' new_e) neg_name)
325 loc' = combineLocs neg_arg e2
326 (nofix_error, associate_right) = compareFixity negateFixity fix2
328 ---------------------------
330 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right
331 | not associate_right -- We *want* right association
332 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
333 returnM (OpApp e1 op1 fix1 e2)
335 (_, associate_right) = compareFixity fix1 negateFixity
337 ---------------------------
339 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
340 = ASSERT2( right_op_ok fix (unLoc e2),
341 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
343 returnM (OpApp e1 op fix e2)
345 -- Parser left-associates everything, but
346 -- derived instances may have correctly-associated things to
347 -- in the right operarand. So we just check that the right operand is OK
348 right_op_ok fix1 (OpApp _ _ fix2 _)
349 = not error_please && associate_right
351 (error_please, associate_right) = compareFixity fix1 fix2
352 right_op_ok fix1 other
355 -- Parser initially makes negation bind more tightly than any other operator
356 -- And "deriving" code should respect this (use HsPar if not)
357 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
358 mkNegAppRn neg_arg neg_name
359 = ASSERT( not_op_app (unLoc neg_arg) )
360 returnM (NegApp neg_arg neg_name)
362 not_op_app (OpApp _ _ _ _) = False
363 not_op_app other = True
365 ---------------------------
366 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
367 -> LHsExpr Name -> Fixity -- Operator and fixity
368 -> LHsCmdTop Name -- Right operand (not an infix)
371 -- (e11 `op1` e12) `op2` e2
372 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
375 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
376 returnM (HsArrForm op2 (Just fix2) [a1, a2])
379 = mkOpFormRn a12 op2 fix2 a2 `thenM` \ new_c ->
380 returnM (HsArrForm op1 (Just fix1)
381 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
382 -- TODO: locs are wrong
384 (nofix_error, associate_right) = compareFixity fix1 fix2
387 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
388 = returnM (HsArrForm op (Just fix) [arg1, arg2])
391 --------------------------------------
392 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
395 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
396 = do { fix1 <- lookupFixityRn (unLoc op1)
397 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
399 ; if nofix_error then do
400 { addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
401 ; return (ConPatIn op2 (InfixCon p1 p2)) }
403 else if associate_right then do
404 { new_p <- mkConOpPatRn op2 fix2 p12 p2
405 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
406 else return (ConPatIn op2 (InfixCon p1 p2)) }
408 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
409 = ASSERT( not_op_pat (unLoc p2) )
410 returnM (ConPatIn op (InfixCon p1 p2))
412 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
413 not_op_pat other = True
415 --------------------------------------
416 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
417 -- True indicates an infix lhs
418 -- See comments with rnExpr (OpApp ...) about "deriving"
420 checkPrecMatch False fn match
422 checkPrecMatch True op (MatchGroup ms _)
425 check (L _ (Match (p1:p2:_) _ _))
426 = checkPrec op (unLoc p1) False `thenM_`
427 checkPrec op (unLoc p2) True
430 -- This can happen. Consider
433 -- The infix flag comes from the first binding of the group
434 -- but the second eqn has no args (an error, but not discovered
435 -- until the type checker). So we don't want to crash on the
438 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
439 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
440 lookupFixityRn (unLoc op1) `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
442 inf_ok = op1_prec > op_prec ||
443 (op1_prec == op_prec &&
444 (op1_dir == InfixR && op_dir == InfixR && right ||
445 op1_dir == InfixL && op_dir == InfixL && not right))
447 info = (ppr_op op, op_fix)
448 info1 = (ppr_op op1, op1_fix)
449 (infol, infor) = if right then (info, info1) else (info1, info)
451 checkErr inf_ok (precParseErr infol infor)
453 checkPrec op pat right
456 -- Check precedence of (arg op) or (op arg) respectively
457 -- If arg is itself an operator application, then either
458 -- (a) its precedence must be higher than that of op
459 -- (b) its precedency & associativity must be the same as that of op
460 checkSectionPrec :: FixityDirection -> HsExpr RdrName
461 -> LHsExpr Name -> LHsExpr Name -> RnM ()
462 checkSectionPrec direction section op arg
464 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
465 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
468 L _ (HsVar op_name) = op
469 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
470 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
471 checkErr (op_prec < arg_prec
472 || op_prec == arg_prec && direction == assoc)
473 (sectionPrecErr (ppr_op op_name, op_fix)
474 (pp_arg_op, arg_fix) section)
477 Precedence-related error messages
481 = hang (ptext SLIT("precedence parsing error"))
482 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
484 ptext SLIT("in the same infix expression")])
486 sectionPrecErr op arg_op section
487 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
488 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
489 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
491 pp_prefix_minus = ptext SLIT("prefix `-'")
492 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
493 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
496 %*********************************************************
498 \subsection{Contexts and predicates}
500 %*********************************************************
503 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
504 rnContext doc = wrapLocM (rnContext' doc)
506 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
507 rnContext' doc ctxt = mappM (rnLPred doc) ctxt
509 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
510 rnLPred doc = wrapLocM (rnPred doc)
512 rnPred doc (HsClassP clas tys)
513 = do { clas_name <- lookupOccRn clas
514 ; tys' <- rnLHsTypes doc tys
515 ; returnM (HsClassP clas_name tys')
517 rnPred doc (HsEqualP ty1 ty2)
518 = do { ty1' <- rnLHsType doc ty1
519 ; ty2' <- rnLHsType doc ty2
520 ; returnM (HsEqualP ty1' ty2')
522 rnPred doc (HsIParam n ty)
523 = do { name <- newIPNameRn n
524 ; ty' <- rnLHsType doc ty
525 ; returnM (HsIParam name ty')
530 *********************************************************
532 \subsection{Patterns}
534 *********************************************************
537 rnPatsAndThen :: HsMatchContext Name
539 -> ([LPat Name] -> RnM (a, FreeVars))
541 -- Bring into scope all the binders and type variables
542 -- bound by the patterns; then rename the patterns; then
543 -- do the thing inside.
545 -- Note that we do a single bindLocalsRn for all the
546 -- matches together, so that we spot the repeated variable in
549 rnPatsAndThen ctxt pats thing_inside
550 = bindPatSigTyVarsFV pat_sig_tys $
551 bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs ->
552 rnLPats pats `thenM` \ (pats', pat_fvs) ->
553 thing_inside pats' `thenM` \ (res, res_fvs) ->
555 unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
557 warnUnusedMatches unused_binders `thenM_`
558 returnM (res, res_fvs `plusFV` pat_fvs)
560 pat_sig_tys = collectSigTysFromPats pats
561 bndrs = collectLocatedPatsBinders pats
562 doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
564 rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
565 rnLPats ps = mapFvRn rnLPat ps
567 rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
568 rnLPat = wrapLocFstM rnPat
570 -- -----------------------------------------------------------------------------
573 rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
575 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
578 = lookupBndrRn name `thenM` \ vname ->
579 returnM (VarPat vname, emptyFVs)
581 rnPat (SigPatIn pat ty)
582 = doptM Opt_PatternSignatures `thenM` \ patsigs ->
585 then rnLPat pat `thenM` \ (pat', fvs1) ->
586 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
587 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
589 else addErr (patSigErr ty) `thenM_`
590 rnPat (unLoc pat) -- XXX shouldn't throw away the loc
592 doc = text "In a pattern type-signature"
594 rnPat (LitPat lit@(HsString s))
595 = do { ovlStr <- doptM Opt_OverloadedStrings
596 ; if ovlStr then rnPat (mkNPat (mkHsIsString s) Nothing)
597 else do { rnLit lit; return (LitPat lit, emptyFVs) } } -- Same as below
600 returnM (LitPat lit, emptyFVs)
602 rnPat (NPat lit mb_neg eq _)
603 = rnOverLit lit `thenM` \ (lit', fvs1) ->
605 Nothing -> returnM (Nothing, emptyFVs)
606 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
607 returnM (Just neg, fvs)
608 ) `thenM` \ (mb_neg', fvs2) ->
609 lookupSyntaxName eqName `thenM` \ (eq', fvs3) ->
610 returnM (NPat lit' mb_neg' eq' placeHolderType,
611 fvs1 `plusFV` fvs2 `plusFV` fvs3)
612 -- Needed to find equality on pattern
614 rnPat (NPlusKPat name lit _ _)
615 = rnOverLit lit `thenM` \ (lit', fvs1) ->
616 lookupLocatedBndrRn name `thenM` \ name' ->
617 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
618 lookupSyntaxName geName `thenM` \ (ge, fvs3) ->
619 returnM (NPlusKPat name' lit' ge minus,
620 fvs1 `plusFV` fvs2 `plusFV` fvs3)
621 -- The Report says that n+k patterns must be in Integral
624 = rnLPat pat `thenM` \ (pat', fvs) ->
625 returnM (LazyPat pat', fvs)
628 = rnLPat pat `thenM` \ (pat', fvs) ->
629 returnM (BangPat pat', fvs)
631 rnPat (AsPat name pat)
632 = rnLPat pat `thenM` \ (pat', fvs) ->
633 lookupLocatedBndrRn name `thenM` \ vname ->
634 returnM (AsPat vname pat', fvs)
636 rnPat (ConPatIn con stuff) = rnConPat con stuff
639 = rnLPat pat `thenM` \ (pat', fvs) ->
640 returnM (ParPat pat', fvs)
642 rnPat (ListPat pats _)
643 = rnLPats pats `thenM` \ (patslist, fvs) ->
644 returnM (ListPat patslist placeHolderType, fvs)
646 rnPat (PArrPat pats _)
647 = rnLPats pats `thenM` \ (patslist, fvs) ->
648 returnM (PArrPat patslist placeHolderType,
649 fvs `plusFV` implicit_fvs)
651 implicit_fvs = mkFVs [lengthPName, indexPName]
653 rnPat (TuplePat pats boxed _)
654 = checkTupSize (length pats) `thenM_`
655 rnLPats pats `thenM` \ (patslist, fvs) ->
656 returnM (TuplePat patslist boxed placeHolderType, fvs)
658 rnPat (TypePat name) =
659 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
660 returnM (TypePat name', fvs)
662 -- -----------------------------------------------------------------------------
665 rnConPat :: Located RdrName -> HsConPatDetails RdrName -> RnM (Pat Name, FreeVars)
666 rnConPat con (PrefixCon pats)
667 = do { con' <- lookupLocatedOccRn con
668 ; (pats', fvs) <- rnLPats pats
669 ; return (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con') }
671 rnConPat con (RecCon rpats)
672 = do { con' <- lookupLocatedOccRn con
673 ; (rpats', fvs) <- rnHsRecFields "pattern" (Just con') rnLPat VarPat rpats
674 ; return (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con') }
676 rnConPat con (InfixCon pat1 pat2)
677 = do { con' <- lookupLocatedOccRn con
678 ; (pat1', fvs1) <- rnLPat pat1
679 ; (pat2', fvs2) <- rnLPat pat2
680 ; fixity <- lookupFixityRn (unLoc con')
681 ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
682 ; return (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con') }
684 -- -----------------------------------------------------------------------------
685 rnHsRecFields :: String -- "pattern" or "construction" or "update"
686 -> Maybe (Located Name)
687 -> (Located a -> RnM (Located b, FreeVars))
688 -> (RdrName -> a) -- How to fill in ".."
689 -> HsRecFields RdrName (Located a)
690 -> RnM (HsRecFields Name (Located b), FreeVars)
691 -- Haddock comments for record fields are renamed to Nothing here
692 rnHsRecFields str mb_con rn_thing mk_rhs (HsRecFields fields dd)
693 = do { mappM_ field_dup_err dup_fields
694 ; pun_flag <- doptM Opt_RecordPuns
695 ; (fields1, fvs1) <- mapFvRn (rn_rpat pun_flag) fields
697 Nothing -> return (HsRecFields fields1 dd, fvs1)
698 Just n -> ASSERT( n == length fields ) do
699 { dd_flag <- doptM Opt_RecordWildCards
700 ; checkErr dd_flag (needFlagDotDot str)
702 ; let fld_names1 = map (unLoc . hsRecFieldId) fields1
703 ; (fields2, fvs2) <- dot_dot_fields fld_names1 mb_con
705 ; return (HsRecFields (fields1 ++ fields2) dd, fvs1 `plusFV` fvs2) } }
707 (_, dup_fields) = removeDups compare (map (unLoc . hsRecFieldId) fields)
709 field_dup_err dups = addErr (dupFieldErr str (head dups))
711 rn_rpat pun_ok (HsRecField field pat pun)
712 = do { fieldname <- lookupRecordBndr mb_con field
713 ; checkErr (not pun || pun_ok) (badPun field)
714 ; (pat', fvs) <- rn_thing pat
715 ; return (HsRecField fieldname pat' pun,
716 fvs `addOneFV` unLoc fieldname) }
718 dot_dot_fields fs Nothing = do { addErr (badDotDot str)
719 ; return ([], emptyFVs) }
721 -- Compute the extra fields to be filled in by the dot-dot notation
722 dot_dot_fields fs (Just con)
723 = do { con_fields <- lookupConstructorFields (unLoc con)
724 ; let missing_fields = con_fields `minusList` fs
725 ; loc <- getSrcSpanM -- Rather approximate
726 ; (rhss, fvs_s) <- mapAndUnzipM rn_thing
727 [ L loc (mk_rhs (mkRdrUnqual (getOccName f)))
728 | f <- missing_fields ]
729 ; let new_fs = [ HsRecField (L loc f) r False
730 | (f, r) <- missing_fields `zip` rhss ]
731 ; return (new_fs, plusFVs fvs_s) }
733 needFlagDotDot str = vcat [ptext SLIT("Illegal `..' in record") <+> text str,
734 ptext SLIT("Use -frecord-dot-dot to permit this")]
736 badDotDot str = ptext SLIT("You cannot use `..' in record") <+> text str
738 badPun fld = vcat [ptext SLIT("Illegal use of punning for field") <+> quotes (ppr fld),
739 ptext SLIT("Use -frecord-puns to permit this")]
743 %************************************************************************
745 \subsubsection{Literals}
747 %************************************************************************
749 When literals occur we have to make sure
750 that the types and classes they involve
754 rnLit :: HsLit -> RnM ()
755 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
756 rnLit other = returnM ()
758 rnOverLit (HsIntegral i _)
759 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
761 returnM (HsIntegral i from_integer_name, fvs)
763 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
764 -- Big integer literals are built, using + and *,
765 -- out of small integers (DsUtils.mkIntegerLit)
766 -- [NB: plusInteger, timesInteger aren't rebindable...
767 -- they are used to construct the argument to fromInteger,
768 -- which is the rebindable one.]
770 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
772 rnOverLit (HsFractional i _)
773 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
775 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
776 -- We have to make sure that the Ratio type is imported with
777 -- its constructor, because literals of type Ratio t are
778 -- built with that constructor.
779 -- The Rational type is needed too, but that will come in
780 -- as part of the type for fromRational.
781 -- The plus/times integer operations may be needed to construct the numerator
782 -- and denominator (see DsUtils.mkIntegerLit)
784 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
786 rnOverLit (HsIsString s _)
787 = lookupSyntaxName fromStringName `thenM` \ (from_string_name, fvs) ->
788 returnM (HsIsString s from_string_name, fvs)
793 %*********************************************************
797 %*********************************************************
800 checkTupSize :: Int -> RnM ()
801 checkTupSize tup_size
802 | tup_size <= mAX_TUPLE_SIZE
805 = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
806 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
807 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
809 forAllWarn doc ty (L loc tyvar)
810 = ifOptM Opt_WarnUnusedMatches $
811 addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
812 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
817 = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
818 2 (parens (ptext SLIT("Use -XTypeOperators to allow operators in types")))
821 = ptext SLIT("character literal out of range: '\\") <> char c <> char '\''
824 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
825 $$ nest 4 (ptext SLIT("Use -XPatternSignatures to permit it"))
828 = hsep [ptext SLIT("duplicate field name"),
830 ptext SLIT("in record"), text str]