ghc/compiler/rename/RnExpr.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnExpr]{Renaming of expressions}
   5
   6 Basically dependency analysis.
   7
   8 Handles @Match@, @GRHSsAndBinds@, @HsExpr@, and @Qual@ datatypes.  In
   9 general, all of these functions return a renamed thing, and a set of
  10 free variables.
  11
  12 \begin{code}
  13 #include "HsVersions.h"
  14
  15 module RnExpr (
  16         rnMatch, rnGRHSsAndBinds, rnPat
  17    ) where
  18
  19 import Ubiq
  20 import RnLoop           -- break the RnPass4/RnExpr4/RnBinds4 loops
  21
  22 import HsSyn
  23 import RdrHsSyn
  24 import RnHsSyn
  25 import RnMonad
  26
  27 import ErrUtils         ( addErrLoc )
  28 import Name             ( isLocallyDefinedName, pprOp, Name, RdrName )
  29 import Pretty
  30 import UniqFM           ( lookupUFM )
  31 import UniqSet          ( emptyUniqSet, unitUniqSet,
  32                           unionUniqSets, unionManyUniqSets,
  33                           UniqSet(..) )
  34 import Util             ( Ord3(..), panic )
  35 \end{code}
  36
  37
  38 *********************************************************
  39 *                                                       *
  40 \subsection{Patterns}
  41 *                                                       *
  42 *********************************************************
  43
  44 \begin{code}
  45 rnPat :: RdrNamePat -> RnM_Fixes s RenamedPat
  46
  47 rnPat WildPatIn = returnRn WildPatIn
  48
  49 rnPat (VarPatIn name)
  50   = lookupValue name    `thenRn` \ vname ->
  51     returnRn (VarPatIn vname)
  52
  53 rnPat (LitPatIn n) = returnRn (LitPatIn n)
  54
  55 rnPat (LazyPatIn pat)
  56   = rnPat pat           `thenRn` \ pat' ->
  57     returnRn (LazyPatIn pat')
  58
  59 rnPat (AsPatIn name pat)
  60   = rnPat pat   `thenRn` \ pat' ->
  61     lookupValue name    `thenRn` \ vname ->
  62     returnRn (AsPatIn vname pat')
  63
  64 rnPat (ConPatIn name pats)
  65   = lookupValue name    `thenRn` \ name' ->
  66     mapRn rnPat pats    `thenRn` \ patslist ->
  67     returnRn (ConPatIn name' patslist)
  68
  69 rnPat (ConOpPatIn pat1 name pat2)
  70   = lookupValue name    `thenRn` \ name' ->
  71     rnPat pat1          `thenRn` \ pat1' ->
  72     rnPat pat2          `thenRn` \ pat2' ->
  73     precParsePat (ConOpPatIn pat1' name' pat2')
  74
  75 rnPat neg@(NegPatIn pat)
  76   = getSrcLocRn         `thenRn` \ src_loc ->
  77     addErrIfRn (not (is_lit pat)) (negPatErr neg src_loc)
  78                         `thenRn_`
  79     rnPat pat           `thenRn` \ pat' ->
  80     returnRn (NegPatIn pat')
  81   where
  82     is_lit (LitPatIn _) = True
  83     is_lit _            = False
  84
  85 rnPat (ParPatIn pat)
  86   = rnPat pat           `thenRn` \ pat' ->
  87     returnRn (ParPatIn pat')
  88
  89 rnPat (ListPatIn pats)
  90   = mapRn rnPat pats    `thenRn` \ patslist ->
  91     returnRn (ListPatIn patslist)
  92
  93 rnPat (TuplePatIn pats)
  94   = mapRn rnPat pats    `thenRn` \ patslist ->
  95     returnRn (TuplePatIn patslist)
  96
  97 rnPat (RecPatIn con rpats)
  98   = panic "rnPat:RecPatIn"
  99
 100 \end{code}
 101
 102 ************************************************************************
 103 *                                                                       *
 104 \subsection{Match}
 105 *                                                                       *
 106 ************************************************************************
 107
 108 \begin{code}
 109 rnMatch :: RdrNameMatch -> RnM_Fixes s (RenamedMatch, FreeVars)
 110
 111 rnMatch match
 112   = getSrcLocRn                 `thenRn` \ src_loc ->
 113     newLocalNames "variable in pattern"
 114          (binders `zip` repeat src_loc) `thenRn` \ new_binders ->
 115     extendSS2 new_binders (rnMatch_aux match)
 116   where
 117     binders = collect_binders match
 118
 119     collect_binders :: RdrNameMatch -> [RdrName]
 120
 121     collect_binders (GRHSMatch _) = []
 122     collect_binders (PatMatch pat match)
 123       = collectPatBinders pat ++ collect_binders match
 124
 125 rnMatch_aux (PatMatch pat match)
 126   = rnPat pat           `thenRn` \ pat' ->
 127     rnMatch_aux match   `thenRn` \ (match', fvMatch) ->
 128     returnRn (PatMatch pat' match', fvMatch)
 129
 130 rnMatch_aux (GRHSMatch grhss_and_binds)
 131   = rnGRHSsAndBinds grhss_and_binds `thenRn` \ (grhss_and_binds', fvs) ->
 132     returnRn (GRHSMatch grhss_and_binds', fvs)
 133 \end{code}
 134
 135 %************************************************************************
 136 %*                                                                      *
 137 \subsubsection{Guarded right-hand sides (GRHSsAndBinds)}
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 \begin{code}
 142 rnGRHSsAndBinds :: RdrNameGRHSsAndBinds -> RnM_Fixes s (RenamedGRHSsAndBinds, FreeVars)
 143
 144 rnGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
 145   = rnBinds binds                       `thenRn` \ (binds', fvBinds, scope) ->
 146     extendSS2 scope (rnGRHSs grhss)     `thenRn` \ (grhss', fvGRHS) ->
 147     returnRn (GRHSsAndBindsIn grhss' binds', fvBinds `unionUniqSets` fvGRHS)
 148   where
 149     rnGRHSs [] = returnRn ([], emptyUniqSet)
 150
 151     rnGRHSs (grhs:grhss)
 152       = rnGRHS  grhs   `thenRn` \ (grhs',  fvs) ->
 153         rnGRHSs grhss  `thenRn` \ (grhss', fvss) ->
 154         returnRn (grhs' : grhss', fvs `unionUniqSets` fvss)
 155
 156     rnGRHS (GRHS guard expr locn)
 157       = pushSrcLocRn locn $
 158         rnExpr guard    `thenRn` \ (guard', fvsg) ->
 159         rnExpr expr     `thenRn` \ (expr',  fvse) ->
 160         returnRn (GRHS guard' expr' locn, fvsg `unionUniqSets` fvse)
 161
 162     rnGRHS (OtherwiseGRHS expr locn)
 163       = pushSrcLocRn locn $
 164         rnExpr expr     `thenRn` \ (expr', fvs) ->
 165         returnRn (OtherwiseGRHS expr' locn, fvs)
 166 \end{code}
 167
 168 %************************************************************************
 169 %*                                                                      *
 170 \subsubsection{Expressions}
 171 %*                                                                      *
 172 %************************************************************************
 173
 174 \begin{code}
 175 rnExprs :: [RdrNameHsExpr] -> RnM_Fixes s ([RenamedHsExpr], FreeVars)
 176
 177 rnExprs [] = returnRn ([], emptyUniqSet)
 178
 179 rnExprs (expr:exprs)
 180   = rnExpr expr         `thenRn` \ (expr', fvExpr) ->
 181     rnExprs exprs       `thenRn` \ (exprs', fvExprs) ->
 182     returnRn (expr':exprs', fvExpr `unionUniqSets` fvExprs)
 183 \end{code}
 184
 185 Variables. We look up the variable and return the resulting name.  The
 186 interesting question is what the free-variable set should be.  We
 187 don't want to return imported or prelude things as free vars.  So we
 188 look at the RnName returned from the lookup, and make it part of the
 189 free-var set iff if it's a LocallyDefined RnName.
 190
 191 ToDo: what about RnClassOps ???
 192 \end{itemize}
 193
 194 \begin{code}
 195 rnExpr :: RdrNameHsExpr -> RnM_Fixes s (RenamedHsExpr, FreeVars)
 196
 197 rnExpr (HsVar v)
 198   = lookupValue v       `thenRn` \ vname ->
 199     returnRn (HsVar vname, fv_set vname)
 200   where
 201     fv_set vname@(RnName n)
 202       | isLocallyDefinedName n = unitUniqSet vname
 203       | otherwise              = emptyUniqSet
 204
 205 rnExpr (HsLit lit)
 206   = returnRn (HsLit lit, emptyUniqSet)
 207
 208 rnExpr (HsLam match)
 209   = rnMatch match       `thenRn` \ (match', fvMatch) ->
 210     returnRn (HsLam match', fvMatch)
 211
 212 rnExpr (HsApp fun arg)
 213   = rnExpr fun          `thenRn` \ (fun',fvFun) ->
 214     rnExpr arg          `thenRn` \ (arg',fvArg) ->
 215     returnRn (HsApp fun' arg', fvFun `unionUniqSets` fvArg)
 216
 217 rnExpr (OpApp e1 op e2)
 218   = rnExpr e1           `thenRn` \ (e1', fvs_e1) ->
 219     rnExpr op           `thenRn` \ (op', fvs_op) ->
 220     rnExpr e2           `thenRn` \ (e2', fvs_e2) ->
 221     precParseExpr (OpApp e1' op' e2') `thenRn` \ exp ->
 222     returnRn (exp, (fvs_op `unionUniqSets` fvs_e1) `unionUniqSets` fvs_e2)
 223
 224 rnExpr (NegApp e)
 225   = rnExpr e            `thenRn` \ (e', fvs_e) ->
 226     returnRn (NegApp e', fvs_e)
 227
 228 rnExpr (HsPar e)
 229   = rnExpr e            `thenRn` \ (e', fvs_e) ->
 230     returnRn (HsPar e', fvs_e)
 231
 232 rnExpr (SectionL expr op)
 233   = rnExpr expr         `thenRn` \ (expr', fvs_expr) ->
 234     rnExpr op           `thenRn` \ (op', fvs_op) ->
 235     returnRn (SectionL expr' op', fvs_op `unionUniqSets` fvs_expr)
 236
 237 rnExpr (SectionR op expr)
 238   = rnExpr op           `thenRn` \ (op',   fvs_op) ->
 239     rnExpr expr         `thenRn` \ (expr', fvs_expr) ->
 240     returnRn (SectionR op' expr', fvs_op `unionUniqSets` fvs_expr)
 241
 242 rnExpr (CCall fun args may_gc is_casm fake_result_ty)
 243   = rnExprs args        `thenRn` \ (args', fvs_args) ->
 244     returnRn (CCall fun args' may_gc is_casm fake_result_ty, fvs_args)
 245
 246 rnExpr (HsSCC label expr)
 247   = rnExpr expr         `thenRn` \ (expr', fvs_expr) ->
 248     returnRn (HsSCC label expr', fvs_expr)
 249
 250 rnExpr (HsCase expr ms src_loc)
 251   = pushSrcLocRn src_loc $
 252     rnExpr expr                 `thenRn` \ (new_expr, e_fvs) ->
 253     mapAndUnzipRn rnMatch ms    `thenRn` \ (new_ms, ms_fvs) ->
 254     returnRn (HsCase new_expr new_ms src_loc, unionManyUniqSets (e_fvs : ms_fvs))
 255
 256 rnExpr (HsLet binds expr)
 257   = rnBinds binds               `thenRn` \ (binds', fvBinds, new_binders) ->
 258     extendSS2 new_binders (rnExpr expr) `thenRn` \ (expr',fvExpr) ->
 259     returnRn (HsLet binds' expr', fvBinds `unionUniqSets` fvExpr)
 260
 261 rnExpr (HsDo stmts src_loc)
 262   = pushSrcLocRn src_loc $
 263     rnStmts stmts               `thenRn` \ (stmts', fvStmts) ->
 264     returnRn (HsDo stmts' src_loc, fvStmts)
 265
 266 rnExpr (ListComp expr quals)
 267   = rnQuals quals               `thenRn` \ ((quals', qual_binders), fvQuals) ->
 268     extendSS2 qual_binders (rnExpr expr) `thenRn` \ (expr', fvExpr) ->
 269     returnRn (ListComp expr' quals', fvExpr `unionUniqSets` fvQuals)
 270
 271 rnExpr (ExplicitList exps)
 272   = rnExprs exps                `thenRn` \ (exps', fvs) ->
 273     returnRn  (ExplicitList exps', fvs)
 274
 275 rnExpr (ExplicitTuple exps)
 276   = rnExprs exps                `thenRn` \ (exps', fvExps) ->
 277     returnRn (ExplicitTuple exps', fvExps)
 278
 279 rnExpr (RecordCon con rbinds)
 280   = panic "rnExpr:RecordCon"
 281 rnExpr (RecordUpd exp rbinds)
 282   = panic "rnExpr:RecordUpd"
 283
 284 rnExpr (ExprWithTySig expr pty)
 285   = rnExpr expr                         `thenRn` \ (expr', fvExpr) ->
 286     rnPolyType nullTyVarNamesEnv pty `thenRn` \ pty' ->
 287     returnRn (ExprWithTySig expr' pty', fvExpr)
 288
 289 rnExpr (HsIf p b1 b2 src_loc)
 290   = pushSrcLocRn src_loc $
 291     rnExpr p            `thenRn` \ (p', fvP) ->
 292     rnExpr b1           `thenRn` \ (b1', fvB1) ->
 293     rnExpr b2           `thenRn` \ (b2', fvB2) ->
 294     returnRn (HsIf p' b1' b2' src_loc, unionManyUniqSets [fvP, fvB1, fvB2])
 295
 296 rnExpr (ArithSeqIn seq)
 297   = rn_seq seq          `thenRn` \ (new_seq, fvs) ->
 298     returnRn (ArithSeqIn new_seq, fvs)
 299   where
 300     rn_seq (From expr)
 301      = rnExpr expr      `thenRn` \ (expr', fvExpr) ->
 302        returnRn (From expr', fvExpr)
 303
 304     rn_seq (FromThen expr1 expr2)
 305      = rnExpr expr1     `thenRn` \ (expr1', fvExpr1) ->
 306        rnExpr expr2     `thenRn` \ (expr2', fvExpr2) ->
 307        returnRn (FromThen expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
 308
 309     rn_seq (FromTo expr1 expr2)
 310      = rnExpr expr1     `thenRn` \ (expr1', fvExpr1) ->
 311        rnExpr expr2     `thenRn` \ (expr2', fvExpr2) ->
 312        returnRn (FromTo expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
 313
 314     rn_seq (FromThenTo expr1 expr2 expr3)
 315      = rnExpr expr1     `thenRn` \ (expr1', fvExpr1) ->
 316        rnExpr expr2     `thenRn` \ (expr2', fvExpr2) ->
 317        rnExpr expr3     `thenRn` \ (expr3', fvExpr3) ->
 318        returnRn (FromThenTo expr1' expr2' expr3',
 319                   unionManyUniqSets [fvExpr1, fvExpr2, fvExpr3])
 320
 321 \end{code}
 322
 323 %************************************************************************
 324 %*                                                                      *
 325 \subsubsection{@Qual@s: in list comprehensions}
 326 %*                                                                      *
 327 %************************************************************************
 328
 329 Note that although some bound vars may appear in the free var set for
 330 the first qual, these will eventually be removed by the caller. For
 331 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
 332 @[q <- r, p <- q]@, the free var set for @q <- r@ will
 333 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
 334 @r@ will be removed only when we finally return from examining all the
 335 Quals.
 336
 337 \begin{code}
 338 rnQuals :: [RdrNameQual]
 339          -> RnM_Fixes s (([RenamedQual],        -- renamed qualifiers
 340                          [RnName]),             -- qualifiers' binders
 341                          FreeVars)              -- free variables
 342
 343 rnQuals [qual]                          -- must be at least one qual
 344   = rnQual qual `thenRn` \ ((new_qual, bs), fvs) ->
 345     returnRn (([new_qual], bs), fvs)
 346
 347 rnQuals (qual: quals)
 348   = rnQual qual                         `thenRn` \ ((qual',  bs1), fvQuals1) ->
 349     extendSS2 bs1 (rnQuals quals)       `thenRn` \ ((quals', bs2), fvQuals2) ->
 350     returnRn
 351        ((qual' : quals', bs2 ++ bs1),   -- The ones on the right (bs2) shadow the
 352                                         -- ones on the left (bs1)
 353         fvQuals1 `unionUniqSets` fvQuals2)
 354
 355 rnQual (GeneratorQual pat expr)
 356   = rnExpr expr          `thenRn` \ (expr', fvExpr) ->
 357     let
 358         binders = collectPatBinders pat
 359     in
 360     getSrcLocRn          `thenRn` \ src_loc ->
 361     newLocalNames "variable in list-comprehension-generator pattern"
 362          (binders `zip` repeat src_loc)   `thenRn` \ new_binders ->
 363     extendSS new_binders (rnPat pat) `thenRn` \ pat' ->
 364
 365     returnRn ((GeneratorQual pat' expr', new_binders), fvExpr)
 366
 367 rnQual (FilterQual expr)
 368   = rnExpr expr  `thenRn` \ (expr', fvs) ->
 369     returnRn ((FilterQual expr', []), fvs)
 370
 371 rnQual (LetQual binds)
 372   = rnBinds binds       `thenRn` \ (binds', binds_fvs, new_binders) ->
 373     returnRn ((LetQual binds', new_binders), binds_fvs)
 374 \end{code}
 375
 376
 377 %************************************************************************
 378 %*                                                                      *
 379 \subsubsection{@Stmt@s: in @do@ expressions}
 380 %*                                                                      *
 381 %************************************************************************
 382
 383 \begin{code}
 384 rnStmts :: [RdrNameStmt] -> RnM_Fixes s ([RenamedStmt], FreeVars)
 385
 386 rnStmts [stmt@(ExprStmt _ _)]           -- last stmt must be ExprStmt
 387   = rnStmt stmt                         `thenRn` \ ((stmt',[]), fvStmt) ->
 388     returnRn ([stmt'], fvStmt)
 389
 390 rnStmts (stmt:stmts)
 391   = rnStmt stmt                         `thenRn` \ ((stmt',bs), fvStmt) ->
 392     extendSS2 bs (rnStmts stmts)        `thenRn` \ (stmts',     fvStmts) ->
 393     returnRn (stmt':stmts', fvStmt `unionUniqSets` fvStmts)
 394
 395
 396 rnStmt (BindStmt pat expr src_loc)
 397   = pushSrcLocRn src_loc $
 398     rnExpr expr                         `thenRn` \ (expr', fvExpr) ->
 399     let
 400         binders = collectPatBinders pat
 401     in
 402     newLocalNames "variable in do binding"
 403          (binders `zip` repeat src_loc) `thenRn` \ new_binders ->
 404     extendSS new_binders (rnPat pat)    `thenRn` \ pat' ->
 405
 406     returnRn ((BindStmt pat' expr' src_loc, new_binders), fvExpr)
 407
 408 rnStmt (ExprStmt expr src_loc)
 409   =
 410     rnExpr expr                         `thenRn` \ (expr', fvs) ->
 411     returnRn ((ExprStmt expr' src_loc, []), fvs)
 412
 413 rnStmt (LetStmt binds)
 414   = rnBinds binds       `thenRn` \ (binds', binds_fvs, new_binders) ->
 415     returnRn ((LetStmt binds', new_binders), binds_fvs)
 416
 417 \end{code}
 418
 419 %************************************************************************
 420 %*                                                                      *
 421 \subsubsection{Precedence Parsing}
 422 %*                                                                      *
 423 %************************************************************************
 424
 425 \begin{code}
 426 precParseExpr :: RenamedHsExpr -> RnM_Fixes s RenamedHsExpr
 427 precParsePat  :: RenamedPat -> RnM_Fixes s RenamedPat
 428
 429 precParseExpr exp@(OpApp (NegApp e1) (HsVar op) e2)
 430   = lookupFixity op             `thenRn` \ (op_fix, op_prec) ->
 431     if 6 < op_prec then
 432         -- negate precedence 6 wired in
 433         -- (-x)*y  ==> -(x*y)
 434         precParseExpr (OpApp e1 (HsVar op) e2) `thenRn` \ op_app ->
 435         returnRn (NegApp op_app)
 436     else
 437         returnRn exp
 438
 439 precParseExpr exp@(OpApp (OpApp e11 (HsVar op1) e12) (HsVar op) e2)
 440   = lookupFixity op              `thenRn` \ (op_fix, op_prec) ->
 441     lookupFixity op1             `thenRn` \ (op1_fix, op1_prec) ->
 442     case cmp op1_prec op_prec of
 443       LT_  -> rearrange
 444       EQ_  -> case (op1_fix, op_fix) of
 445                 (INFIXR, INFIXR) -> rearrange
 446                 (INFIXL, INFIXL) -> returnRn exp
 447                 _ -> getSrcLocRn `thenRn` \ src_loc ->
 448                      failButContinueRn exp
 449                      (precParseErr (op1,op1_fix,op1_prec) (op,op_fix,op_prec) src_loc)
 450       GT__ -> returnRn exp
 451   where
 452     rearrange = precParseExpr (OpApp e12 (HsVar op) e2) `thenRn` \ e2' ->
 453                 returnRn (OpApp e11 (HsVar op1) e2')
 454
 455 precParseExpr exp = returnRn exp
 456
 457
 458 precParsePat pat@(ConOpPatIn (NegPatIn e1) op e2)
 459   = lookupFixity op             `thenRn` \ (op_fix, op_prec) ->
 460     if 6 < op_prec then
 461         -- negate precedence 6 wired in
 462         getSrcLocRn `thenRn` \ src_loc ->
 463         failButContinueRn pat (precParseNegPatErr (op,op_fix,op_prec) src_loc)
 464     else
 465         returnRn pat
 466
 467 precParsePat pat@(ConOpPatIn (ConOpPatIn p11 op1 p12) op p2)
 468   = lookupFixity op              `thenRn` \ (op_fix, op_prec) ->
 469     lookupFixity op1             `thenRn` \ (op1_fix, op1_prec) ->
 470     case cmp op1_prec op_prec of
 471       LT_  -> rearrange
 472       EQ_  -> case (op1_fix, op_fix) of
 473                 (INFIXR, INFIXR) -> rearrange
 474                 (INFIXL, INFIXL) -> returnRn pat
 475                 _ -> getSrcLocRn `thenRn` \ src_loc ->
 476                      failButContinueRn pat
 477                        (precParseErr (op1,op1_fix,op1_prec) (op,op_fix,op_prec) src_loc)
 478       GT__ -> returnRn pat
 479   where
 480     rearrange = precParsePat (ConOpPatIn p12 op p2) `thenRn` \ p2' ->
 481                 returnRn (ConOpPatIn p11 op1 p2')
 482
 483 precParsePat pat = returnRn pat
 484
 485
 486 data INFIX = INFIXL | INFIXR | INFIXN
 487
 488 lookupFixity :: RnName -> RnM_Fixes s (INFIX, Int)
 489 lookupFixity op
 490   = getExtraRn `thenRn` \ fixity_fm ->
 491     case lookupUFM fixity_fm op of
 492       Nothing           -> returnRn (INFIXL, 9)
 493       Just (InfixL _ n) -> returnRn (INFIXL, n)
 494       Just (InfixR _ n) -> returnRn (INFIXR, n)
 495       Just (InfixN _ n) -> returnRn (INFIXN, n)
 496 \end{code}
 497
 498 \begin{code}
 499 negPatErr pat src_loc
 500   = addErrLoc src_loc "prefix `-' not applied to literal in pattern" ( \sty ->
 501     ppr sty pat)
 502
 503 precParseNegPatErr op src_loc
 504   = addErrLoc src_loc "precedence parsing error" (\ sty ->
 505     ppBesides [ppStr "prefix `-' has lower precedence than ", pp_op sty op, ppStr " in pattern"])
 506
 507 precParseErr op1 op2 src_loc
 508   = addErrLoc src_loc "precedence parsing error" (\ sty ->
 509     ppBesides [ppStr "cannot mix ", pp_op sty op1, ppStr " and ", pp_op sty op2,
 510                ppStr " in the same infix expression"])
 511
 512 pp_op sty (op, fix, prec) = ppBesides [pprOp sty op, ppLparen, pp_fix fix, ppSP, ppInt prec, ppRparen]
 513 pp_fix INFIXL = ppStr "infixl"
 514 pp_fix INFIXR = ppStr "infixr"
 515 pp_fix INFIXN = ppStr "infix"
 516 \end{code}