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 -- Precence related stuff
20 mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
21 checkPrecMatch, checkSectionPrec
26 import RdrHsSyn ( extractHsRhoRdrTyVars )
27 import RnHsSyn ( extractHsTyNames, parrTyCon_name, tupleTyCon_name,
30 import RnHsDoc ( rnLHsDoc )
36 import TypeRep ( funTyCon )
37 import Constants ( mAX_TUPLE_SIZE )
42 import Literal ( inIntRange, inCharRange )
43 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
44 Fixity(..), FixityDirection(..) )
45 import ListSetOps ( removeDups, minusList )
48 #include "HsVersions.h"
51 These type renamers are in a separate module, rather than in (say) RnSource,
52 to break several loop.
54 %*********************************************************
56 \subsection{Renaming types}
58 %*********************************************************
61 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
62 rnHsTypeFVs doc_str ty = do
63 ty' <- rnLHsType doc_str ty
64 return (ty', extractHsTyNames ty')
66 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
67 -- rnHsSigType is used for source-language type signatures,
68 -- which use *implicit* universal quantification.
69 rnHsSigType doc_str ty
70 = rnLHsType (text "In the type signature for" <+> doc_str) ty
73 rnHsType is here because we call it from loadInstDecl, and I didn't
74 want a gratuitous knot.
77 rnLHsType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
78 rnLHsType doc = wrapLocM (rnHsType doc)
80 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
82 rnHsType doc (HsForAllTy Implicit _ ctxt ty) = do
83 -- Implicit quantifiction in source code (no kinds on tyvars)
84 -- Given the signature C => T we universally quantify
85 -- over FV(T) \ {in-scope-tyvars}
86 name_env <- getLocalRdrEnv
88 mentioned = extractHsRhoRdrTyVars ctxt ty
90 -- Don't quantify over type variables that are in scope;
91 -- when GlasgowExts is off, there usually won't be any, except for
93 -- class C a where { op :: a -> a }
94 forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
95 tyvar_bndrs = userHsTyVarBndrs forall_tyvars
97 rnForAll doc Implicit tyvar_bndrs ctxt ty
99 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau) = do
100 -- Explicit quantification.
101 -- Check that the forall'd tyvars are actually
102 -- mentioned in the type, and produce a warning if not
104 mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
105 forall_tyvar_names = hsLTyVarLocNames forall_tyvars
107 -- Explicitly quantified but not mentioned in ctxt or tau
108 warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
110 mapM_ (forAllWarn doc tau) warn_guys
111 rnForAll doc Explicit forall_tyvars ctxt tau
113 rnHsType doc (HsTyVar tyvar) = do
114 tyvar' <- lookupOccRn tyvar
115 return (HsTyVar tyvar')
117 -- If we see (forall a . ty), without foralls on, the forall will give
118 -- a sensible error message, but we don't want to complain about the dot too
119 -- Hence the jiggery pokery with ty1
120 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
122 do { ops_ok <- doptM Opt_TypeOperators
125 else do { addErr (opTyErr op ty)
126 ; return (mkUnboundName op) } -- Avoid double complaint
127 ; let l_op' = L loc op'
128 ; fix <- lookupTyFixityRn l_op'
129 ; ty1' <- rnLHsType doc ty1
130 ; ty2' <- rnLHsType doc ty2
131 ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2' }
133 rnHsType doc (HsParTy ty) = do
134 ty' <- rnLHsType doc ty
137 rnHsType doc (HsBangTy b ty) = do
138 ty' <- rnLHsType doc ty
139 return (HsBangTy b ty')
141 rnHsType doc (HsNumTy i)
142 | i == 1 = return (HsNumTy i)
143 | otherwise = addErr err_msg >> return (HsNumTy i)
145 err_msg = ptext SLIT("Only unit numeric type pattern is valid")
148 rnHsType doc (HsFunTy ty1 ty2) = do
149 ty1' <- rnLHsType doc ty1
150 -- Might find a for-all as the arg of a function type
151 ty2' <- rnLHsType doc ty2
152 -- Or as the result. This happens when reading Prelude.hi
153 -- when we find return :: forall m. Monad m -> forall a. a -> m a
155 -- Check for fixity rearrangements
156 mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2'
158 rnHsType doc (HsListTy ty) = do
159 ty' <- rnLHsType doc ty
160 return (HsListTy ty')
162 rnHsType doc (HsKindSig ty k) = do
163 ty' <- rnLHsType doc ty
164 return (HsKindSig ty' k)
166 rnHsType doc (HsPArrTy ty) = do
167 ty' <- rnLHsType doc ty
168 return (HsPArrTy ty')
170 -- Unboxed tuples are allowed to have poly-typed arguments. These
171 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
172 rnHsType doc (HsTupleTy tup_con tys) = do
173 tys' <- mapM (rnLHsType doc) tys
174 return (HsTupleTy tup_con tys')
176 rnHsType doc (HsAppTy ty1 ty2) = do
177 ty1' <- rnLHsType doc ty1
178 ty2' <- rnLHsType doc ty2
179 return (HsAppTy ty1' ty2')
181 rnHsType doc (HsPredTy pred) = do
182 pred' <- rnPred doc pred
183 return (HsPredTy pred')
185 rnHsType doc (HsSpliceTy _) = do
186 addErr (ptext SLIT("Type splices are not yet implemented"))
189 rnHsType doc (HsDocTy ty haddock_doc) = do
190 ty' <- rnLHsType doc ty
191 haddock_doc' <- rnLHsDoc haddock_doc
192 return (HsDocTy ty' haddock_doc')
194 rnLHsTypes doc tys = mapM (rnLHsType doc) tys
199 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
200 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
202 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
203 -- One reason for this case is that a type like Int#
204 -- starts off as (HsForAllTy Nothing [] Int), in case
205 -- there is some quantification. Now that we have quantified
206 -- and discovered there are no type variables, it's nicer to turn
207 -- it into plain Int. If it were Int# instead of Int, we'd actually
208 -- get an error, because the body of a genuine for-all is
211 rnForAll doc exp forall_tyvars ctxt ty
212 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars -> do
213 new_ctxt <- rnContext doc ctxt
214 new_ty <- rnLHsType doc ty
215 return (HsForAllTy exp new_tyvars new_ctxt new_ty)
216 -- Retain the same implicit/explicit flag as before
217 -- so that we can later print it correctly
220 %*********************************************************
222 \subsection{Contexts and predicates}
224 %*********************************************************
227 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
228 rnContext doc = wrapLocM (rnContext' doc)
230 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
231 rnContext' doc ctxt = mapM (rnLPred doc) ctxt
233 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
234 rnLPred doc = wrapLocM (rnPred doc)
236 rnPred doc (HsClassP clas tys)
237 = do { clas_name <- lookupOccRn clas
238 ; tys' <- rnLHsTypes doc tys
239 ; return (HsClassP clas_name tys')
241 rnPred doc (HsEqualP ty1 ty2)
242 = do { ty1' <- rnLHsType doc ty1
243 ; ty2' <- rnLHsType doc ty2
244 ; return (HsEqualP ty1' ty2')
246 rnPred doc (HsIParam n ty)
247 = do { name <- newIPNameRn n
248 ; ty' <- rnLHsType doc ty
249 ; return (HsIParam name ty')
254 %************************************************************************
256 Fixities and precedence parsing
258 %************************************************************************
260 @mkOpAppRn@ deals with operator fixities. The argument expressions
261 are assumed to be already correctly arranged. It needs the fixities
262 recorded in the OpApp nodes, because fixity info applies to the things
263 the programmer actually wrote, so you can't find it out from the Name.
265 Furthermore, the second argument is guaranteed not to be another
266 operator application. Why? Because the parser parses all
267 operator appications left-associatively, EXCEPT negation, which
268 we need to handle specially.
269 Infix types are read in a *right-associative* way, so that
274 mkHsOpTyRn rearranges where necessary. The two arguments
275 have already been renamed and rearranged. It's made rather tiresome
276 by the presence of ->, which is a separate syntactic construct.
280 -- Building (ty1 `op1` (ty21 `op2` ty22))
281 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
282 -> SDoc -> Fixity -> LHsType Name -> LHsType Name
285 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
286 = do { fix2 <- lookupTyFixityRn op2
287 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
288 (\t1 t2 -> HsOpTy t1 op2 t2)
289 (ppr op2) fix2 ty21 ty22 loc2 }
291 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
292 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
293 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
295 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 -- Default case, no rearrangment
296 = return (mk1 ty1 ty2)
299 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
300 -> SDoc -> Fixity -> LHsType Name
301 -> (LHsType Name -> LHsType Name -> HsType Name)
302 -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
304 mk_hs_op_ty mk1 pp_op1 fix1 ty1
305 mk2 pp_op2 fix2 ty21 ty22 loc2
306 | nofix_error = do { addErr (precParseErr (quotes pp_op1,fix1)
307 (quotes pp_op2,fix2))
308 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
309 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
310 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
311 new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
312 ; return (mk2 (noLoc new_ty) ty22) }
314 (nofix_error, associate_right) = compareFixity fix1 fix2
317 ---------------------------
318 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
319 -> LHsExpr Name -> Fixity -- Operator and fixity
320 -> LHsExpr Name -- Right operand (not an OpApp, but might
324 -- (e11 `op1` e12) `op2` e2
325 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
327 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
328 return (OpApp e1 op2 fix2 e2)
330 | associate_right = do
331 new_e <- mkOpAppRn e12 op2 fix2 e2
332 return (OpApp e11 op1 fix1 (L loc' new_e))
334 loc'= combineLocs e12 e2
335 (nofix_error, associate_right) = compareFixity fix1 fix2
337 ---------------------------
338 -- (- neg_arg) `op` e2
339 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
341 addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2))
342 return (OpApp e1 op2 fix2 e2)
344 | associate_right = do
345 new_e <- mkOpAppRn neg_arg op2 fix2 e2
346 return (NegApp (L loc' new_e) neg_name)
348 loc' = combineLocs neg_arg e2
349 (nofix_error, associate_right) = compareFixity negateFixity fix2
351 ---------------------------
353 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right
354 | not associate_right= do -- We *want* right association
355 addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity))
356 return (OpApp e1 op1 fix1 e2)
358 (_, associate_right) = compareFixity fix1 negateFixity
360 ---------------------------
362 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
363 = ASSERT2( right_op_ok fix (unLoc e2),
364 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
366 return (OpApp e1 op fix e2)
368 -- Parser left-associates everything, but
369 -- derived instances may have correctly-associated things to
370 -- in the right operarand. So we just check that the right operand is OK
371 right_op_ok fix1 (OpApp _ _ fix2 _)
372 = not error_please && associate_right
374 (error_please, associate_right) = compareFixity fix1 fix2
375 right_op_ok fix1 other
378 -- Parser initially makes negation bind more tightly than any other operator
379 -- And "deriving" code should respect this (use HsPar if not)
380 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
381 mkNegAppRn neg_arg neg_name
382 = ASSERT( not_op_app (unLoc neg_arg) )
383 return (NegApp neg_arg neg_name)
385 not_op_app (OpApp _ _ _ _) = False
386 not_op_app other = True
388 ---------------------------
389 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
390 -> LHsExpr Name -> Fixity -- Operator and fixity
391 -> LHsCmdTop Name -- Right operand (not an infix)
394 -- (e11 `op1` e12) `op2` e2
395 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
398 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
399 return (HsArrForm op2 (Just fix2) [a1, a2])
401 | associate_right = do
402 new_c <- mkOpFormRn a12 op2 fix2 a2
403 return (HsArrForm op1 (Just fix1)
404 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
405 -- TODO: locs are wrong
407 (nofix_error, associate_right) = compareFixity fix1 fix2
410 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
411 = return (HsArrForm op (Just fix) [arg1, arg2])
414 --------------------------------------
415 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
418 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
419 = do { fix1 <- lookupFixityRn (unLoc op1)
420 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
422 ; if nofix_error then do
423 { addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
424 ; return (ConPatIn op2 (InfixCon p1 p2)) }
426 else if associate_right then do
427 { new_p <- mkConOpPatRn op2 fix2 p12 p2
428 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
429 else return (ConPatIn op2 (InfixCon p1 p2)) }
431 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
432 = ASSERT( not_op_pat (unLoc p2) )
433 return (ConPatIn op (InfixCon p1 p2))
435 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
436 not_op_pat other = True
438 --------------------------------------
439 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
440 -- True indicates an infix lhs
441 -- See comments with rnExpr (OpApp ...) about "deriving"
443 checkPrecMatch False fn match
445 checkPrecMatch True op (MatchGroup ms _)
448 check (L _ (Match (p1:p2:_) _ _))
449 = do checkPrec op (unLoc p1) False
450 checkPrec op (unLoc p2) True
453 -- This can happen. Consider
456 -- The infix flag comes from the first binding of the group
457 -- but the second eqn has no args (an error, but not discovered
458 -- until the type checker). So we don't want to crash on the
461 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
462 op_fix@(Fixity op_prec op_dir) <- lookupFixityRn op
463 op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
465 inf_ok = op1_prec > op_prec ||
466 (op1_prec == op_prec &&
467 (op1_dir == InfixR && op_dir == InfixR && right ||
468 op1_dir == InfixL && op_dir == InfixL && not right))
470 info = (ppr_op op, op_fix)
471 info1 = (ppr_op op1, op1_fix)
472 (infol, infor) = if right then (info, info1) else (info1, info)
474 checkErr inf_ok (precParseErr infol infor)
476 checkPrec op pat right
479 -- Check precedence of (arg op) or (op arg) respectively
480 -- If arg is itself an operator application, then either
481 -- (a) its precedence must be higher than that of op
482 -- (b) its precedency & associativity must be the same as that of op
483 checkSectionPrec :: FixityDirection -> HsExpr RdrName
484 -> LHsExpr Name -> LHsExpr Name -> RnM ()
485 checkSectionPrec direction section op arg
487 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
488 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
491 L _ (HsVar op_name) = op
492 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc) = do
493 op_fix@(Fixity op_prec _) <- lookupFixityRn op_name
494 checkErr (op_prec < arg_prec
495 || op_prec == arg_prec && direction == assoc)
496 (sectionPrecErr (ppr_op op_name, op_fix)
497 (pp_arg_op, arg_fix) section)
500 Precedence-related error messages
504 = hang (ptext SLIT("precedence parsing error"))
505 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
507 ptext SLIT("in the same infix expression")])
509 sectionPrecErr op arg_op section
510 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
511 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
512 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
514 pp_prefix_minus = ptext SLIT("prefix `-'")
515 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
516 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
519 %*********************************************************
523 %*********************************************************
526 forAllWarn doc ty (L loc tyvar)
527 = ifOptM Opt_WarnUnusedMatches $
528 addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
529 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
533 opTyErr op ty@(HsOpTy ty1 _ ty2)
534 = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
537 extra | op == dot_tv_RDR && forall_head ty1
538 = ptext SLIT("Perhaps you intended to use -XRankNTypes or similar flag")
540 = ptext SLIT("Use -XTypeOperators to allow operators in types")
542 forall_head (L _ (HsTyVar tv)) = tv == forall_tv_RDR
543 forall_head (L _ (HsAppTy ty _)) = forall_head ty
544 forall_head _other = False