2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnExpr]{Renaming of expressions}
6 Basically dependency analysis.
8 Handles @Match@, @GRHSsAndBinds@, @HsExpr@, and @Qualifier@ datatypes. In
9 general, all of these functions return a renamed thing, and a set of
13 #include "HsVersions.h"
16 rnMatch, rnGRHSsAndBinds, rnPat,
21 IMPORT_DELOOPER(RnLoop) -- break the RnPass/RnExpr/RnBinds loops
28 import CmdLineOpts ( opt_GlasgowExts )
29 import BasicTypes ( Fixity(..), FixityDirection(..) )
30 import PrelInfo ( numClass_RDR, fractionalClass_RDR, eqClass_RDR, ccallableClass_RDR,
31 creturnableClass_RDR, monadZeroClass_RDR, enumClass_RDR, ordClass_RDR,
32 ratioDataCon_RDR, negate_RDR
34 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
35 floatPrimTyCon, doublePrimTyCon
37 import TyCon ( TyCon )
39 import ErrUtils ( addErrLoc, addShortErrLocLine )
42 import UniqFM ( lookupUFM{-, ufmToList ToDo:rm-} )
43 import UniqSet ( emptyUniqSet, unitUniqSet,
44 unionUniqSets, unionManyUniqSets,
47 import Util ( Ord3(..), removeDups, panic, pprPanic, assertPanic )
53 *********************************************************
57 *********************************************************
60 rnPat :: RdrNamePat -> RnMS s RenamedPat
62 rnPat WildPatIn = returnRn WildPatIn
65 = lookupBndrRn name `thenRn` \ vname ->
66 returnRn (VarPatIn vname)
69 = litOccurrence lit `thenRn_`
70 lookupImplicitOccRn eqClass_RDR `thenRn_` -- Needed to find equality on pattern
71 returnRn (LitPatIn lit)
74 = rnPat pat `thenRn` \ pat' ->
75 returnRn (LazyPatIn pat')
77 rnPat (AsPatIn name pat)
78 = rnPat pat `thenRn` \ pat' ->
79 lookupBndrRn name `thenRn` \ vname ->
80 returnRn (AsPatIn vname pat')
82 rnPat (ConPatIn con pats)
83 = lookupOccRn con `thenRn` \ con' ->
84 mapRn rnPat pats `thenRn` \ patslist ->
85 returnRn (ConPatIn con' patslist)
87 rnPat (ConOpPatIn pat1 con _ pat2)
88 = rnPat pat1 `thenRn` \ pat1' ->
89 lookupOccRn con `thenRn` \ con' ->
90 lookupFixity con `thenRn` \ fixity ->
91 rnPat pat2 `thenRn` \ pat2' ->
92 mkConOpPatRn pat1' con' fixity pat2'
94 -- Negated patters can only be literals, and they are dealt with
95 -- by negating the literal at compile time, not by using the negation
96 -- operation in Num. So we don't need to make an implicit reference
98 rnPat neg@(NegPatIn pat)
99 = checkRn (valid_neg_pat pat) (negPatErr neg)
101 rnPat pat `thenRn` \ pat' ->
102 returnRn (NegPatIn pat')
104 valid_neg_pat (LitPatIn (HsInt _)) = True
105 valid_neg_pat (LitPatIn (HsFrac _)) = True
106 valid_neg_pat _ = False
109 = rnPat pat `thenRn` \ pat' ->
110 returnRn (ParPatIn pat')
112 rnPat (NPlusKPatIn name lit)
113 = litOccurrence lit `thenRn_`
114 lookupImplicitOccRn ordClass_RDR `thenRn_`
115 lookupBndrRn name `thenRn` \ name' ->
116 returnRn (NPlusKPatIn name' lit)
118 rnPat (ListPatIn pats)
119 = addImplicitOccRn listType_name `thenRn_`
120 mapRn rnPat pats `thenRn` \ patslist ->
121 returnRn (ListPatIn patslist)
123 rnPat (TuplePatIn pats)
124 = addImplicitOccRn (tupleType_name (length pats)) `thenRn_`
125 mapRn rnPat pats `thenRn` \ patslist ->
126 returnRn (TuplePatIn patslist)
128 rnPat (RecPatIn con rpats)
129 = lookupOccRn con `thenRn` \ con' ->
130 rnRpats rpats `thenRn` \ rpats' ->
131 returnRn (RecPatIn con' rpats')
134 ************************************************************************
138 ************************************************************************
141 rnMatch :: RdrNameMatch -> RnMS s (RenamedMatch, FreeVars)
143 rnMatch (PatMatch pat match)
144 = bindLocalsRn "pattern" binders $ \ new_binders ->
145 rnPat pat `thenRn` \ pat' ->
146 rnMatch match `thenRn` \ (match', fvMatch) ->
147 returnRn (PatMatch pat' match', fvMatch `minusNameSet` mkNameSet new_binders)
149 binders = collectPatBinders pat
151 rnMatch (GRHSMatch grhss_and_binds)
152 = rnGRHSsAndBinds grhss_and_binds `thenRn` \ (grhss_and_binds', fvs) ->
153 returnRn (GRHSMatch grhss_and_binds', fvs)
156 %************************************************************************
158 \subsubsection{Guarded right-hand sides (GRHSsAndBinds)}
160 %************************************************************************
163 rnGRHSsAndBinds :: RdrNameGRHSsAndBinds -> RnMS s (RenamedGRHSsAndBinds, FreeVars)
165 rnGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
166 = rnBinds binds $ \ binds' ->
167 rnGRHSs grhss `thenRn` \ (grhss', fvGRHS) ->
168 returnRn (GRHSsAndBindsIn grhss' binds', fvGRHS)
170 rnGRHSs [] = returnRn ([], emptyNameSet)
173 = rnGRHS grhs `thenRn` \ (grhs', fvs) ->
174 rnGRHSs grhss `thenRn` \ (grhss', fvss) ->
175 returnRn (grhs' : grhss', fvs `unionNameSets` fvss)
177 rnGRHS (GRHS guard expr locn)
178 = pushSrcLocRn locn $
179 (if not (opt_GlasgowExts || is_standard_guard guard) then
180 addWarnRn (nonStdGuardErr guard)
185 (rnStmts rnExpr guard $ \ guard' ->
186 -- This nested thing deals with scope and
187 -- the free vars of the guard, and knocking off the
188 -- free vars of the rhs that are bound by the guard
190 rnExpr expr `thenRn` \ (expr', fvse) ->
191 returnRn (GRHS guard' expr' locn, fvse))
193 rnGRHS (OtherwiseGRHS expr locn)
194 = pushSrcLocRn locn $
195 rnExpr expr `thenRn` \ (expr', fvs) ->
196 returnRn (GRHS [] expr' locn, fvs)
198 -- Standard Haskell 1.4 guards are just a single boolean
199 -- expression, rather than a list of qualifiers as in the
201 is_standard_guard [GuardStmt _ _] = True
202 is_standard_guard other = False
205 %************************************************************************
207 \subsubsection{Expressions}
209 %************************************************************************
212 rnExprs :: [RdrNameHsExpr] -> RnMS s ([RenamedHsExpr], FreeVars)
214 rnExprs' ls [] `thenRn` \ (exprs, fvExprs) ->
215 returnRn (exprs, unionManyNameSets fvExprs)
217 rnExprs' [] acc = returnRn ([], acc)
218 rnExprs' (expr:exprs) acc
219 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
220 rnExprs' exprs (fvExpr:acc) `thenRn` \ (exprs', fvExprs) ->
221 returnRn (expr':exprs', fvExprs)
224 Variables. We look up the variable and return the resulting name. The
225 interesting question is what the free-variable set should be. We
226 don't want to return imported or prelude things as free vars. So we
227 look at the Name returned from the lookup, and make it part of the
228 free-var set iff if it's a LocallyDefined Name.
232 rnExpr :: RdrNameHsExpr -> RnMS s (RenamedHsExpr, FreeVars)
235 = lookupOccRn v `thenRn` \ vname ->
236 returnRn (HsVar vname, if isLocallyDefined vname
237 then unitNameSet vname
241 = litOccurrence lit `thenRn_`
242 returnRn (HsLit lit, emptyNameSet)
245 = rnMatch match `thenRn` \ (match', fvMatch) ->
246 returnRn (HsLam match', fvMatch)
248 rnExpr (HsApp fun arg)
249 = rnExpr fun `thenRn` \ (fun',fvFun) ->
250 rnExpr arg `thenRn` \ (arg',fvArg) ->
251 returnRn (HsApp fun' arg', fvFun `unionNameSets` fvArg)
253 rnExpr (OpApp e1 op@(HsVar op_name) _ e2)
254 = rnExpr e1 `thenRn` \ (e1', fv_e1) ->
255 rnExpr e2 `thenRn` \ (e2', fv_e2) ->
256 rnExpr op `thenRn` \ (op', fv_op) ->
259 -- When renaming code synthesised from "deriving" declarations
260 -- we're in Interface mode, and we should ignore fixity; assume
261 -- that the deriving code generator got the association correct
262 lookupFixity op_name `thenRn` \ fixity ->
263 getModeRn `thenRn` \ mode ->
265 SourceMode -> mkOpAppRn e1' op' fixity e2'
266 InterfaceMode _ -> returnRn (OpApp e1' op' fixity e2')
267 ) `thenRn` \ final_e ->
270 fv_e1 `unionNameSets` fv_op `unionNameSets` fv_e2)
273 = rnExpr e `thenRn` \ (e', fv_e) ->
274 lookupImplicitOccRn negate_RDR `thenRn` \ neg ->
275 mkNegAppRn e' (HsVar neg) `thenRn` \ final_e ->
276 returnRn (final_e, fv_e)
279 = rnExpr e `thenRn` \ (e', fvs_e) ->
280 returnRn (HsPar e', fvs_e)
282 rnExpr (SectionL expr op)
283 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
284 rnExpr op `thenRn` \ (op', fvs_op) ->
285 returnRn (SectionL expr' op', fvs_op `unionNameSets` fvs_expr)
287 rnExpr (SectionR op expr)
288 = rnExpr op `thenRn` \ (op', fvs_op) ->
289 rnExpr expr `thenRn` \ (expr', fvs_expr) ->
290 returnRn (SectionR op' expr', fvs_op `unionNameSets` fvs_expr)
292 rnExpr (CCall fun args may_gc is_casm fake_result_ty)
293 = lookupImplicitOccRn ccallableClass_RDR `thenRn_`
294 lookupImplicitOccRn creturnableClass_RDR `thenRn_`
295 rnExprs args `thenRn` \ (args', fvs_args) ->
296 returnRn (CCall fun args' may_gc is_casm fake_result_ty, fvs_args)
298 rnExpr (HsSCC label expr)
299 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
300 returnRn (HsSCC label expr', fvs_expr)
302 rnExpr (HsCase expr ms src_loc)
303 = pushSrcLocRn src_loc $
304 rnExpr expr `thenRn` \ (new_expr, e_fvs) ->
305 mapAndUnzipRn rnMatch ms `thenRn` \ (new_ms, ms_fvs) ->
306 returnRn (HsCase new_expr new_ms src_loc, unionManyNameSets (e_fvs : ms_fvs))
308 rnExpr (HsLet binds expr)
309 = rnBinds binds $ \ binds' ->
310 rnExpr expr `thenRn` \ (expr',fvExpr) ->
311 returnRn (HsLet binds' expr', fvExpr)
313 rnExpr (HsDo do_or_lc stmts src_loc)
314 = pushSrcLocRn src_loc $
315 lookupImplicitOccRn monadZeroClass_RDR `thenRn_` -- Forces Monad to come too
316 (rnStmts rnExpr stmts $ \ stmts' ->
317 returnRn (HsDo do_or_lc stmts' src_loc, emptyNameSet))
319 rnExpr (ExplicitList exps)
320 = addImplicitOccRn listType_name `thenRn_`
321 rnExprs exps `thenRn` \ (exps', fvs) ->
322 returnRn (ExplicitList exps', fvs)
324 rnExpr (ExplicitTuple exps)
325 = addImplicitOccRn (tupleType_name (length exps)) `thenRn_`
326 rnExprs exps `thenRn` \ (exps', fvExps) ->
327 returnRn (ExplicitTuple exps', fvExps)
329 rnExpr (RecordCon (HsVar con) rbinds)
330 = lookupOccRn con `thenRn` \ conname ->
331 rnRbinds "construction" rbinds `thenRn` \ (rbinds', fvRbinds) ->
332 returnRn (RecordCon (HsVar conname) rbinds', fvRbinds)
334 rnExpr (RecordUpd expr rbinds)
335 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
336 rnRbinds "update" rbinds `thenRn` \ (rbinds', fvRbinds) ->
337 returnRn (RecordUpd expr' rbinds', fvExpr `unionNameSets` fvRbinds)
339 rnExpr (ExprWithTySig expr pty)
340 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
341 rnHsSigType (\ sty -> text "an expression") pty `thenRn` \ pty' ->
342 returnRn (ExprWithTySig expr' pty', fvExpr)
344 rnExpr (HsIf p b1 b2 src_loc)
345 = pushSrcLocRn src_loc $
346 rnExpr p `thenRn` \ (p', fvP) ->
347 rnExpr b1 `thenRn` \ (b1', fvB1) ->
348 rnExpr b2 `thenRn` \ (b2', fvB2) ->
349 returnRn (HsIf p' b1' b2' src_loc, unionManyNameSets [fvP, fvB1, fvB2])
351 rnExpr (ArithSeqIn seq)
352 = lookupImplicitOccRn enumClass_RDR `thenRn_`
353 rn_seq seq `thenRn` \ (new_seq, fvs) ->
354 returnRn (ArithSeqIn new_seq, fvs)
357 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
358 returnRn (From expr', fvExpr)
360 rn_seq (FromThen expr1 expr2)
361 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
362 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
363 returnRn (FromThen expr1' expr2', fvExpr1 `unionNameSets` fvExpr2)
365 rn_seq (FromTo expr1 expr2)
366 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
367 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
368 returnRn (FromTo expr1' expr2', fvExpr1 `unionNameSets` fvExpr2)
370 rn_seq (FromThenTo expr1 expr2 expr3)
371 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
372 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
373 rnExpr expr3 `thenRn` \ (expr3', fvExpr3) ->
374 returnRn (FromThenTo expr1' expr2' expr3',
375 unionManyNameSets [fvExpr1, fvExpr2, fvExpr3])
378 %************************************************************************
380 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
382 %************************************************************************
386 = mapRn field_dup_err dup_fields `thenRn_`
387 mapAndUnzipRn rn_rbind rbinds `thenRn` \ (rbinds', fvRbind_s) ->
388 returnRn (rbinds', unionManyNameSets fvRbind_s)
390 (_, dup_fields) = removeDups cmp [ f | (f,_,_) <- rbinds ]
392 field_dup_err dups = addErrRn (dupFieldErr str dups)
394 rn_rbind (field, expr, pun)
395 = lookupGlobalOccRn field `thenRn` \ fieldname ->
396 rnExpr expr `thenRn` \ (expr', fvExpr) ->
397 returnRn ((fieldname, expr', pun), fvExpr)
400 = mapRn field_dup_err dup_fields `thenRn_`
403 (_, dup_fields) = removeDups cmp [ f | (f,_,_) <- rpats ]
405 field_dup_err dups = addErrRn (dupFieldErr "pattern" dups)
407 rn_rpat (field, pat, pun)
408 = lookupGlobalOccRn field `thenRn` \ fieldname ->
409 rnPat pat `thenRn` \ pat' ->
410 returnRn (fieldname, pat', pun)
413 %************************************************************************
415 \subsubsection{@Stmt@s: in @do@ expressions}
417 %************************************************************************
419 Note that although some bound vars may appear in the free var set for
420 the first qual, these will eventually be removed by the caller. For
421 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
422 @[q <- r, p <- q]@, the free var set for @q <- r@ will
423 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
424 @r@ will be removed only when we finally return from examining all the
428 type RnExprTy s = RdrNameHsExpr -> RnMS s (RenamedHsExpr, FreeVars)
430 rnStmts :: RnExprTy s
432 -> ([RenamedStmt] -> RnMS s (a, FreeVars))
433 -> RnMS s (a, FreeVars)
435 rnStmts rn_expr [] thing_inside
438 rnStmts rn_expr (stmt:stmts) thing_inside
439 = rnStmt rn_expr stmt $ \ stmt' ->
440 rnStmts rn_expr stmts $ \ stmts' ->
441 thing_inside (stmt' : stmts')
443 rnStmt :: RnExprTy s -> RdrNameStmt -> (RenamedStmt -> RnMS s (a, FreeVars)) -> RnMS s (a, FreeVars)
444 -- Because of mutual recursion we have to pass in rnExpr.
446 rnStmt rn_expr (BindStmt pat expr src_loc) thing_inside
447 = pushSrcLocRn src_loc $
448 rn_expr expr `thenRn` \ (expr', fv_expr) ->
449 bindLocalsRn "pattern in do binding" binders $ \ new_binders ->
450 rnPat pat `thenRn` \ pat' ->
452 thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ (result, fvs) ->
453 returnRn (result, fv_expr `unionNameSets` (fvs `minusNameSet` mkNameSet new_binders))
455 binders = collectPatBinders pat
457 rnStmt rn_expr (ExprStmt expr src_loc) thing_inside
458 = pushSrcLocRn src_loc $
459 rn_expr expr `thenRn` \ (expr', fv_expr) ->
460 thing_inside (ExprStmt expr' src_loc) `thenRn` \ (result, fvs) ->
461 returnRn (result, fv_expr `unionNameSets` fvs)
463 rnStmt rn_expr (GuardStmt expr src_loc) thing_inside
464 = pushSrcLocRn src_loc $
465 rn_expr expr `thenRn` \ (expr', fv_expr) ->
466 thing_inside (GuardStmt expr' src_loc) `thenRn` \ (result, fvs) ->
467 returnRn (result, fv_expr `unionNameSets` fvs)
469 rnStmt rn_expr (ReturnStmt expr) thing_inside
470 = rn_expr expr `thenRn` \ (expr', fv_expr) ->
471 thing_inside (ReturnStmt expr') `thenRn` \ (result, fvs) ->
472 returnRn (result, fv_expr `unionNameSets` fvs)
474 rnStmt rn_expr (LetStmt binds) thing_inside
475 = rnBinds binds $ \ binds' ->
476 thing_inside (LetStmt binds')
479 %************************************************************************
481 \subsubsection{Precedence Parsing}
483 %************************************************************************
485 @mkOpAppRn@ deals with operator fixities. The argument expressions
486 are assumed to be already correctly arranged. It needs the fixities
487 recorded in the OpApp nodes, because fixity info applies to the things
488 the programmer actually wrote, so you can't find it out from the Name.
490 Furthermore, the second argument is guaranteed not to be another
491 operator application. Why? Because the parser parses all
492 operator appications left-associatively.
495 mkOpAppRn :: RenamedHsExpr -> RenamedHsExpr -> Fixity -> RenamedHsExpr
496 -> RnMS s RenamedHsExpr
498 mkOpAppRn e1@(OpApp e11 op1 fix1 e12)
501 = addErrRn (precParseErr (get op1,fix1) (get op2,fix2)) `thenRn_`
502 returnRn (OpApp e1 op2 fix2 e2)
505 = mkOpAppRn e12 op2 fix2 e2 `thenRn` \ new_e ->
506 returnRn (OpApp e11 op1 fix1 new_e)
508 (nofix_error, rearrange_me) = compareFixity fix1 fix2
510 mkOpAppRn e1@(NegApp neg_arg neg_op)
512 fix2@(Fixity prec2 dir2)
515 = addErrRn (precParseErr (get neg_op,fix_neg) (get op2,fix2)) `thenRn_`
516 returnRn (OpApp e1 op2 fix2 e2)
519 = mkOpAppRn neg_arg op2 fix2 e2 `thenRn` \ new_e ->
520 returnRn (NegApp new_e neg_op)
522 fix_neg = Fixity 6 InfixL -- Precedence of unary negate is wired in as infixl 6!
523 (nofix_error, rearrange_me) = compareFixity fix_neg fix2
525 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
526 = ASSERT( right_op_ok fix e2 )
527 returnRn (OpApp e1 op fix e2)
531 -- Parser left-associates everything, but
532 -- derived instances may have correctly-associated things to
533 -- in the right operarand. So we just check that the right operand is OK
534 right_op_ok fix1 (OpApp _ _ fix2 _)
535 = not error_please && associate_right
537 (error_please, associate_right) = compareFixity fix1 fix2
538 right_op_ok fix1 other
541 -- Parser initially makes negation bind more tightly than any other operator
542 mkNegAppRn neg_arg neg_op
545 getModeRn `thenRn` \ mode ->
546 ASSERT( not_op_app mode neg_arg )
548 returnRn (NegApp neg_arg neg_op)
550 not_op_app SourceMode (OpApp _ _ _ _) = False
551 not_op_app mode other = True
555 mkConOpPatRn :: RenamedPat -> Name -> Fixity -> RenamedPat
558 mkConOpPatRn p1@(ConOpPatIn p11 op1 fix1 p12)
561 = addErrRn (precParseErr (op1,fix1) (op2,fix2)) `thenRn_`
562 returnRn (ConOpPatIn p1 op2 fix2 p2)
565 = mkConOpPatRn p12 op2 fix2 p2 `thenRn` \ new_p ->
566 returnRn (ConOpPatIn p11 op1 fix1 new_p)
569 (nofix_error, rearrange_me) = compareFixity fix1 fix2
571 mkConOpPatRn p1@(NegPatIn neg_arg)
573 fix2@(Fixity prec2 dir2)
575 | prec2 > 6 -- Precedence of unary - is wired in as 6!
576 = addErrRn (precParseNegPatErr (op2,fix2)) `thenRn_`
577 returnRn (ConOpPatIn p1 op2 fix2 p2)
579 mkConOpPatRn p1 op fix p2 -- Default case, no rearrangment
580 = ASSERT( not_op_pat p2 )
581 returnRn (ConOpPatIn p1 op fix p2)
583 not_op_pat (ConOpPatIn _ _ _ _) = False
584 not_op_pat other = True
588 checkPrecMatch :: Bool -> RdrName -> RdrNameMatch -> RnMS s ()
590 checkPrecMatch False fn match
592 checkPrecMatch True op (PatMatch p1 (PatMatch p2 (GRHSMatch _)))
593 = checkPrec op p1 False `thenRn_`
595 checkPrecMatch True op _
596 = panic "checkPrecMatch"
598 checkPrec op (ConOpPatIn _ op1 _ _) right
599 = lookupFixity op `thenRn` \ op_fix@(Fixity op_prec op_dir) ->
600 lookupFixity op1 `thenRn` \ op1_fix@(Fixity op1_prec op1_dir) ->
602 inf_ok = op1_prec > op_prec ||
603 (op1_prec == op_prec &&
604 (op1_dir == InfixR && op_dir == InfixR && right ||
605 op1_dir == InfixL && op_dir == InfixL && not right))
608 info1 = (op1,op1_fix)
609 (infol, infor) = if right then (info, info1) else (info1, info)
611 checkRn inf_ok (precParseErr infol infor)
613 checkPrec op (NegPatIn _) right
614 = lookupFixity op `thenRn` \ op_fix@(Fixity op_prec op_dir) ->
615 checkRn (op_prec <= 6) (precParseNegPatErr (op,op_fix))
617 checkPrec op pat right
624 (compareFixity op1 op2) tells which way to arrange appication, or
625 whether there's an error.
628 compareFixity :: Fixity -> Fixity
629 -> (Bool, -- Error please
630 Bool) -- Associate to the right: a op1 (b op2 c)
631 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
632 = case prec1 `cmp` prec2 of
635 EQ_ -> case (dir1, dir2) of
636 (InfixR, InfixR) -> right
637 (InfixL, InfixL) -> left
640 right = (False, True)
641 left = (False, False)
642 error_please = (True, False)
645 %************************************************************************
647 \subsubsection{Literals}
649 %************************************************************************
651 When literals occur we have to make sure that the types and classes they involve
655 litOccurrence (HsChar _)
656 = addImplicitOccRn charType_name
658 litOccurrence (HsCharPrim _)
659 = addImplicitOccRn (getName charPrimTyCon)
661 litOccurrence (HsString _)
662 = addImplicitOccRn listType_name `thenRn_`
663 addImplicitOccRn charType_name
665 litOccurrence (HsStringPrim _)
666 = addImplicitOccRn (getName addrPrimTyCon)
668 litOccurrence (HsInt _)
669 = lookupImplicitOccRn numClass_RDR -- Int and Integer are forced in by Num
671 litOccurrence (HsFrac _)
672 = lookupImplicitOccRn fractionalClass_RDR `thenRn_`
673 lookupImplicitOccRn ratioDataCon_RDR
674 -- We have to make sure that the Ratio type is imported with
675 -- its constructor, because literals of type Ratio t are
676 -- built with that constructor.
678 litOccurrence (HsIntPrim _)
679 = addImplicitOccRn (getName intPrimTyCon)
681 litOccurrence (HsFloatPrim _)
682 = addImplicitOccRn (getName floatPrimTyCon)
684 litOccurrence (HsDoublePrim _)
685 = addImplicitOccRn (getName doublePrimTyCon)
687 litOccurrence (HsLitLit _)
688 = lookupImplicitOccRn ccallableClass_RDR
692 %************************************************************************
694 \subsubsection{Errors}
696 %************************************************************************
699 dupFieldErr str (dup:rest) sty
700 = hcat [ptext SLIT("duplicate field name `"),
702 ptext SLIT("' in record "), text str]
705 = sep [ptext SLIT("prefix `-' not applied to literal in pattern"), ppr sty pat]
707 precParseNegPatErr op sty
708 = hang (ptext SLIT("precedence parsing error"))
709 4 (hcat [ptext SLIT("prefix `-' has lower precedence than "),
711 ptext SLIT(" in pattern")])
713 precParseErr op1 op2 sty
714 = hang (ptext SLIT("precedence parsing error"))
715 4 (hcat [ptext SLIT("cannot mix "), pp_op sty op1, ptext SLIT(" and "), pp_op sty op2,
716 ptext SLIT(" in the same infix expression")])
718 nonStdGuardErr guard sty
719 = hang (ptext SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)"))
722 pp_op sty (op, fix) = hcat [ppr sty op, space, parens (ppr sty fix)]