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