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