compiler/hsSyn/HsExpr.lhs

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