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