compiler/hsSyn/HsExpr.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \begin{code}
   6
   7 -- | Abstract Haskell syntax for expressions.
   8 module HsExpr where
   9
  10 #include "HsVersions.h"
  11
  12 -- friends:
  13 import HsDecls
  14 import HsPat
  15 import HsLit
  16 import HsTypes
  17 import HsBinds
  18
  19 -- others:
  20 import Var
  21 import Name
  22 import BasicTypes
  23 import DataCon
  24 import SrcLoc
  25 import Outputable
  26 import FastString
  27 \end{code}
  28
  29
  30 %************************************************************************
  31 %*                                                                      *
  32 \subsection{Expressions proper}
  33 %*                                                                      *
  34 %************************************************************************
  35
  36 \begin{code}
  37 -- * Expressions proper
  38
  39 type LHsExpr id = Located (HsExpr id)
  40
  41 -------------------------
  42 -- | PostTcExpr is an evidence expression attached to the syntax tree by the
  43 -- type checker (c.f. postTcType).
  44 type PostTcExpr  = HsExpr Id
  45 -- | We use a PostTcTable where there are a bunch of pieces of evidence, more
  46 -- than is convenient to keep individually.
  47 type PostTcTable = [(Name, Id)]
  48
  49 noPostTcExpr :: PostTcExpr
  50 noPostTcExpr = HsLit (HsString (fsLit "noPostTcExpr"))
  51
  52 noPostTcTable :: PostTcTable
  53 noPostTcTable = []
  54
  55 -------------------------
  56 -- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
  57 -- by the renamer.  It's used for rebindable syntax.
  58 --
  59 -- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
  60 --      @(>>=)@, and then instantiated by the type checker with its type args
  61 --      tec
  62
  63 type SyntaxExpr id = HsExpr id
  64
  65 noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
  66                               -- (if the syntax slot makes no sense)
  67 noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr"))
  68
  69
  70 type SyntaxTable id = [(Name, SyntaxExpr id)]
  71 -- ^ Currently used only for 'CmdTop' (sigh)
  72 --
  73 -- * Before the renamer, this list is 'noSyntaxTable'
  74 --
  75 -- * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
  76 --   For example, for the 'return' op of a monad
  77 --
  78 --    * normal case:            @(GHC.Base.return, HsVar GHC.Base.return)@
  79 --
  80 --    * with rebindable syntax: @(GHC.Base.return, return_22)@
  81 --              where @return_22@ is whatever @return@ is in scope
  82 --
  83 -- * After the type checker, it takes the form @[(std_name, <expression>)]@
  84 --      where @<expression>@ is the evidence for the method
  85
  86 noSyntaxTable :: SyntaxTable id
  87 noSyntaxTable = []
  88
  89
  90 -------------------------
  91 -- | A Haskell expression.
  92 data HsExpr id
  93   = HsVar     id                        -- ^ variable
  94   | HsIPVar   (IPName id)               -- ^ implicit parameter
  95   | HsOverLit (HsOverLit id)            -- ^ Overloaded literals
  96
  97   | HsLit     HsLit                     -- ^ Simple (non-overloaded) literals
  98
  99   | HsLam     (MatchGroup id)           -- Currently always a single match
 100
 101   | HsApp     (LHsExpr id) (LHsExpr id) -- Application
 102
 103   -- Operator applications:
 104   -- NB Bracketed ops such as (+) come out as Vars.
 105
 106   -- NB We need an expr for the operator in an OpApp/Section since
 107   -- the typechecker may need to apply the operator to a few types.
 108
 109   | OpApp       (LHsExpr id)    -- left operand
 110                 (LHsExpr id)    -- operator
 111                 Fixity          -- Renamer adds fixity; bottom until then
 112                 (LHsExpr id)    -- right operand
 113
 114   | NegApp      (LHsExpr id)    -- negated expr
 115                 (SyntaxExpr id) -- Name of 'negate'
 116
 117   | HsPar       (LHsExpr id)    -- parenthesised expr
 118
 119   | SectionL    (LHsExpr id)    -- operand
 120                 (LHsExpr id)    -- operator
 121   | SectionR    (LHsExpr id)    -- operator
 122                 (LHsExpr id)    -- operand
 123
 124   | HsCase      (LHsExpr id)
 125                 (MatchGroup id)
 126
 127   | HsIf        (LHsExpr id)    --  predicate
 128                 (LHsExpr id)    --  then part
 129                 (LHsExpr id)    --  else part
 130
 131   | HsLet       (HsLocalBinds id) -- let(rec)
 132                 (LHsExpr  id)
 133
 134   | HsDo        (HsStmtContext Name) -- The parameterisation is unimportant
 135                                      -- because in this context we never use
 136                                      -- the PatGuard or ParStmt variant
 137                 [LStmt id]           -- "do":one or more stmts
 138                 (LHsExpr id)         -- The body; the last expression in the
 139                                      -- 'do' of [ body | ... ] in a list comp
 140                 PostTcType           -- Type of the whole expression
 141
 142   | ExplicitList                -- syntactic list
 143                 PostTcType      -- Gives type of components of list
 144                 [LHsExpr id]
 145
 146   | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
 147                 PostTcType      -- type of elements of the parallel array
 148                 [LHsExpr id]
 149
 150   | ExplicitTuple               -- tuple
 151                 [LHsExpr id]
 152                                 -- NB: Unit is ExplicitTuple []
 153                                 -- for tuples, we can get the types
 154                                 -- direct from the components
 155                 Boxity
 156
 157
 158   -- Record construction
 159   | RecordCon   (Located id)       -- The constructor.  After type checking
 160                                    -- it's the dataConWrapId of the constructor
 161                 PostTcExpr         -- Data con Id applied to type args
 162                 (HsRecordBinds id)
 163
 164   -- Record update
 165   | RecordUpd   (LHsExpr id)
 166                 (HsRecordBinds id)
 167 --              (HsMatchGroup Id)  -- Filled in by the type checker to be
 168 --                                 -- a match that does the job
 169                 [DataCon]          -- Filled in by the type checker to the
 170                                    -- _non-empty_ list of DataCons that have
 171                                    -- all the upd'd fields
 172                 [PostTcType]       -- Argument types of *input* record type
 173                 [PostTcType]       --              and  *output* record type
 174   -- For a type family, the arg types are of the *instance* tycon,
 175   -- not the family tycon
 176
 177   | ExprWithTySig                       -- e :: type
 178                 (LHsExpr id)
 179                 (LHsType id)
 180
 181   | ExprWithTySigOut                    -- TRANSLATION
 182                 (LHsExpr id)
 183                 (LHsType Name)          -- Retain the signature for
 184                                         -- round-tripping purposes
 185
 186   | ArithSeq                            -- arithmetic sequence
 187                 PostTcExpr
 188                 (ArithSeqInfo id)
 189
 190   | PArrSeq                             -- arith. sequence for parallel array
 191                 PostTcExpr              -- [:e1..e2:] or [:e1, e2..e3:]
 192                 (ArithSeqInfo id)
 193
 194   | HsSCC       FastString              -- "set cost centre" SCC pragma
 195                 (LHsExpr id)            -- expr whose cost is to be measured
 196
 197   | HsCoreAnn   FastString              -- hdaume: core annotation
 198                 (LHsExpr id)
 199
 200   -----------------------------------------------------------
 201   -- MetaHaskell Extensions
 202
 203   | HsBracket    (HsBracket id)
 204
 205   | HsBracketOut (HsBracket Name)       -- Output of the type checker is
 206                                         -- the *original*
 207                  [PendingSplice]        -- renamed expression, plus
 208                                         -- _typechecked_ splices to be
 209                                         -- pasted back in by the desugarer
 210
 211   | HsSpliceE (HsSplice id)
 212
 213   | HsQuasiQuoteE (HsQuasiQuote id)
 214         -- See Note [Quasi-quote overview] in TcSplice
 215
 216   -----------------------------------------------------------
 217   -- Arrow notation extension
 218
 219   | HsProc      (LPat id)               -- arrow abstraction, proc
 220                 (LHsCmdTop id)          -- body of the abstraction
 221                                         -- always has an empty stack
 222
 223   ---------------------------------------
 224   -- The following are commands, not expressions proper
 225
 226   | HsArrApp            -- Arrow tail, or arrow application (f -< arg)
 227         (LHsExpr id)    -- arrow expression, f
 228         (LHsExpr id)    -- input expression, arg
 229         PostTcType      -- type of the arrow expressions f,
 230                         -- of the form a t t', where arg :: t
 231         HsArrAppType    -- higher-order (-<<) or first-order (-<)
 232         Bool            -- True => right-to-left (f -< arg)
 233                         -- False => left-to-right (arg >- f)
 234
 235   | HsArrForm           -- Command formation,  (| e cmd1 .. cmdn |)
 236         (LHsExpr id)    -- the operator
 237                         -- after type-checking, a type abstraction to be
 238                         -- applied to the type of the local environment tuple
 239         (Maybe Fixity)  -- fixity (filled in by the renamer), for forms that
 240                         -- were converted from OpApp's by the renamer
 241         [LHsCmdTop id]  -- argument commands
 242
 243
 244   ---------------------------------------
 245   -- Haskell program coverage (Hpc) Support
 246
 247   | HsTick
 248      Int                                -- module-local tick number
 249      [id]                               -- variables in scope
 250      (LHsExpr id)                       -- sub-expression
 251
 252   | HsBinTick
 253      Int                                -- module-local tick number for True
 254      Int                                -- module-local tick number for False
 255      (LHsExpr id)                       -- sub-expression
 256
 257   | HsTickPragma                        -- A pragma introduced tick
 258      (FastString,(Int,Int),(Int,Int))   -- external span for this tick
 259      (LHsExpr id)
 260
 261   ---------------------------------------
 262   -- These constructors only appear temporarily in the parser.
 263   -- The renamer translates them into the Right Thing.
 264
 265   | EWildPat                 -- wildcard
 266
 267   | EAsPat      (Located id) -- as pattern
 268                 (LHsExpr id)
 269
 270   | EViewPat    (LHsExpr id) -- view pattern
 271                 (LHsExpr id)
 272
 273   | ELazyPat    (LHsExpr id) -- ~ pattern
 274
 275   | HsType      (LHsType id) -- Explicit type argument; e.g  f {| Int |} x y
 276
 277   ---------------------------------------
 278   -- Finally, HsWrap appears only in typechecker output
 279
 280   |  HsWrap     HsWrapper    -- TRANSLATION
 281                 (HsExpr id)
 282
 283 type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
 284                                         -- pasted back in by the desugarer
 285 \end{code}
 286
 287 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 288 @ClassDictLam dictvars methods expr@ is, therefore:
 289 \begin{verbatim}
 290 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 291 \end{verbatim}
 292
 293 \begin{code}
 294 instance OutputableBndr id => Outputable (HsExpr id) where
 295     ppr expr = pprExpr expr
 296 \end{code}
 297
 298 \begin{code}
 299 -----------------------
 300 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
 301 -- the underscore versions do not
 302 pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
 303 pprLExpr (L _ e) = pprExpr e
 304
 305 pprExpr :: OutputableBndr id => HsExpr id -> SDoc
 306 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
 307           | otherwise                           = pprDeeper (ppr_expr e)
 308
 309 isQuietHsExpr :: HsExpr id -> Bool
 310 -- Parentheses do display something, but it gives little info and
 311 -- if we go deeper when we go inside them then we get ugly things
 312 -- like (...)
 313 isQuietHsExpr (HsPar _) = True
 314 -- applications don't display anything themselves
 315 isQuietHsExpr (HsApp _ _) = True
 316 isQuietHsExpr (OpApp _ _ _ _) = True
 317 isQuietHsExpr _ = False
 318
 319 pprBinds :: (OutputableBndr idL, OutputableBndr idR)
 320          => HsLocalBindsLR idL idR -> SDoc
 321 pprBinds b = pprDeeper (ppr b)
 322
 323 -----------------------
 324 ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
 325 ppr_lexpr e = ppr_expr (unLoc e)
 326
 327 ppr_expr :: OutputableBndr id => HsExpr id -> SDoc
 328 ppr_expr (HsVar v)       = pprHsVar v
 329 ppr_expr (HsIPVar v)     = ppr v
 330 ppr_expr (HsLit lit)     = ppr lit
 331 ppr_expr (HsOverLit lit) = ppr lit
 332 ppr_expr (HsPar e)       = parens (ppr_lexpr e)
 333
 334 ppr_expr (HsCoreAnn s e)
 335   = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
 336
 337 ppr_expr (HsApp e1 e2)
 338   = let (fun, args) = collect_args e1 [e2] in
 339     hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
 340   where
 341     collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
 342     collect_args fun args = (fun, args)
 343
 344 ppr_expr (OpApp e1 op _ e2)
 345   = case unLoc op of
 346       HsVar v -> pp_infixly v
 347       _       -> pp_prefixly
 348   where
 349     pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
 350     pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
 351
 352     pp_prefixly
 353       = hang (ppr op) 2 (sep [pp_e1, pp_e2])
 354
 355     pp_infixly v
 356       = sep [nest 2 pp_e1, pprHsInfix v, nest 2 pp_e2]
 357
 358 ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
 359
 360 ppr_expr (SectionL expr op)
 361   = case unLoc op of
 362       HsVar v -> pp_infixly v
 363       _       -> pp_prefixly
 364   where
 365     pp_expr = pprDebugParendExpr expr
 366
 367     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
 368                        4 (hsep [pp_expr, ptext (sLit "x_ )")])
 369     pp_infixly v = (sep [pp_expr, pprHsInfix v])
 370
 371 ppr_expr (SectionR op expr)
 372   = case unLoc op of
 373       HsVar v -> pp_infixly v
 374       _       -> pp_prefixly
 375   where
 376     pp_expr = pprDebugParendExpr expr
 377
 378     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
 379                        4 ((<>) pp_expr rparen)
 380     pp_infixly v
 381       = (sep [pprHsInfix v, pp_expr])
 382
 383 --avoid using PatternSignatures for stage1 code portability
 384 ppr_expr exprType@(HsLam matches)
 385   = pprMatches (LambdaExpr `asTypeOf` idType exprType) matches
 386  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
 387
 388 ppr_expr exprType@(HsCase expr matches)
 389   = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
 390           nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches <+> char '}') ]
 391  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
 392
 393 ppr_expr (HsIf e1 e2 e3)
 394   = sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
 395          nest 4 (ppr e2),
 396          ptext (sLit "else"),
 397          nest 4 (ppr e3)]
 398
 399 -- special case: let ... in let ...
 400 ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
 401   = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
 402          ppr_lexpr expr]
 403
 404 ppr_expr (HsLet binds expr)
 405   = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
 406          hang (ptext (sLit "in"))  2 (ppr expr)]
 407
 408 ppr_expr (HsDo do_or_list_comp stmts body _) = pprDo do_or_list_comp stmts body
 409
 410 ppr_expr (ExplicitList _ exprs)
 411   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
 412
 413 ppr_expr (ExplicitPArr _ exprs)
 414   = pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
 415
 416 ppr_expr (ExplicitTuple exprs boxity)
 417   = tupleParens boxity (sep (punctuate comma (map ppr_lexpr exprs)))
 418
 419 ppr_expr (RecordCon con_id _ rbinds)
 420   = hang (ppr con_id) 2 (ppr rbinds)
 421
 422 ppr_expr (RecordUpd aexp rbinds _ _ _)
 423   = hang (pprParendExpr aexp) 2 (ppr rbinds)
 424
 425 ppr_expr (ExprWithTySig expr sig)
 426   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
 427          4 (ppr sig)
 428 ppr_expr (ExprWithTySigOut expr sig)
 429   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
 430          4 (ppr sig)
 431
 432 ppr_expr (ArithSeq _ info) = brackets (ppr info)
 433 ppr_expr (PArrSeq  _ info) = pa_brackets (ppr info)
 434
 435 ppr_expr EWildPat       = char '_'
 436 ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
 437 ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
 438 ppr_expr (EViewPat p e) = ppr p <+> ptext (sLit "->") <+> ppr e
 439
 440 ppr_expr (HsSCC lbl expr)
 441   = sep [ ptext (sLit "_scc_") <+> doubleQuotes (ftext lbl),
 442           pprParendExpr expr ]
 443
 444 ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
 445 ppr_expr (HsType id)      = ppr id
 446
 447 ppr_expr (HsSpliceE s)       = pprSplice s
 448 ppr_expr (HsBracket b)       = pprHsBracket b
 449 ppr_expr (HsBracketOut e []) = ppr e
 450 ppr_expr (HsBracketOut e ps) = ppr e $$ ptext (sLit "pending") <+> ppr ps
 451 ppr_expr (HsQuasiQuoteE qq)  = ppr qq
 452
 453 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
 454   = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
 455
 456 ppr_expr (HsTick tickId vars exp)
 457   = hcat [ptext (sLit "tick<"),
 458           ppr tickId,
 459           ptext (sLit ">("),
 460           hsep (map pprHsVar vars),
 461           ppr exp,
 462           ptext (sLit ")")]
 463 ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
 464   = hcat [ptext (sLit "bintick<"),
 465           ppr tickIdTrue,
 466           ptext (sLit ","),
 467           ppr tickIdFalse,
 468           ptext (sLit ">("),
 469           ppr exp,ptext (sLit ")")]
 470 ppr_expr (HsTickPragma externalSrcLoc exp)
 471   = hcat [ptext (sLit "tickpragma<"),
 472           ppr externalSrcLoc,
 473           ptext (sLit ">("),
 474           ppr exp,
 475           ptext (sLit ")")]
 476
 477 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
 478   = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
 479 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
 480   = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
 481 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
 482   = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
 483 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
 484   = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
 485
 486 ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
 487   = sep [pprCmdArg (unLoc arg1), hsep [pprHsInfix v, pprCmdArg (unLoc arg2)]]
 488 ppr_expr (HsArrForm op _ args)
 489   = hang (ptext (sLit "(|") <> ppr_lexpr op)
 490          4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
 491
 492 pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
 493 pprCmdArg (HsCmdTop cmd@(L _ (HsArrForm _ Nothing [])) _ _ _)
 494   = ppr_lexpr cmd
 495 pprCmdArg (HsCmdTop cmd _ _ _)
 496   = parens (ppr_lexpr cmd)
 497
 498 instance OutputableBndr id => Outputable (HsCmdTop id) where
 499     ppr = pprCmdArg
 500
 501 -- add parallel array brackets around a document
 502 --
 503 pa_brackets :: SDoc -> SDoc
 504 pa_brackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
 505 \end{code}
 506
 507 HsSyn records exactly where the user put parens, with HsPar.
 508 So generally speaking we print without adding any parens.
 509 However, some code is internally generated, and in some places
 510 parens are absolutely required; so for these places we use
 511 pprParendExpr (but don't print double parens of course).
 512
 513 For operator applications we don't add parens, because the oprerator
 514 fixities should do the job, except in debug mode (-dppr-debug) so we
 515 can see the structure of the parse tree.
 516
 517 \begin{code}
 518 pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
 519 pprDebugParendExpr expr
 520   = getPprStyle (\sty ->
 521     if debugStyle sty then pprParendExpr expr
 522                       else pprLExpr      expr)
 523
 524 pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
 525 pprParendExpr expr
 526   = let
 527         pp_as_was = pprLExpr expr
 528         -- Using pprLExpr makes sure that we go 'deeper'
 529         -- I think that is usually (always?) right
 530     in
 531     case unLoc expr of
 532       HsLit _              -> pp_as_was
 533       HsOverLit _          -> pp_as_was
 534       HsVar _              -> pp_as_was
 535       HsIPVar _            -> pp_as_was
 536       ExplicitList _ _     -> pp_as_was
 537       ExplicitPArr _ _     -> pp_as_was
 538       ExplicitTuple _ _    -> pp_as_was
 539       HsPar _              -> pp_as_was
 540       HsBracket _          -> pp_as_was
 541       HsBracketOut _ []    -> pp_as_was
 542       HsDo sc _ _ _
 543        | isListCompExpr sc -> pp_as_was
 544       _                    -> parens pp_as_was
 545
 546 isAtomicHsExpr :: HsExpr id -> Bool -- A single token
 547 isAtomicHsExpr (HsVar {})     = True
 548 isAtomicHsExpr (HsLit {})     = True
 549 isAtomicHsExpr (HsOverLit {}) = True
 550 isAtomicHsExpr (HsIPVar {})   = True
 551 isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
 552 isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
 553 isAtomicHsExpr _              = False
 554 \end{code}
 555
 556 %************************************************************************
 557 %*                                                                      *
 558 \subsection{Commands (in arrow abstractions)}
 559 %*                                                                      *
 560 %************************************************************************
 561
 562 We re-use HsExpr to represent these.
 563
 564 \begin{code}
 565 type HsCmd id = HsExpr id
 566
 567 type LHsCmd id = LHsExpr id
 568
 569 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
 570 \end{code}
 571
 572 The legal constructors for commands are:
 573
 574   = HsArrApp ...                -- as above
 575
 576   | HsArrForm ...               -- as above
 577
 578   | HsApp       (HsCmd id)
 579                 (HsExpr id)
 580
 581   | HsLam       (Match  id)     -- kappa
 582
 583   -- the renamer turns this one into HsArrForm
 584   | OpApp       (HsExpr id)     -- left operand
 585                 (HsCmd id)      -- operator
 586                 Fixity          -- Renamer adds fixity; bottom until then
 587                 (HsCmd id)      -- right operand
 588
 589   | HsPar       (HsCmd id)      -- parenthesised command
 590
 591   | HsCase      (HsExpr id)
 592                 [Match id]      -- bodies are HsCmd's
 593                 SrcLoc
 594
 595   | HsIf        (HsExpr id)     --  predicate
 596                 (HsCmd id)      --  then part
 597                 (HsCmd id)      --  else part
 598                 SrcLoc
 599
 600   | HsLet       (HsLocalBinds id)       -- let(rec)
 601                 (HsCmd  id)
 602
 603   | HsDo        (HsStmtContext Name)    -- The parameterisation is unimportant
 604                                         -- because in this context we never use
 605                                         -- the PatGuard or ParStmt variant
 606                 [Stmt id]       -- HsExpr's are really HsCmd's
 607                 PostTcType      -- Type of the whole expression
 608                 SrcLoc
 609
 610 Top-level command, introducing a new arrow.
 611 This may occur inside a proc (where the stack is empty) or as an
 612 argument of a command-forming operator.
 613
 614 \begin{code}
 615 type LHsCmdTop id = Located (HsCmdTop id)
 616
 617 data HsCmdTop id
 618   = HsCmdTop (LHsCmd id)
 619              [PostTcType]     -- types of inputs on the command's stack
 620              PostTcType       -- return type of the command
 621              (SyntaxTable id) -- after type checking:
 622                               -- names used in the command's desugaring
 623 \end{code}
 624
 625 %************************************************************************
 626 %*                                                                      *
 627 \subsection{Record binds}
 628 %*                                                                      *
 629 %************************************************************************
 630
 631 \begin{code}
 632 type HsRecordBinds id = HsRecFields id (LHsExpr id)
 633 \end{code}
 634
 635
 636
 637 %************************************************************************
 638 %*                                                                      *
 639 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
 640 %*                                                                      *
 641 %************************************************************************
 642
 643 @Match@es are sets of pattern bindings and right hand sides for
 644 functions, patterns or case branches. For example, if a function @g@
 645 is defined as:
 646 \begin{verbatim}
 647 g (x,y) = y
 648 g ((x:ys),y) = y+1,
 649 \end{verbatim}
 650 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
 651
 652 It is always the case that each element of an @[Match]@ list has the
 653 same number of @pats@s inside it.  This corresponds to saying that
 654 a function defined by pattern matching must have the same number of
 655 patterns in each equation.
 656
 657 \begin{code}
 658 data MatchGroup id
 659   = MatchGroup
 660         [LMatch id]     -- The alternatives
 661         PostTcType      -- The type is the type of the entire group
 662                         --      t1 -> ... -> tn -> tr
 663                         -- where there are n patterns
 664
 665 type LMatch id = Located (Match id)
 666
 667 data Match id
 668   = Match
 669         [LPat id]               -- The patterns
 670         (Maybe (LHsType id))    -- A type signature for the result of the match
 671                                 -- Nothing after typechecking
 672         (GRHSs id)
 673
 674 isEmptyMatchGroup :: MatchGroup id -> Bool
 675 isEmptyMatchGroup (MatchGroup ms _) = null ms
 676
 677 matchGroupArity :: MatchGroup id -> Arity
 678 matchGroupArity (MatchGroup [] _)
 679   = panic "matchGroupArity"     -- Precondition: MatchGroup is non-empty
 680 matchGroupArity (MatchGroup (match:matches) _)
 681   = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
 682     -- Assertion just checks that all the matches have the same number of pats
 683     n_pats
 684   where
 685     n_pats = length (hsLMatchPats match)
 686
 687 hsLMatchPats :: LMatch id -> [LPat id]
 688 hsLMatchPats (L _ (Match pats _ _)) = pats
 689
 690 -- | GRHSs are used both for pattern bindings and for Matches
 691 data GRHSs id
 692   = GRHSs {
 693       grhssGRHSs :: [LGRHS id],  -- ^ Guarded RHSs
 694       grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
 695     }
 696
 697 type LGRHS id = Located (GRHS id)
 698
 699 -- | Guarded Right Hand Side.
 700 data GRHS id = GRHS [LStmt id]   -- Guards
 701                     (LHsExpr id) -- Right hand side
 702 \end{code}
 703
 704 We know the list must have at least one @Match@ in it.
 705
 706 \begin{code}
 707 pprMatches :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> MatchGroup idR -> SDoc
 708 pprMatches ctxt (MatchGroup matches _)
 709     = vcat (map (pprMatch ctxt) (map unLoc matches))
 710       -- Don't print the type; it's only a place-holder before typechecking
 711
 712 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 713 pprFunBind :: (OutputableBndr idL, OutputableBndr idR) => idL -> Bool -> MatchGroup idR -> SDoc
 714 pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
 715
 716 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 717 pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
 718            => LPat bndr -> GRHSs id -> SDoc
 719 pprPatBind pat ty@(grhss)
 720  = sep [ppr pat, nest 4 (pprGRHSs (PatBindRhs `asTypeOf` idType ty) grhss)]
 721 --avoid using PatternSignatures for stage1 code portability
 722  where idType :: GRHSs id -> HsMatchContext id; idType = undefined
 723
 724
 725 pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
 726 pprMatch ctxt (Match pats maybe_ty grhss)
 727   = herald <+> sep [sep (map ppr other_pats),
 728                     ppr_maybe_ty,
 729                     nest 2 (pprGRHSs ctxt grhss)]
 730   where
 731     (herald, other_pats)
 732         = case ctxt of
 733             FunRhs fun is_infix
 734                 | not is_infix -> (ppr fun, pats)
 735                         -- f x y z = e
 736                         -- Not pprBndr; the AbsBinds will
 737                         -- have printed the signature
 738
 739                 | null pats3 -> (pp_infix, [])
 740                         -- x &&& y = e
 741
 742                 | otherwise -> (parens pp_infix, pats3)
 743                         -- (x &&& y) z = e
 744                 where
 745                   (pat1:pat2:pats3) = pats
 746                   pp_infix = ppr pat1 <+> ppr fun <+> ppr pat2
 747
 748             LambdaExpr -> (char '\\', pats)
 749             _          -> (empty,     pats)
 750
 751     ppr_maybe_ty = case maybe_ty of
 752                         Just ty -> dcolon <+> ppr ty
 753                         Nothing -> empty
 754
 755
 756 pprGRHSs :: (OutputableBndr idL, OutputableBndr idR)
 757          => HsMatchContext idL -> GRHSs idR -> SDoc
 758 pprGRHSs ctxt (GRHSs grhss binds)
 759   = vcat (map (pprGRHS ctxt . unLoc) grhss)
 760  $$ if isEmptyLocalBinds binds then empty
 761                                else text "where" $$ nest 4 (pprBinds binds)
 762
 763 pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
 764         => HsMatchContext idL -> GRHS idR -> SDoc
 765
 766 pprGRHS ctxt (GRHS [] expr)
 767  =  pp_rhs ctxt expr
 768
 769 pprGRHS ctxt (GRHS guards expr)
 770  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
 771
 772 pp_rhs :: OutputableBndr idR => HsMatchContext idL -> LHsExpr idR -> SDoc
 773 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 774 \end{code}
 775
 776 %************************************************************************
 777 %*                                                                      *
 778 \subsection{Do stmts and list comprehensions}
 779 %*                                                                      *
 780 %************************************************************************
 781
 782 \begin{code}
 783 type LStmt id = Located (StmtLR id id)
 784 type LStmtLR idL idR = Located (StmtLR idL idR)
 785
 786 type Stmt id = StmtLR id id
 787
 788 data GroupByClause id
 789     = GroupByNothing (LHsExpr id) -- Using expression, i.e.
 790                                   -- "then group using f" ==> GroupByNothing f
 791     | GroupBySomething (Either (LHsExpr id) (SyntaxExpr id)) (LHsExpr id)
 792       -- "then group using f by e" ==> GroupBySomething (Left f) e
 793       -- "then group by e"         ==> GroupBySomething (Right _) e: in
 794       --                               this case the expression is filled
 795       --                               in by the renamer
 796
 797 -- The SyntaxExprs in here are used *only* for do-notation, which
 798 -- has rebindable syntax.  Otherwise they are unused.
 799 data StmtLR idL idR
 800   = BindStmt (LPat idL)
 801              (LHsExpr idR)
 802              (SyntaxExpr idR) -- The (>>=) operator
 803              (SyntaxExpr idR) -- The fail operator
 804              -- The fail operator is noSyntaxExpr
 805              -- if the pattern match can't fail
 806
 807   | ExprStmt (LHsExpr idR)
 808              (SyntaxExpr idR) -- The (>>) operator
 809              PostTcType       -- Element type of the RHS (used for arrows)
 810
 811   | LetStmt  (HsLocalBindsLR idL idR)
 812
 813   -- ParStmts only occur in a list comprehension
 814   | ParStmt  [([LStmt idL], [idR])]
 815   -- After renaming, the ids are the binders bound by the stmts and used
 816   -- after them
 817
 818   | TransformStmt ([LStmt idL], [idR]) (LHsExpr idR) (Maybe (LHsExpr idR))
 819   -- After renaming, the IDs are the binders occurring within this
 820   -- transform statement that are used after it
 821   -- "qs, then f by e" ==> TransformStmt (qs, binders) f (Just e)
 822   -- "qs, then f"      ==> TransformStmt (qs, binders) f Nothing
 823
 824   | GroupStmt ([LStmt idL], [(idR, idR)]) (GroupByClause idR)
 825   -- After renaming, the IDs are the binders occurring within this
 826   -- transform statement that are used after it which are paired with
 827   -- the names which they group over in statements
 828
 829   -- Recursive statement (see Note [RecStmt] below)
 830   | RecStmt  [LStmtLR idL idR]
 831              --- The next two fields are only valid after renaming
 832              [idR] -- The ids are a subset of the variables bound by the
 833                    -- stmts that are used in stmts that follow the RecStmt
 834
 835              [idR] -- Ditto, but these variables are the "recursive" ones,
 836                    -- that are used before they are bound in the stmts of
 837                    -- the RecStmt. From a type-checking point of view,
 838                    -- these ones have to be monomorphic
 839
 840              --- These fields are only valid after typechecking
 841              [PostTcExpr]       -- These expressions correspond 1-to-1 with
 842                                 -- the "recursive" [id], and are the
 843                                 -- expressions that should be returned by
 844                                 -- the recursion.
 845                                 -- They may not quite be the Ids themselves,
 846                                 -- because the Id may be *polymorphic*, but
 847                                 -- the returned thing has to be *monomorphic*.
 848              (DictBinds idR)    -- Method bindings of Ids bound by the
 849                                 -- RecStmt, and used afterwards
 850 \end{code}
 851
 852 ExprStmts are a bit tricky, because what they mean
 853 depends on the context.  Consider the following contexts:
 854
 855         A do expression of type (m res_ty)
 856         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 857         * ExprStmt E any_ty:   do { ....; E; ... }
 858                 E :: m any_ty
 859           Translation: E >> ...
 860
 861         A list comprehensions of type [elt_ty]
 862         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 863         * ExprStmt E Bool:   [ .. | .... E ]
 864                         [ .. | ..., E, ... ]
 865                         [ .. | .... | ..., E | ... ]
 866                 E :: Bool
 867           Translation: if E then fail else ...
 868
 869         A guard list, guarding a RHS of type rhs_ty
 870         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 871         * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
 872                 E :: Bool
 873           Translation: if E then fail else ...
 874
 875 Array comprehensions are handled like list comprehensions -=chak
 876
 877 Note [RecStmt]
 878 ~~~~~~~~~~~~~~
 879 Example:
 880         HsDo [ BindStmt x ex
 881
 882              , RecStmt [a::forall a. a -> a, b]
 883                        [a::Int -> Int,       c]
 884                        [ BindStmt b (return x)
 885                        , LetStmt a = ea
 886                        , BindStmt c ec ]
 887
 888              , return (a b) ]
 889
 890 Here, the RecStmt binds a,b,c; but
 891   - Only a,b are used in the stmts *following* the RecStmt,
 892         This 'a' is *polymorphic'
 893   - Only a,c are used in the stmts *inside* the RecStmt
 894         *before* their bindings
 895         This 'a' is monomorphic
 896
 897 Nota Bene: the two a's have different types, even though they
 898 have the same Name.
 899
 900
 901 \begin{code}
 902 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) where
 903     ppr stmt = pprStmt stmt
 904
 905 pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
 906 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, ptext (sLit "<-"), ppr expr]
 907 pprStmt (LetStmt binds)           = hsep [ptext (sLit "let"), pprBinds binds]
 908 pprStmt (ExprStmt expr _ _)       = ppr expr
 909 pprStmt (ParStmt stmtss)          = hsep (map doStmts stmtss)
 910   where doStmts stmts = ptext (sLit "| ") <> ppr stmts
 911 pprStmt (TransformStmt (stmts, _) usingExpr maybeByExpr)
 912     = (hsep [stmtsDoc, ptext (sLit "then"), ppr usingExpr, byExprDoc])
 913   where stmtsDoc = interpp'SP stmts
 914         byExprDoc = maybe empty (\byExpr -> hsep [ptext (sLit "by"), ppr byExpr]) maybeByExpr
 915 pprStmt (GroupStmt (stmts, _) groupByClause) = (hsep [stmtsDoc, ptext (sLit "then group"), pprGroupByClause groupByClause])
 916   where stmtsDoc = interpp'SP stmts
 917 pprStmt (RecStmt segment _ _ _ _) = ptext (sLit "rec") <+> braces (vcat (map ppr segment))
 918
 919 pprGroupByClause :: (OutputableBndr id) => GroupByClause id -> SDoc
 920 pprGroupByClause (GroupByNothing usingExpr) = hsep [ptext (sLit "using"), ppr usingExpr]
 921 pprGroupByClause (GroupBySomething eitherUsingExpr byExpr) = hsep [ptext (sLit "by"), ppr byExpr, usingExprDoc]
 922   where usingExprDoc = either (\usingExpr -> hsep [ptext (sLit "using"), ppr usingExpr]) (const empty) eitherUsingExpr
 923
 924 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
 925 pprDo DoExpr      stmts body = ptext (sLit "do")  <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
 926 pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
 927 pprDo ListComp    stmts body = pprComp brackets    stmts body
 928 pprDo PArrComp    stmts body = pprComp pa_brackets stmts body
 929 pprDo _           _     _    = panic "pprDo" -- PatGuard, ParStmtCxt
 930
 931 pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
 932 pprComp brack quals body
 933   = brack $
 934         hang (ppr body <+> char '|')
 935              4 (interpp'SP quals)
 936 \end{code}
 937
 938 %************************************************************************
 939 %*                                                                      *
 940                 Template Haskell quotation brackets
 941 %*                                                                      *
 942 %************************************************************************
 943
 944 \begin{code}
 945 data HsSplice id  = HsSplice            --  $z  or $(f 4)
 946                         id              -- The id is just a unique name to
 947                         (LHsExpr id)    -- identify this splice point
 948
 949 instance OutputableBndr id => Outputable (HsSplice id) where
 950   ppr = pprSplice
 951
 952 pprSplice :: OutputableBndr id => HsSplice id -> SDoc
 953 pprSplice (HsSplice n e)
 954     = char '$' <> ifPprDebug (brackets (ppr n)) <> pprParendExpr e
 955
 956
 957 data HsBracket id = ExpBr (LHsExpr id)          -- [|  expr  |]
 958                   | PatBr (LPat id)             -- [p| pat   |]
 959                   | DecBr (HsGroup id)          -- [d| decls |]
 960                   | TypBr (LHsType id)          -- [t| type  |]
 961                   | VarBr id                    -- 'x, ''T
 962
 963 instance OutputableBndr id => Outputable (HsBracket id) where
 964   ppr = pprHsBracket
 965
 966
 967 pprHsBracket :: OutputableBndr id => HsBracket id -> SDoc
 968 pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
 969 pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
 970 pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
 971 pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
 972 pprHsBracket (VarBr n) = char '\'' <> ppr n
 973 -- Infelicity: can't show ' vs '', because
 974 -- we can't ask n what its OccName is, because the
 975 -- pretty-printer for HsExpr doesn't ask for NamedThings
 976 -- But the pretty-printer for names will show the OccName class
 977
 978 thBrackets :: SDoc -> SDoc -> SDoc
 979 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
 980                              pp_body <+> ptext (sLit "|]")
 981 \end{code}
 982
 983 %************************************************************************
 984 %*                                                                      *
 985 \subsection{Enumerations and list comprehensions}
 986 %*                                                                      *
 987 %************************************************************************
 988
 989 \begin{code}
 990 data ArithSeqInfo id
 991   = From            (LHsExpr id)
 992   | FromThen        (LHsExpr id)
 993                     (LHsExpr id)
 994   | FromTo          (LHsExpr id)
 995                     (LHsExpr id)
 996   | FromThenTo      (LHsExpr id)
 997                     (LHsExpr id)
 998                     (LHsExpr id)
 999 \end{code}
1000
1001 \begin{code}
1002 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
1003     ppr (From e1)             = hcat [ppr e1, pp_dotdot]
1004     ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
1005     ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]
1006     ppr (FromThenTo e1 e2 e3)
1007       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
1008
1009 pp_dotdot :: SDoc
1010 pp_dotdot = ptext (sLit " .. ")
1011 \end{code}
1012
1013
1014 %************************************************************************
1015 %*                                                                      *
1016 \subsection{HsMatchCtxt}
1017 %*                                                                      *
1018 %************************************************************************
1019
1020 \begin{code}
1021 data HsMatchContext id  -- Context of a Match
1022   = FunRhs id Bool              -- Function binding for f; True <=> written infix
1023   | CaseAlt                     -- Guard on a case alternative
1024   | LambdaExpr                  -- Pattern of a lambda
1025   | ProcExpr                    -- Pattern of a proc
1026   | PatBindRhs                  -- Pattern binding
1027   | RecUpd                      -- Record update [used only in DsExpr to
1028                                 --    tell matchWrapper what sort of
1029                                 --    runtime error message to generate]
1030   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
1031   deriving ()
1032
1033 data HsStmtContext id
1034   = ListComp
1035   | DoExpr
1036   | MDoExpr PostTcTable                  -- Recursive do-expression
1037                                          -- (tiresomely, it needs table
1038                                          --  of its return/bind ops)
1039   | PArrComp                             -- Parallel array comprehension
1040   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
1041   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
1042   | TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt
1043 \end{code}
1044
1045 \begin{code}
1046 isDoExpr :: HsStmtContext id -> Bool
1047 isDoExpr DoExpr      = True
1048 isDoExpr (MDoExpr _) = True
1049 isDoExpr _           = False
1050
1051 isListCompExpr :: HsStmtContext id -> Bool
1052 isListCompExpr ListComp = True
1053 isListCompExpr PArrComp = True
1054 isListCompExpr _        = False
1055 \end{code}
1056
1057 \begin{code}
1058 matchSeparator :: HsMatchContext id -> SDoc
1059 matchSeparator (FunRhs {})  = ptext (sLit "=")
1060 matchSeparator CaseAlt      = ptext (sLit "->")
1061 matchSeparator LambdaExpr   = ptext (sLit "->")
1062 matchSeparator ProcExpr     = ptext (sLit "->")
1063 matchSeparator PatBindRhs   = ptext (sLit "=")
1064 matchSeparator (StmtCtxt _) = ptext (sLit "<-")
1065 matchSeparator RecUpd       = panic "unused"
1066 \end{code}
1067
1068 \begin{code}
1069 pprMatchContext :: Outputable id => HsMatchContext id -> SDoc
1070 pprMatchContext (FunRhs fun _)    = ptext (sLit "the definition of")
1071                                     <+> quotes (ppr fun)
1072 pprMatchContext CaseAlt           = ptext (sLit "a case alternative")
1073 pprMatchContext RecUpd            = ptext (sLit "a record-update construct")
1074 pprMatchContext PatBindRhs        = ptext (sLit "a pattern binding")
1075 pprMatchContext LambdaExpr        = ptext (sLit "a lambda abstraction")
1076 pprMatchContext ProcExpr          = ptext (sLit "an arrow abstraction")
1077 pprMatchContext (StmtCtxt ctxt)   = ptext (sLit "a pattern binding in")
1078                                     $$ pprStmtContext ctxt
1079
1080 pprStmtContext :: Outputable id => HsStmtContext id -> SDoc
1081 pprStmtContext (ParStmtCtxt c)
1082  = sep [ptext (sLit "a parallel branch of"), pprStmtContext c]
1083 pprStmtContext (TransformStmtCtxt c)
1084  = sep [ptext (sLit "a transformed branch of"), pprStmtContext c]
1085 pprStmtContext (PatGuard ctxt)
1086  = ptext (sLit "a pattern guard for") $$ pprMatchContext ctxt
1087 pprStmtContext DoExpr          = ptext (sLit "a 'do' expression")
1088 pprStmtContext (MDoExpr _)     = ptext (sLit "an 'mdo' expression")
1089 pprStmtContext ListComp        = ptext (sLit "a list comprehension")
1090 pprStmtContext PArrComp        = ptext (sLit "an array comprehension")
1091
1092 {-
1093 pprMatchRhsContext (FunRhs fun) = ptext (sLit "a right-hand side of function") <+> quotes (ppr fun)
1094 pprMatchRhsContext CaseAlt      = ptext (sLit "the body of a case alternative")
1095 pprMatchRhsContext PatBindRhs   = ptext (sLit "the right-hand side of a pattern binding")
1096 pprMatchRhsContext LambdaExpr   = ptext (sLit "the body of a lambda")
1097 pprMatchRhsContext ProcExpr     = ptext (sLit "the body of a proc")
1098 pprMatchRhsContext other        = panic "pprMatchRhsContext"    -- RecUpd, StmtCtxt
1099
1100 -- Used for the result statement of comprehension
1101 -- e.g. the 'e' in      [ e | ... ]
1102 --      or the 'r' in   f x = r
1103 pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
1104 pprStmtResultContext other           = ptext (sLit "the result of") <+> pprStmtContext other
1105 -}
1106
1107 -- Used to generate the string for a *runtime* error message
1108 matchContextErrString :: Outputable id => HsMatchContext id -> String
1109 matchContextErrString (FunRhs fun _)             = "function " ++ showSDoc (ppr fun)
1110 matchContextErrString CaseAlt                    = "case"
1111 matchContextErrString PatBindRhs                 = "pattern binding"
1112 matchContextErrString RecUpd                     = "record update"
1113 matchContextErrString LambdaExpr                 = "lambda"
1114 matchContextErrString ProcExpr                   = "proc"
1115 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1116 matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1117 matchContextErrString (StmtCtxt (PatGuard _))    = "pattern guard"
1118 matchContextErrString (StmtCtxt DoExpr)          = "'do' expression"
1119 matchContextErrString (StmtCtxt (MDoExpr _))     = "'mdo' expression"
1120 matchContextErrString (StmtCtxt ListComp)        = "list comprehension"
1121 matchContextErrString (StmtCtxt PArrComp)        = "array comprehension"
1122 \end{code}
1123
1124 \begin{code}
1125 pprMatchInCtxt :: (OutputableBndr idL, OutputableBndr idR)
1126                => HsMatchContext idL -> Match idR -> SDoc
1127 pprMatchInCtxt ctxt match  = hang (ptext (sLit "In") <+> pprMatchContext ctxt <> colon)
1128                              4 (pprMatch ctxt match)
1129
1130 pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR)
1131                => HsStmtContext idL -> StmtLR idL idR -> SDoc
1132 pprStmtInCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprStmtContext ctxt <> colon)
1133                           4 (ppr stmt)
1134 \end{code}