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