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 ErrUtils ( addErrLoc, addShortErrLocLine )
29 import Name ( isLocallyDefinedName, pprSym, Name, RdrName )
31 import UniqFM ( lookupUFM{-, ufmToList ToDo:rm-} )
32 import UniqSet ( emptyUniqSet, unitUniqSet,
33 unionUniqSets, unionManyUniqSets,
36 import Util ( Ord3(..), removeDups, panic )
40 *********************************************************
44 *********************************************************
47 rnPat :: RdrNamePat -> RnM_Fixes s RenamedPat
49 rnPat WildPatIn = returnRn WildPatIn
52 = lookupValue name `thenRn` \ vname ->
53 returnRn (VarPatIn vname)
55 rnPat (LitPatIn n) = returnRn (LitPatIn n)
58 = rnPat pat `thenRn` \ pat' ->
59 returnRn (LazyPatIn pat')
61 rnPat (AsPatIn name pat)
62 = rnPat pat `thenRn` \ pat' ->
63 lookupValue name `thenRn` \ vname ->
64 returnRn (AsPatIn vname pat')
66 rnPat (ConPatIn con pats)
67 = lookupConstr con `thenRn` \ con' ->
68 mapRn rnPat pats `thenRn` \ patslist ->
69 returnRn (ConPatIn con' patslist)
71 rnPat (ConOpPatIn pat1 con pat2)
72 = lookupConstr con `thenRn` \ con' ->
73 rnPat pat1 `thenRn` \ pat1' ->
74 rnPat pat2 `thenRn` \ pat2' ->
75 precParsePat (ConOpPatIn pat1' con' pat2')
77 rnPat neg@(NegPatIn pat)
78 = getSrcLocRn `thenRn` \ src_loc ->
79 addErrIfRn (not (valid_neg_pat pat)) (negPatErr neg src_loc)
81 rnPat pat `thenRn` \ pat' ->
82 returnRn (NegPatIn pat')
84 valid_neg_pat (LitPatIn (HsInt _)) = True
85 valid_neg_pat (LitPatIn (HsFrac _)) = True
86 valid_neg_pat _ = False
89 = rnPat pat `thenRn` \ pat' ->
90 returnRn (ParPatIn pat')
92 rnPat (ListPatIn pats)
93 = mapRn rnPat pats `thenRn` \ patslist ->
94 returnRn (ListPatIn patslist)
96 rnPat (TuplePatIn pats)
97 = mapRn rnPat pats `thenRn` \ patslist ->
98 returnRn (TuplePatIn patslist)
100 rnPat (RecPatIn con rpats)
101 = lookupConstr con `thenRn` \ con' ->
102 rnRpats rpats `thenRn` \ rpats' ->
103 returnRn (RecPatIn con' rpats')
106 ************************************************************************
110 ************************************************************************
113 rnMatch :: RdrNameMatch -> RnM_Fixes s (RenamedMatch, FreeVars)
116 = getSrcLocRn `thenRn` \ src_loc ->
117 newLocalNames "variable in pattern"
118 (binders `zip` repeat src_loc) `thenRn` \ new_binders ->
119 extendSS2 new_binders (rnMatch_aux match)
121 binders = collect_binders match
123 collect_binders :: RdrNameMatch -> [RdrName]
125 collect_binders (GRHSMatch _) = []
126 collect_binders (PatMatch pat match)
127 = collectPatBinders pat ++ collect_binders match
129 rnMatch_aux (PatMatch pat match)
130 = rnPat pat `thenRn` \ pat' ->
131 rnMatch_aux match `thenRn` \ (match', fvMatch) ->
132 returnRn (PatMatch pat' match', fvMatch)
134 rnMatch_aux (GRHSMatch grhss_and_binds)
135 = rnGRHSsAndBinds grhss_and_binds `thenRn` \ (grhss_and_binds', fvs) ->
136 returnRn (GRHSMatch grhss_and_binds', fvs)
139 %************************************************************************
141 \subsubsection{Guarded right-hand sides (GRHSsAndBinds)}
143 %************************************************************************
146 rnGRHSsAndBinds :: RdrNameGRHSsAndBinds -> RnM_Fixes s (RenamedGRHSsAndBinds, FreeVars)
148 rnGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
149 = rnBinds binds `thenRn` \ (binds', fvBinds, scope) ->
150 extendSS2 scope (rnGRHSs grhss) `thenRn` \ (grhss', fvGRHS) ->
151 returnRn (GRHSsAndBindsIn grhss' binds', fvBinds `unionUniqSets` fvGRHS)
153 rnGRHSs [] = returnRn ([], emptyUniqSet)
156 = rnGRHS grhs `thenRn` \ (grhs', fvs) ->
157 rnGRHSs grhss `thenRn` \ (grhss', fvss) ->
158 returnRn (grhs' : grhss', fvs `unionUniqSets` fvss)
160 rnGRHS (GRHS guard expr locn)
161 = pushSrcLocRn locn $
162 rnExpr guard `thenRn` \ (guard', fvsg) ->
163 rnExpr expr `thenRn` \ (expr', fvse) ->
164 returnRn (GRHS guard' expr' locn, fvsg `unionUniqSets` fvse)
166 rnGRHS (OtherwiseGRHS expr locn)
167 = pushSrcLocRn locn $
168 rnExpr expr `thenRn` \ (expr', fvs) ->
169 returnRn (OtherwiseGRHS expr' locn, fvs)
172 %************************************************************************
174 \subsubsection{Expressions}
176 %************************************************************************
179 rnExprs :: [RdrNameHsExpr] -> RnM_Fixes s ([RenamedHsExpr], FreeVars)
181 rnExprs [] = returnRn ([], emptyUniqSet)
184 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
185 rnExprs exprs `thenRn` \ (exprs', fvExprs) ->
186 returnRn (expr':exprs', fvExpr `unionUniqSets` fvExprs)
189 Variables. We look up the variable and return the resulting name. The
190 interesting question is what the free-variable set should be. We
191 don't want to return imported or prelude things as free vars. So we
192 look at the RnName returned from the lookup, and make it part of the
193 free-var set iff if it's a LocallyDefined RnName.
195 ToDo: what about RnClassOps ???
199 fv_set vname@(RnName n) | isLocallyDefinedName n
201 fv_set _ = emptyUniqSet
204 rnExpr :: RdrNameHsExpr -> RnM_Fixes s (RenamedHsExpr, FreeVars)
207 = lookupValue v `thenRn` \ vname ->
208 returnRn (HsVar vname, fv_set vname)
211 = returnRn (HsLit lit, emptyUniqSet)
214 = rnMatch match `thenRn` \ (match', fvMatch) ->
215 returnRn (HsLam match', fvMatch)
217 rnExpr (HsApp fun arg)
218 = rnExpr fun `thenRn` \ (fun',fvFun) ->
219 rnExpr arg `thenRn` \ (arg',fvArg) ->
220 returnRn (HsApp fun' arg', fvFun `unionUniqSets` fvArg)
222 rnExpr (OpApp e1 op e2)
223 = rnExpr e1 `thenRn` \ (e1', fvs_e1) ->
224 rnExpr op `thenRn` \ (op', fvs_op) ->
225 rnExpr e2 `thenRn` \ (e2', fvs_e2) ->
226 precParseExpr (OpApp e1' op' e2') `thenRn` \ exp ->
227 returnRn (exp, (fvs_op `unionUniqSets` fvs_e1) `unionUniqSets` fvs_e2)
230 = rnExpr e `thenRn` \ (e', fvs_e) ->
231 rnExpr n `thenRn` \ (n', fvs_n) ->
232 returnRn (NegApp e' n', fvs_e `unionUniqSets` fvs_n)
235 = rnExpr e `thenRn` \ (e', fvs_e) ->
236 returnRn (HsPar e', fvs_e)
238 rnExpr (SectionL expr op)
239 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
240 rnExpr op `thenRn` \ (op', fvs_op) ->
241 returnRn (SectionL expr' op', fvs_op `unionUniqSets` fvs_expr)
243 rnExpr (SectionR op expr)
244 = rnExpr op `thenRn` \ (op', fvs_op) ->
245 rnExpr expr `thenRn` \ (expr', fvs_expr) ->
246 returnRn (SectionR op' expr', fvs_op `unionUniqSets` fvs_expr)
248 rnExpr (CCall fun args may_gc is_casm fake_result_ty)
249 = rnExprs args `thenRn` \ (args', fvs_args) ->
250 returnRn (CCall fun args' may_gc is_casm fake_result_ty, fvs_args)
252 rnExpr (HsSCC label expr)
253 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
254 returnRn (HsSCC label expr', fvs_expr)
256 rnExpr (HsCase expr ms src_loc)
257 = pushSrcLocRn src_loc $
258 rnExpr expr `thenRn` \ (new_expr, e_fvs) ->
259 mapAndUnzipRn rnMatch ms `thenRn` \ (new_ms, ms_fvs) ->
260 returnRn (HsCase new_expr new_ms src_loc, unionManyUniqSets (e_fvs : ms_fvs))
262 rnExpr (HsLet binds expr)
263 = rnBinds binds `thenRn` \ (binds', fvBinds, new_binders) ->
264 extendSS2 new_binders (rnExpr expr) `thenRn` \ (expr',fvExpr) ->
265 returnRn (HsLet binds' expr', fvBinds `unionUniqSets` fvExpr)
267 rnExpr (HsDo stmts src_loc)
268 = pushSrcLocRn src_loc $
269 rnStmts stmts `thenRn` \ (stmts', fvStmts) ->
270 returnRn (HsDo stmts' src_loc, fvStmts)
272 rnExpr (ListComp expr quals)
273 = rnQuals quals `thenRn` \ ((quals', qual_binders), fvQuals) ->
274 extendSS2 qual_binders (rnExpr expr) `thenRn` \ (expr', fvExpr) ->
275 returnRn (ListComp expr' quals', fvExpr `unionUniqSets` fvQuals)
277 rnExpr (ExplicitList exps)
278 = rnExprs exps `thenRn` \ (exps', fvs) ->
279 returnRn (ExplicitList exps', fvs)
281 rnExpr (ExplicitTuple exps)
282 = rnExprs exps `thenRn` \ (exps', fvExps) ->
283 returnRn (ExplicitTuple exps', fvExps)
285 rnExpr (RecordCon (HsVar con) rbinds)
286 = lookupConstr con `thenRn` \ conname ->
287 rnRbinds "construction" rbinds `thenRn` \ (rbinds', fvRbinds) ->
288 returnRn (RecordCon (HsVar conname) rbinds', fvRbinds)
290 rnExpr (RecordUpd expr rbinds)
291 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
292 rnRbinds "update" rbinds `thenRn` \ (rbinds', fvRbinds) ->
293 returnRn (RecordUpd expr' rbinds', fvExpr `unionUniqSets` fvRbinds)
295 rnExpr (ExprWithTySig expr pty)
296 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
297 rnPolyType nullTyVarNamesEnv pty `thenRn` \ pty' ->
298 returnRn (ExprWithTySig expr' pty', fvExpr)
300 rnExpr (HsIf p b1 b2 src_loc)
301 = pushSrcLocRn src_loc $
302 rnExpr p `thenRn` \ (p', fvP) ->
303 rnExpr b1 `thenRn` \ (b1', fvB1) ->
304 rnExpr b2 `thenRn` \ (b2', fvB2) ->
305 returnRn (HsIf p' b1' b2' src_loc, unionManyUniqSets [fvP, fvB1, fvB2])
307 rnExpr (ArithSeqIn seq)
308 = rn_seq seq `thenRn` \ (new_seq, fvs) ->
309 returnRn (ArithSeqIn new_seq, fvs)
312 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
313 returnRn (From expr', fvExpr)
315 rn_seq (FromThen expr1 expr2)
316 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
317 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
318 returnRn (FromThen expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
320 rn_seq (FromTo expr1 expr2)
321 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
322 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
323 returnRn (FromTo expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
325 rn_seq (FromThenTo expr1 expr2 expr3)
326 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
327 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
328 rnExpr expr3 `thenRn` \ (expr3', fvExpr3) ->
329 returnRn (FromThenTo expr1' expr2' expr3',
330 unionManyUniqSets [fvExpr1, fvExpr2, fvExpr3])
333 %************************************************************************
335 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
337 %************************************************************************
341 = mapRn field_dup_err dup_fields `thenRn_`
342 mapAndUnzipRn rn_rbind rbinds `thenRn` \ (rbinds', fvRbind_s) ->
343 returnRn (rbinds', unionManyUniqSets fvRbind_s)
345 (_, dup_fields) = removeDups cmp [ f | (f,_,_) <- rbinds ]
347 field_dup_err dups = getSrcLocRn `thenRn` \ src_loc ->
348 addErrRn (dupFieldErr str src_loc dups)
350 rn_rbind (field, expr, pun)
351 = lookupField field `thenRn` \ fieldname ->
352 rnExpr expr `thenRn` \ (expr', fvExpr) ->
353 returnRn ((fieldname, expr', pun), fvExpr)
356 = mapRn field_dup_err dup_fields `thenRn_`
359 (_, dup_fields) = removeDups cmp [ f | (f,_,_) <- rpats ]
361 field_dup_err dups = getSrcLocRn `thenRn` \ src_loc ->
362 addErrRn (dupFieldErr "pattern" src_loc dups)
364 rn_rpat (field, pat, pun)
365 = lookupField field `thenRn` \ fieldname ->
366 rnPat pat `thenRn` \ pat' ->
367 returnRn (fieldname, pat', pun)
370 %************************************************************************
372 \subsubsection{@Qualifier@s: in list comprehensions}
374 %************************************************************************
376 Note that although some bound vars may appear in the free var set for
377 the first qual, these will eventually be removed by the caller. For
378 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
379 @[q <- r, p <- q]@, the free var set for @q <- r@ will
380 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
381 @r@ will be removed only when we finally return from examining all the
385 rnQuals :: [RdrNameQual]
386 -> RnM_Fixes s (([RenamedQual], -- renamed qualifiers
387 [RnName]), -- qualifiers' binders
388 FreeVars) -- free variables
390 rnQuals [qual] -- must be at least one qual
391 = rnQual qual `thenRn` \ ((new_qual, bs), fvs) ->
392 returnRn (([new_qual], bs), fvs)
394 rnQuals (qual: quals)
395 = rnQual qual `thenRn` \ ((qual', bs1), fvQuals1) ->
396 extendSS2 bs1 (rnQuals quals) `thenRn` \ ((quals', bs2), fvQuals2) ->
398 ((qual' : quals', bs1 ++ bs2), -- The ones on the right (bs2) shadow the
399 -- ones on the left (bs1)
400 fvQuals1 `unionUniqSets` fvQuals2)
402 rnQual (GeneratorQual pat expr)
403 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
405 binders = collectPatBinders pat
407 getSrcLocRn `thenRn` \ src_loc ->
408 newLocalNames "variable in list-comprehension-generator pattern"
409 (binders `zip` repeat src_loc) `thenRn` \ new_binders ->
410 extendSS new_binders (rnPat pat) `thenRn` \ pat' ->
412 returnRn ((GeneratorQual pat' expr', new_binders), fvExpr)
414 rnQual (FilterQual expr)
415 = rnExpr expr `thenRn` \ (expr', fvs) ->
416 returnRn ((FilterQual expr', []), fvs)
418 rnQual (LetQual binds)
419 = rnBinds binds `thenRn` \ (binds', binds_fvs, new_binders) ->
420 returnRn ((LetQual binds', new_binders), binds_fvs)
424 %************************************************************************
426 \subsubsection{@Stmt@s: in @do@ expressions}
428 %************************************************************************
431 rnStmts :: [RdrNameStmt] -> RnM_Fixes s ([RenamedStmt], FreeVars)
433 rnStmts [stmt@(ExprStmt _ _)] -- last stmt must be ExprStmt
434 = rnStmt stmt `thenRn` \ ((stmt',[]), fvStmt) ->
435 returnRn ([stmt'], fvStmt)
438 = rnStmt stmt `thenRn` \ ((stmt',bs), fvStmt) ->
439 extendSS2 bs (rnStmts stmts) `thenRn` \ (stmts', fvStmts) ->
440 returnRn (stmt':stmts', fvStmt `unionUniqSets` fvStmts)
443 rnStmt (BindStmt pat expr src_loc)
444 = pushSrcLocRn src_loc $
445 rnExpr expr `thenRn` \ (expr', fvExpr) ->
447 binders = collectPatBinders pat
449 newLocalNames "variable in do binding"
450 (binders `zip` repeat src_loc) `thenRn` \ new_binders ->
451 extendSS new_binders (rnPat pat) `thenRn` \ pat' ->
453 returnRn ((BindStmt pat' expr' src_loc, new_binders), fvExpr)
455 rnStmt (ExprStmt expr src_loc)
457 rnExpr expr `thenRn` \ (expr', fvs) ->
458 returnRn ((ExprStmt expr' src_loc, []), fvs)
460 rnStmt (LetStmt binds)
461 = rnBinds binds `thenRn` \ (binds', binds_fvs, new_binders) ->
462 returnRn ((LetStmt binds', new_binders), binds_fvs)
466 %************************************************************************
468 \subsubsection{Precedence Parsing}
470 %************************************************************************
473 precParseExpr :: RenamedHsExpr -> RnM_Fixes s RenamedHsExpr
474 precParsePat :: RenamedPat -> RnM_Fixes s RenamedPat
476 precParseExpr exp@(OpApp (NegApp e1 n) (HsVar op) e2)
477 = lookupFixity op `thenRn` \ (op_fix, op_prec) ->
479 -- negate precedence 6 wired in
481 precParseExpr (OpApp e1 (HsVar op) e2) `thenRn` \ op_app ->
482 returnRn (NegApp op_app n)
486 precParseExpr exp@(OpApp (OpApp e11 (HsVar op1) e12) (HsVar op) e2)
487 = lookupFixity op `thenRn` \ (op_fix, op_prec) ->
488 lookupFixity op1 `thenRn` \ (op1_fix, op1_prec) ->
489 -- pprTrace "precParse:" (ppCat [ppr PprDebug op, ppInt op_prec, ppr PprDebug op1, ppInt op1_prec]) $
490 case (op1_prec `cmp` op_prec) of
492 EQ_ -> case (op1_fix, op_fix) of
493 (INFIXR, INFIXR) -> rearrange
494 (INFIXL, INFIXL) -> returnRn exp
495 _ -> getSrcLocRn `thenRn` \ src_loc ->
496 failButContinueRn exp
497 (precParseErr (op1,op1_fix,op1_prec) (op,op_fix,op_prec) src_loc)
500 rearrange = precParseExpr (OpApp e12 (HsVar op) e2) `thenRn` \ e2' ->
501 returnRn (OpApp e11 (HsVar op1) e2')
503 precParseExpr exp = returnRn exp
506 precParsePat pat@(ConOpPatIn (NegPatIn e1) op e2)
507 = lookupFixity op `thenRn` \ (op_fix, op_prec) ->
509 -- negate precedence 6 wired in
510 getSrcLocRn `thenRn` \ src_loc ->
511 failButContinueRn pat (precParseNegPatErr (op,op_fix,op_prec) src_loc)
515 precParsePat pat@(ConOpPatIn (ConOpPatIn p11 op1 p12) op p2)
516 = lookupFixity op `thenRn` \ (op_fix, op_prec) ->
517 lookupFixity op1 `thenRn` \ (op1_fix, op1_prec) ->
518 case (op1_prec `cmp` op_prec) of
520 EQ_ -> case (op1_fix, op_fix) of
521 (INFIXR, INFIXR) -> rearrange
522 (INFIXL, INFIXL) -> returnRn pat
523 _ -> getSrcLocRn `thenRn` \ src_loc ->
524 failButContinueRn pat
525 (precParseErr (op1,op1_fix,op1_prec) (op,op_fix,op_prec) src_loc)
528 rearrange = precParsePat (ConOpPatIn p12 op p2) `thenRn` \ p2' ->
529 returnRn (ConOpPatIn p11 op1 p2')
531 precParsePat pat = returnRn pat
534 data INFIX = INFIXL | INFIXR | INFIXN deriving Eq
536 lookupFixity :: RnName -> RnM_Fixes s (INFIX, Int)
538 = getExtraRn `thenRn` \ fixity_fm ->
539 -- pprTrace "lookupFixity:" (ppAboves [ppCat [pprUnique u, ppr PprDebug i_f] | (u,i_f) <- ufmToList fixity_fm]) $
540 case lookupUFM fixity_fm op of
541 Nothing -> returnRn (INFIXL, 9)
542 Just (InfixL _ n) -> returnRn (INFIXL, n)
543 Just (InfixR _ n) -> returnRn (INFIXR, n)
544 Just (InfixN _ n) -> returnRn (INFIXN, n)
548 checkPrecMatch :: Bool -> RnName -> RenamedMatch -> RnM_Fixes s ()
550 checkPrecMatch False fn match
552 checkPrecMatch True op (PatMatch p1 (PatMatch p2 (GRHSMatch _)))
553 = checkPrec op p1 False `thenRn_`
555 checkPrecMatch True op _
556 = panic "checkPrecMatch"
558 checkPrec op (ConOpPatIn _ op1 _) right
559 = lookupFixity op `thenRn` \ (op_fix, op_prec) ->
560 lookupFixity op1 `thenRn` \ (op1_fix, op1_prec) ->
561 getSrcLocRn `thenRn` \ src_loc ->
563 inf_ok = op1_prec > op_prec ||
564 (op1_prec == op_prec &&
565 (op1_fix == INFIXR && op_fix == INFIXR && right ||
566 op1_fix == INFIXL && op_fix == INFIXL && not right))
568 info = (op,op_fix,op_prec)
569 info1 = (op1,op1_fix,op1_prec)
570 (infol, infor) = if right then (info, info1) else (info1, info)
572 addErrIfRn (not inf_ok) (precParseErr infol infor src_loc)
574 checkPrec op (NegPatIn _) right
575 = lookupFixity op `thenRn` \ (op_fix, op_prec) ->
576 getSrcLocRn `thenRn` \ src_loc ->
577 addErrIfRn (6 < op_prec) (precParseNegPatErr (op,op_fix,op_prec) src_loc)
579 checkPrec op pat right
584 dupFieldErr str src_loc (dup:rest)
585 = addShortErrLocLine src_loc (\ sty ->
586 ppBesides [ppStr "duplicate field name `", ppr sty dup, ppStr "' in record ", ppStr str])
588 negPatErr pat src_loc
589 = addShortErrLocLine src_loc (\ sty ->
590 ppSep [ppStr "prefix `-' not applied to literal in pattern", ppr sty pat])
592 precParseNegPatErr op src_loc
593 = addErrLoc src_loc "precedence parsing error" (\ sty ->
594 ppBesides [ppStr "prefix `-' has lower precedence than ", pp_op sty op, ppStr " in pattern"])
596 precParseErr op1 op2 src_loc
597 = addErrLoc src_loc "precedence parsing error" (\ sty ->
598 ppBesides [ppStr "cannot mix ", pp_op sty op1, ppStr " and ", pp_op sty op2,
599 ppStr " in the same infix expression"])
601 pp_op sty (op, fix, prec) = ppBesides [pprSym sty op, ppLparen, pp_fix fix, ppSP, ppInt prec, ppRparen]
602 pp_fix INFIXL = ppStr "infixl"
603 pp_fix INFIXR = ppStr "infixr"
604 pp_fix INFIXN = ppStr "infix"