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