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 )
31 import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
32 lookupLocatedOccRn, lookupLocatedBndrRn,
33 lookupLocatedGlobalOccRn, bindTyVarsRn,
34 lookupFixityRn, lookupTyFixityRn, lookupConstructorFields,
35 lookupRecordBndr, mapFvRn,
36 newIPNameRn, bindPatSigTyVarsFV)
39 import PrelNames ( eqClassName, integralClassName, geName, eqName,
40 negateName, minusName, lengthPName, indexPName,
41 plusIntegerName, fromIntegerName, timesIntegerName,
42 ratioDataConName, fromRationalName, fromStringName )
43 import TypeRep ( funTyCon )
44 import Constants ( mAX_TUPLE_SIZE )
49 import Literal ( inIntRange, inCharRange )
50 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
51 Fixity(..), FixityDirection(..) )
52 import ListSetOps ( removeDups, minusList )
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_TypeOperators
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 rnHsType doc (HsDocTy ty haddock_doc)
192 = rnLHsType doc ty `thenM` \ ty' ->
193 rnLHsDoc haddock_doc `thenM` \ haddock_doc' ->
194 returnM (HsDocTy ty' haddock_doc')
196 rnLHsTypes doc tys = mappM (rnLHsType doc) tys
201 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
202 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
204 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
205 -- One reason for this case is that a type like Int#
206 -- starts off as (HsForAllTy Nothing [] Int), in case
207 -- there is some quantification. Now that we have quantified
208 -- and discovered there are no type variables, it's nicer to turn
209 -- it into plain Int. If it were Int# instead of Int, we'd actually
210 -- get an error, because the body of a genuine for-all is
213 rnForAll doc exp forall_tyvars ctxt ty
214 = bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
215 rnContext doc ctxt `thenM` \ new_ctxt ->
216 rnLHsType doc ty `thenM` \ new_ty ->
217 returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
218 -- Retain the same implicit/explicit flag as before
219 -- so that we can later print it correctly
222 %*********************************************************
224 \subsection{Contexts and predicates}
226 %*********************************************************
229 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
230 rnContext doc = wrapLocM (rnContext' doc)
232 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
233 rnContext' doc ctxt = mappM (rnLPred doc) ctxt
235 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
236 rnLPred doc = wrapLocM (rnPred doc)
238 rnPred doc (HsClassP clas tys)
239 = do { clas_name <- lookupOccRn clas
240 ; tys' <- rnLHsTypes doc tys
241 ; returnM (HsClassP clas_name tys')
243 rnPred doc (HsEqualP ty1 ty2)
244 = do { ty1' <- rnLHsType doc ty1
245 ; ty2' <- rnLHsType doc ty2
246 ; returnM (HsEqualP ty1' ty2')
248 rnPred doc (HsIParam n ty)
249 = do { name <- newIPNameRn n
250 ; ty' <- rnLHsType doc ty
251 ; returnM (HsIParam name ty')
256 %************************************************************************
258 Fixities and precedence parsing
260 %************************************************************************
262 @mkOpAppRn@ deals with operator fixities. The argument expressions
263 are assumed to be already correctly arranged. It needs the fixities
264 recorded in the OpApp nodes, because fixity info applies to the things
265 the programmer actually wrote, so you can't find it out from the Name.
267 Furthermore, the second argument is guaranteed not to be another
268 operator application. Why? Because the parser parses all
269 operator appications left-associatively, EXCEPT negation, which
270 we need to handle specially.
271 Infix types are read in a *right-associative* way, so that
276 mkHsOpTyRn rearranges where necessary. The two arguments
277 have already been renamed and rearranged. It's made rather tiresome
278 by the presence of ->, which is a separate syntactic construct.
282 -- Building (ty1 `op1` (ty21 `op2` ty22))
283 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
284 -> SDoc -> Fixity -> LHsType Name -> LHsType Name
287 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
288 = do { fix2 <- lookupTyFixityRn op2
289 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
290 (\t1 t2 -> HsOpTy t1 op2 t2)
291 (ppr op2) fix2 ty21 ty22 loc2 }
293 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
294 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
295 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
297 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 -- Default case, no rearrangment
298 = return (mk1 ty1 ty2)
301 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
302 -> SDoc -> Fixity -> LHsType Name
303 -> (LHsType Name -> LHsType Name -> HsType Name)
304 -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
306 mk_hs_op_ty mk1 pp_op1 fix1 ty1
307 mk2 pp_op2 fix2 ty21 ty22 loc2
308 | nofix_error = do { addErr (precParseErr (quotes pp_op1,fix1)
309 (quotes pp_op2,fix2))
310 ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
311 | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
312 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
313 new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
314 ; return (mk2 (noLoc new_ty) ty22) }
316 (nofix_error, associate_right) = compareFixity fix1 fix2
319 ---------------------------
320 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
321 -> LHsExpr Name -> Fixity -- Operator and fixity
322 -> LHsExpr Name -- Right operand (not an OpApp, but might
326 -- (e11 `op1` e12) `op2` e2
327 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
329 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
330 returnM (OpApp e1 op2 fix2 e2)
333 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
334 returnM (OpApp e11 op1 fix1 (L loc' new_e))
336 loc'= combineLocs e12 e2
337 (nofix_error, associate_right) = compareFixity fix1 fix2
339 ---------------------------
340 -- (- neg_arg) `op` e2
341 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
343 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
344 returnM (OpApp e1 op2 fix2 e2)
347 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
348 returnM (NegApp (L loc' new_e) neg_name)
350 loc' = combineLocs neg_arg e2
351 (nofix_error, associate_right) = compareFixity negateFixity fix2
353 ---------------------------
355 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right
356 | not associate_right -- We *want* right association
357 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
358 returnM (OpApp e1 op1 fix1 e2)
360 (_, associate_right) = compareFixity fix1 negateFixity
362 ---------------------------
364 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
365 = ASSERT2( right_op_ok fix (unLoc e2),
366 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
368 returnM (OpApp e1 op fix e2)
370 -- Parser left-associates everything, but
371 -- derived instances may have correctly-associated things to
372 -- in the right operarand. So we just check that the right operand is OK
373 right_op_ok fix1 (OpApp _ _ fix2 _)
374 = not error_please && associate_right
376 (error_please, associate_right) = compareFixity fix1 fix2
377 right_op_ok fix1 other
380 -- Parser initially makes negation bind more tightly than any other operator
381 -- And "deriving" code should respect this (use HsPar if not)
382 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
383 mkNegAppRn neg_arg neg_name
384 = ASSERT( not_op_app (unLoc neg_arg) )
385 returnM (NegApp neg_arg neg_name)
387 not_op_app (OpApp _ _ _ _) = False
388 not_op_app other = True
390 ---------------------------
391 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
392 -> LHsExpr Name -> Fixity -- Operator and fixity
393 -> LHsCmdTop Name -- Right operand (not an infix)
396 -- (e11 `op1` e12) `op2` e2
397 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
400 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
401 returnM (HsArrForm op2 (Just fix2) [a1, a2])
404 = mkOpFormRn a12 op2 fix2 a2 `thenM` \ new_c ->
405 returnM (HsArrForm op1 (Just fix1)
406 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
407 -- TODO: locs are wrong
409 (nofix_error, associate_right) = compareFixity fix1 fix2
412 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
413 = returnM (HsArrForm op (Just fix) [arg1, arg2])
416 --------------------------------------
417 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
420 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
421 = do { fix1 <- lookupFixityRn (unLoc op1)
422 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
424 ; if nofix_error then do
425 { addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
426 ; return (ConPatIn op2 (InfixCon p1 p2)) }
428 else if associate_right then do
429 { new_p <- mkConOpPatRn op2 fix2 p12 p2
430 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
431 else return (ConPatIn op2 (InfixCon p1 p2)) }
433 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
434 = ASSERT( not_op_pat (unLoc p2) )
435 returnM (ConPatIn op (InfixCon p1 p2))
437 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
438 not_op_pat other = True
440 --------------------------------------
441 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
442 -- True indicates an infix lhs
443 -- See comments with rnExpr (OpApp ...) about "deriving"
445 checkPrecMatch False fn match
447 checkPrecMatch True op (MatchGroup ms _)
450 check (L _ (Match (p1:p2:_) _ _))
451 = checkPrec op (unLoc p1) False `thenM_`
452 checkPrec op (unLoc p2) True
455 -- This can happen. Consider
458 -- The infix flag comes from the first binding of the group
459 -- but the second eqn has no args (an error, but not discovered
460 -- until the type checker). So we don't want to crash on the
463 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
464 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
465 lookupFixityRn (unLoc op1) `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
467 inf_ok = op1_prec > op_prec ||
468 (op1_prec == op_prec &&
469 (op1_dir == InfixR && op_dir == InfixR && right ||
470 op1_dir == InfixL && op_dir == InfixL && not right))
472 info = (ppr_op op, op_fix)
473 info1 = (ppr_op op1, op1_fix)
474 (infol, infor) = if right then (info, info1) else (info1, info)
476 checkErr inf_ok (precParseErr infol infor)
478 checkPrec op pat right
481 -- Check precedence of (arg op) or (op arg) respectively
482 -- If arg is itself an operator application, then either
483 -- (a) its precedence must be higher than that of op
484 -- (b) its precedency & associativity must be the same as that of op
485 checkSectionPrec :: FixityDirection -> HsExpr RdrName
486 -> LHsExpr Name -> LHsExpr Name -> RnM ()
487 checkSectionPrec direction section op arg
489 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
490 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
493 L _ (HsVar op_name) = op
494 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
495 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
496 checkErr (op_prec < arg_prec
497 || op_prec == arg_prec && direction == assoc)
498 (sectionPrecErr (ppr_op op_name, op_fix)
499 (pp_arg_op, arg_fix) section)
502 Precedence-related error messages
506 = hang (ptext SLIT("precedence parsing error"))
507 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
509 ptext SLIT("in the same infix expression")])
511 sectionPrecErr op arg_op section
512 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
513 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
514 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
516 pp_prefix_minus = ptext SLIT("prefix `-'")
517 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
518 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
521 %*********************************************************
525 %*********************************************************
528 forAllWarn doc ty (L loc tyvar)
529 = ifOptM Opt_WarnUnusedMatches $
530 addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
531 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
536 = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
537 2 (parens (ptext SLIT("Use -XTypeOperators to allow operators in types")))