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