HsExpr.lhs 59.7 KB
Newer Older
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, ScopedTypeVariables #-}
7 8

-- | Abstract Haskell syntax for expressions.
9 10
module HsExpr where

11
#include "HsVersions.h"
12 13

-- friends:
14 15 16 17 18
import HsDecls
import HsPat
import HsLit
import HsTypes
import HsBinds
19 20

-- others:
21
import TcEvidence
22
import CoreSyn
23
import Var
24
import RdrName
25 26
import Name
import BasicTypes
27
import DataCon
28
import SrcLoc
29
import Util
30
import StaticFlags( opt_PprStyle_Debug )
Ian Lynagh's avatar
Ian Lynagh committed
31
import Outputable
32
import FastString
33 34 35

-- libraries:
import Data.Data hiding (Fixity)
36 37
\end{code}

38

39
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
40
%*                                                                      *
41
\subsection{Expressions proper}
Ian Lynagh's avatar
Ian Lynagh committed
42
%*                                                                      *
43 44 45
%************************************************************************

\begin{code}
46 47
-- * Expressions proper

48 49
type LHsExpr id = Located (HsExpr id)

50
-------------------------
51 52
-- | PostTcExpr is an evidence expression attached to the syntax tree by the
-- type checker (c.f. postTcType).
53
type PostTcExpr  = HsExpr Id
54 55
-- | We use a PostTcTable where there are a bunch of pieces of evidence, more
-- than is convenient to keep individually.
56
type PostTcTable = [(Name, PostTcExpr)]
57 58

noPostTcExpr :: PostTcExpr
Ian Lynagh's avatar
Ian Lynagh committed
59
noPostTcExpr = HsLit (HsString (fsLit "noPostTcExpr"))
60 61 62 63 64

noPostTcTable :: PostTcTable
noPostTcTable = []

-------------------------
65
-- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
Ian Lynagh's avatar
Ian Lynagh committed
66
-- by the renamer.  It's used for rebindable syntax.
67 68 69
--
-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
--      @(>>=)@, and then instantiated by the type checker with its type args
70
--      etc
71 72 73

type SyntaxExpr id = HsExpr id

Ian Lynagh's avatar
Ian Lynagh committed
74 75
noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
                              -- (if the syntax slot makes no sense)
Ian Lynagh's avatar
Ian Lynagh committed
76
noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr"))
77 78


79 80
type CmdSyntaxTable id = [(Name, SyntaxExpr id)]
-- See Note [CmdSyntaxTable]
81

82
noSyntaxTable :: CmdSyntaxTable id
83
noSyntaxTable = []
84
\end{code}
85

86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
Note [CmdSyntaxtable]
~~~~~~~~~~~~~~~~~~~~~
Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps
track of the methods needed for a Cmd.

* Before the renamer, this list is 'noSyntaxTable'

* After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
  For example, for the 'arr' method
   * normal case:            (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr)
   * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22)
             where @arr_22@ is whatever 'arr' is in scope

* After the type checker, it takes the form [(std_name, <expression>)]
  where <expression> is the evidence for the method.  This evidence is
  instantiated with the class, but is still polymorphic in everything
  else.  For example, in the case of 'arr', the evidence has type
         forall b c. (b->c) -> a b c
  where 'a' is the ambient type of the arrow.  This polymorphism is
  important because the desugarer uses the same evidence at multiple
  different types.

This is Less Cool than what we normally do for rebindable syntax, which is to
make fully-instantiated piece of evidence at every use site.  The Cmd way
is Less Cool because
  * The renamer has to predict which methods are needed.
    See the tedious RnExpr.methodNamesCmd.

  * The desugarer has to know the polymorphic type of the instantiated
    method. This is checked by Inst.tcSyntaxName, but is less flexible
    than the rest of rebindable syntax, where the type is less
    pre-ordained.  (And this flexibility is useful; for example we can
    typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
119

120 121

\begin{code}
122
-- | A Haskell expression.
123
data HsExpr id
124
  = HsVar     id                        -- ^ variable
125
  | HsIPVar   HsIPName                  -- ^ implicit parameter
126
  | HsOverLit (HsOverLit id)            -- ^ Overloaded literals
127

128
  | HsLit     HsLit                     -- ^ Simple (non-overloaded) literals
129

130
  | HsLam     (MatchGroup id (LHsExpr id)) -- Currently always a single match
131

132
  | HsLamCase PostTcType (MatchGroup id (LHsExpr id)) -- Lambda-case
133

Ian Lynagh's avatar
Ian Lynagh committed
134
  | HsApp     (LHsExpr id) (LHsExpr id) -- Application
135

136
  -- Operator applications:
137 138
  -- NB Bracketed ops such as (+) come out as Vars.

139 140 141
  -- NB We need an expr for the operator in an OpApp/Section since
  -- the typechecker may need to apply the operator to a few types.

Ian Lynagh's avatar
Ian Lynagh committed
142 143 144 145 146 147 148 149
  | OpApp       (LHsExpr id)    -- left operand
                (LHsExpr id)    -- operator
                Fixity          -- Renamer adds fixity; bottom until then
                (LHsExpr id)    -- right operand

  | NegApp      (LHsExpr id)    -- negated expr
                (SyntaxExpr id) -- Name of 'negate'

150
  | HsPar       (LHsExpr id)    -- Parenthesised expr; see Note [Parens in HsSyn]
Ian Lynagh's avatar
Ian Lynagh committed
151

152
  | SectionL    (LHsExpr id)    -- operand; see Note [Sections in HsSyn]
Ian Lynagh's avatar
Ian Lynagh committed
153
                (LHsExpr id)    -- operator
154
  | SectionR    (LHsExpr id)    -- operator; see Note [Sections in HsSyn]
Ian Lynagh's avatar
Ian Lynagh committed
155 156
                (LHsExpr id)    -- operand

157 158
  | ExplicitTuple               -- Used for explicit tuples and sections thereof
        [HsTupArg id]
159 160
        Boxity

Ian Lynagh's avatar
Ian Lynagh committed
161
  | HsCase      (LHsExpr id)
162
                (MatchGroup id (LHsExpr id))
Ian Lynagh's avatar
Ian Lynagh committed
163

164
  | HsIf        (Maybe (SyntaxExpr id)) -- cond function
165 166
                                        -- Nothing => use the built-in 'if'
                                        -- See Note [Rebindable if]
167
                (LHsExpr id)    --  predicate
Ian Lynagh's avatar
Ian Lynagh committed
168 169 170
                (LHsExpr id)    --  then part
                (LHsExpr id)    --  else part

171
  | HsMultiIf   PostTcType [LGRHS id (LHsExpr id)] -- Multi-way if
172

Ian Lynagh's avatar
Ian Lynagh committed
173 174 175 176 177 178
  | HsLet       (HsLocalBinds id) -- let(rec)
                (LHsExpr  id)

  | HsDo        (HsStmtContext Name) -- The parameterisation is unimportant
                                     -- because in this context we never use
                                     -- the PatGuard or ParStmt variant
179
                [ExprLStmt id]       -- "do":one or more stmts
Ian Lynagh's avatar
Ian Lynagh committed
180 181
                PostTcType           -- Type of the whole expression

182 183 184
  | ExplicitList                        -- syntactic list
                PostTcType              -- Gives type of components of list
                (Maybe (SyntaxExpr id)) -- For OverloadedLists, the fromListN witness
Ian Lynagh's avatar
Ian Lynagh committed
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
                [LHsExpr id]

  | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
                PostTcType      -- type of elements of the parallel array
                [LHsExpr id]

  -- Record construction
  | RecordCon   (Located id)       -- The constructor.  After type checking
                                   -- it's the dataConWrapId of the constructor
                PostTcExpr         -- Data con Id applied to type args
                (HsRecordBinds id)

  -- Record update
  | RecordUpd   (LHsExpr id)
                (HsRecordBinds id)
200 201
--              (HsMatchGroup Id)  -- Filled in by the type checker to be
--                                 -- a match that does the job
Ian Lynagh's avatar
Ian Lynagh committed
202
                [DataCon]          -- Filled in by the type checker to the
Thomas Schilling's avatar
Thomas Schilling committed
203
                                   -- _non-empty_ list of DataCons that have
Ian Lynagh's avatar
Ian Lynagh committed
204 205 206 207 208 209 210
                                   -- all the upd'd fields
                [PostTcType]       -- Argument types of *input* record type
                [PostTcType]       --              and  *output* record type
  -- For a type family, the arg types are of the *instance* tycon,
  -- not the family tycon

  | ExprWithTySig                       -- e :: type
211
                (LHsExpr id)
Ian Lynagh's avatar
Ian Lynagh committed
212 213 214 215 216 217 218
                (LHsType id)

  | ExprWithTySigOut                    -- TRANSLATION
                (LHsExpr id)
                (LHsType Name)          -- Retain the signature for
                                        -- round-tripping purposes

219
  | ArithSeq                            -- Arithmetic sequence
Ian Lynagh's avatar
Ian Lynagh committed
220
                PostTcExpr
221
                (Maybe (SyntaxExpr id))   -- For OverloadedLists, the fromList witness
Ian Lynagh's avatar
Ian Lynagh committed
222 223 224 225 226 227 228 229 230 231 232 233
                (ArithSeqInfo id)

  | PArrSeq                             -- arith. sequence for parallel array
                PostTcExpr              -- [:e1..e2:] or [:e1, e2..e3:]
                (ArithSeqInfo id)

  | HsSCC       FastString              -- "set cost centre" SCC pragma
                (LHsExpr id)            -- expr whose cost is to be measured

  | HsCoreAnn   FastString              -- hdaume: core annotation
                (LHsExpr id)

234
  -----------------------------------------------------------
235
  -- MetaHaskell Extensions
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
236

237
  | HsBracket    (HsBracket id)
238

Ian Lynagh's avatar
Ian Lynagh committed
239 240 241
  | HsBracketOut (HsBracket Name)       -- Output of the type checker is
                                        -- the *original*
                 [PendingSplice]        -- renamed expression, plus
Thomas Schilling's avatar
Thomas Schilling committed
242
                                        -- _typechecked_ splices to be
Ian Lynagh's avatar
Ian Lynagh committed
243
                                        -- pasted back in by the desugarer
244

Ian Lynagh's avatar
Ian Lynagh committed
245
  | HsSpliceE (HsSplice id)
246

247
  | HsQuasiQuoteE (HsQuasiQuote id)
248
        -- See Note [Quasi-quote overview] in TcSplice
249

250 251 252
  -----------------------------------------------------------
  -- Arrow notation extension

Ian Lynagh's avatar
Ian Lynagh committed
253 254 255
  | HsProc      (LPat id)               -- arrow abstraction, proc
                (LHsCmdTop id)          -- body of the abstraction
                                        -- always has an empty stack
256 257 258

  ---------------------------------------
  -- The following are commands, not expressions proper
259
  -- They are only used in the parsing stage and are removed
260
  --    immediately in parser.RdrHsSyn.checkCommand
Ian Lynagh's avatar
Ian Lynagh committed
261 262 263 264 265 266 267 268
  | HsArrApp            -- Arrow tail, or arrow application (f -< arg)
        (LHsExpr id)    -- arrow expression, f
        (LHsExpr id)    -- input expression, arg
        PostTcType      -- type of the arrow expressions f,
                        -- of the form a t t', where arg :: t
        HsArrAppType    -- higher-order (-<<) or first-order (-<)
        Bool            -- True => right-to-left (f -< arg)
                        -- False => left-to-right (arg >- f)
269

Ian Lynagh's avatar
Ian Lynagh committed
270 271 272 273 274 275 276
  | HsArrForm           -- Command formation,  (| e cmd1 .. cmdn |)
        (LHsExpr id)    -- the operator
                        -- after type-checking, a type abstraction to be
                        -- applied to the type of the local environment tuple
        (Maybe Fixity)  -- fixity (filled in by the renamer), for forms that
                        -- were converted from OpApp's by the renamer
        [LHsCmdTop id]  -- argument commands
277

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
278 279 280
  ---------------------------------------
  -- Haskell program coverage (Hpc) Support

Ian Lynagh's avatar
Ian Lynagh committed
281
  | HsTick
282
     (Tickish id)
Ian Lynagh's avatar
Ian Lynagh committed
283
     (LHsExpr id)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
284 285

  | HsBinTick
Ian Lynagh's avatar
Ian Lynagh committed
286 287 288
     Int                                -- module-local tick number for True
     Int                                -- module-local tick number for False
     (LHsExpr id)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
289

Ian Lynagh's avatar
Ian Lynagh committed
290 291 292
  | HsTickPragma                        -- A pragma introduced tick
     (FastString,(Int,Int),(Int,Int))   -- external span for this tick
     (LHsExpr id)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
293 294 295 296

  ---------------------------------------
  -- These constructors only appear temporarily in the parser.
  -- The renamer translates them into the Right Thing.
297

Ian Lynagh's avatar
Ian Lynagh committed
298
  | EWildPat                 -- wildcard
299

Ian Lynagh's avatar
Ian Lynagh committed
300 301
  | EAsPat      (Located id) -- as pattern
                (LHsExpr id)
302

Ian Lynagh's avatar
Ian Lynagh committed
303 304
  | EViewPat    (LHsExpr id) -- view pattern
                (LHsExpr id)
305

Ian Lynagh's avatar
Ian Lynagh committed
306
  | ELazyPat    (LHsExpr id) -- ~ pattern
307

Ian Lynagh's avatar
Ian Lynagh committed
308
  | HsType      (LHsType id) -- Explicit type argument; e.g  f {| Int |} x y
309

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
310 311
  ---------------------------------------
  -- Finally, HsWrap appears only in typechecker output
312

Ian Lynagh's avatar
Ian Lynagh committed
313 314
  |  HsWrap     HsWrapper    -- TRANSLATION
                (HsExpr id)
315
  |  HsUnboundVar RdrName
316
  deriving (Data, Typeable)
317

318 319 320 321
-- HsTupArg is used for tuple sections
--  (,a,) is represented by  ExplicitTuple [Mising ty1, Present a, Missing ty3]
--  Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
data HsTupArg id
322 323
  = Present (LHsExpr id)        -- The argument
  | Missing PostTcType          -- The argument is missing, but this is its type
324
  deriving (Data, Typeable)
325 326 327 328 329

tupArgPresent :: HsTupArg id -> Bool
tupArgPresent (Present {}) = True
tupArgPresent (Missing {}) = False

Ian Lynagh's avatar
Ian Lynagh committed
330 331
type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
                                        -- pasted back in by the desugarer
332

333 334
\end{code}

335 336 337 338 339 340 341
Note [Parens in HsSyn]
~~~~~~~~~~~~~~~~~~~~~~
HsPar (and ParPat in patterns, HsParTy in types) is used as follows

  * Generally HsPar is optional; the pretty printer adds parens where
    necessary.  Eg (HsApp f (HsApp g x)) is fine, and prints 'f (g x)'

342
  * HsPars are pretty printed as '( .. )' regardless of whether
343 344 345 346 347 348 349 350
    or not they are strictly necssary

  * HsPars are respected when rearranging operator fixities.
    So   a * (b + c)  means what it says (where the parens are an HsPar)

Note [Sections in HsSyn]
~~~~~~~~~~~~~~~~~~~~~~~~
Sections should always appear wrapped in an HsPar, thus
351 352
         HsPar (SectionR ...)
The parser parses sections in a wider variety of situations
353
(See Note [Parsing sections]), but the renamer checks for those
354
parens.  This invariant makes pretty-printing easier; we don't need
355 356
a special case for adding the parens round sections.

357 358 359 360 361 362
Note [Rebindable if]
~~~~~~~~~~~~~~~~~~~~
The rebindable syntax for 'if' is a bit special, because when
rebindable syntax is *off* we do not want to treat
   (if c then t else e)
as if it was an application (ifThenElse c t e).  Why not?
363
Because we allow an 'if' to return *unboxed* results, thus
364 365 366 367 368
  if blah then 3# else 4#
whereas that would not be possible using a all to a polymorphic function
(because you can't call a polymorphic function at an unboxed type).

So we use Nothing to mean "use the old built-in typing rule".
369 370

\begin{code}
371
instance OutputableBndr id => Outputable (HsExpr id) where
372
    ppr expr = pprExpr expr
373 374 375
\end{code}

\begin{code}
376
-----------------------
Ian Lynagh's avatar
Ian Lynagh committed
377
-- pprExpr, pprLExpr, pprBinds call pprDeeper;
378 379
-- the underscore versions do not
pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
380 381 382
pprLExpr (L _ e) = pprExpr e

pprExpr :: OutputableBndr id => HsExpr id -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
383 384 385 386 387 388 389 390 391 392 393 394
pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
          | otherwise                           = pprDeeper (ppr_expr e)

isQuietHsExpr :: HsExpr id -> Bool
-- Parentheses do display something, but it gives little info and
-- if we go deeper when we go inside them then we get ugly things
-- like (...)
isQuietHsExpr (HsPar _) = True
-- applications don't display anything themselves
isQuietHsExpr (HsApp _ _) = True
isQuietHsExpr (OpApp _ _ _ _) = True
isQuietHsExpr _ = False
395

Ian Lynagh's avatar
Ian Lynagh committed
396 397
pprBinds :: (OutputableBndr idL, OutputableBndr idR)
         => HsLocalBindsLR idL idR -> SDoc
398
pprBinds b = pprDeeper (ppr b)
399

400
-----------------------
401 402
ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
ppr_lexpr e = ppr_expr (unLoc e)
403

404
ppr_expr :: forall id. OutputableBndr id => HsExpr id -> SDoc
405
ppr_expr (HsVar v)       = pprPrefixOcc v
406
ppr_expr (HsIPVar v)     = ppr v
407 408
ppr_expr (HsLit lit)     = ppr lit
ppr_expr (HsOverLit lit) = ppr lit
Ian Lynagh's avatar
Ian Lynagh committed
409
ppr_expr (HsPar e)       = parens (ppr_lexpr e)
410 411

ppr_expr (HsCoreAnn s e)
Ian Lynagh's avatar
Ian Lynagh committed
412
  = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
413

414 415
ppr_expr (HsApp e1 e2)
  = let (fun, args) = collect_args e1 [e2] in
416
    hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
417
  where
418 419
    collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
    collect_args fun args = (fun, args)
420

Ian Lynagh's avatar
Ian Lynagh committed
421
ppr_expr (OpApp e1 op _ e2)
422
  = case unLoc op of
423
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
424
      _       -> pp_prefixly
425
  where
Ian Lynagh's avatar
Ian Lynagh committed
426
    pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
427
    pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
428 429

    pp_prefixly
430
      = hang (ppr op) 2 (sep [pp_e1, pp_e2])
431 432

    pp_infixly v
433
      = sep [pp_e1, sep [pprInfixOcc v, nest 2 pp_e2]]
434

435
ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
436

437
ppr_expr (SectionL expr op)
438
  = case unLoc op of
439
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
440
      _       -> pp_prefixly
441
  where
442
    pp_expr = pprDebugParendExpr expr
443

444
    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
Ian Lynagh's avatar
Ian Lynagh committed
445
                       4 (hsep [pp_expr, ptext (sLit "x_ )")])
446
    pp_infixly v = (sep [pp_expr, pprInfixOcc v])
447

448
ppr_expr (SectionR op expr)
449
  = case unLoc op of
450
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
451
      _       -> pp_prefixly
452
  where
453
    pp_expr = pprDebugParendExpr expr
454

Ian Lynagh's avatar
Ian Lynagh committed
455
    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
456
                       4 (pp_expr <> rparen)
457
    pp_infixly v = sep [pprInfixOcc v, pp_expr]
458

459
ppr_expr (ExplicitTuple exprs boxity)
batterseapower's avatar
batterseapower committed
460
  = tupleParens (boxityNormalTupleSort boxity) (fcat (ppr_tup_args exprs))
461 462 463
  where
    ppr_tup_args []               = []
    ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
464
    ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
465 466 467 468 469

    punc (Present {} : _) = comma <> space
    punc (Missing {} : _) = comma
    punc []               = empty

470
--avoid using PatternSignatures for stage1 code portability
471 472
ppr_expr (HsLam matches)
  = pprMatches (LambdaExpr :: HsMatchContext id) matches
473

474 475 476 477
ppr_expr (HsLamCase _ matches)
  = sep [ sep [ptext (sLit "\\case {")],
          nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]

478
ppr_expr (HsCase expr matches)
479
  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
480
          nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
481

482
ppr_expr (HsIf _ e1 e2 e3)
Ian Lynagh's avatar
Ian Lynagh committed
483
  = sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
Ian Lynagh's avatar
Ian Lynagh committed
484
         nest 4 (ppr e2),
Ian Lynagh's avatar
Ian Lynagh committed
485
         ptext (sLit "else"),
Ian Lynagh's avatar
Ian Lynagh committed
486
         nest 4 (ppr e3)]
487

488 489 490 491 492 493
ppr_expr (HsMultiIf _ alts)
  = sep $ ptext (sLit "if") : map ppr_alt alts
  where ppr_alt (L _ (GRHS guards expr)) =
          sep [ char '|' <+> interpp'SP guards
              , ptext (sLit "->") <+> pprDeeper (ppr expr) ]

494
-- special case: let ... in let ...
495
ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
Ian Lynagh's avatar
Ian Lynagh committed
496
  = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
Ian Lynagh's avatar
Ian Lynagh committed
497
         ppr_lexpr expr]
498

499
ppr_expr (HsLet binds expr)
Ian Lynagh's avatar
Ian Lynagh committed
500 501
  = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
         hang (ptext (sLit "in"))  2 (ppr expr)]
502

503
ppr_expr (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp stmts
504

505
ppr_expr (ExplicitList _ _ exprs)
506
  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
507

508
ppr_expr (ExplicitPArr _ exprs)
509
  = paBrackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
510

Ian Lynagh's avatar
Ian Lynagh committed
511
ppr_expr (RecordCon con_id _ rbinds)
512
  = hang (ppr con_id) 2 (ppr rbinds)
513

514
ppr_expr (RecordUpd aexp rbinds _ _ _)
515
  = hang (pprParendExpr aexp) 2 (ppr rbinds)
516 517

ppr_expr (ExprWithTySig expr sig)
518
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
519
         4 (ppr sig)
520 521
ppr_expr (ExprWithTySigOut expr sig)
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
522
         4 (ppr sig)
523

524
ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
525
ppr_expr (PArrSeq  _ info) = paBrackets (ppr info)
526

Ian Lynagh's avatar
Ian Lynagh committed
527 528 529
ppr_expr EWildPat       = char '_'
ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
Ian Lynagh's avatar
Ian Lynagh committed
530
ppr_expr (EViewPat p e) = ppr p <+> ptext (sLit "->") <+> ppr e
531 532

ppr_expr (HsSCC lbl expr)
Ian Lynagh's avatar
Ian Lynagh committed
533
  = sep [ ptext (sLit "_scc_") <+> doubleQuotes (ftext lbl),
Ian Lynagh's avatar
Ian Lynagh committed
534
          pprParendExpr expr ]
535

536
ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
Ian Lynagh's avatar
Ian Lynagh committed
537
ppr_expr (HsType id)      = ppr id
538

539 540
ppr_expr (HsSpliceE s)       = pprSplice s
ppr_expr (HsBracket b)       = pprHsBracket b
Ian Lynagh's avatar
Ian Lynagh committed
541
ppr_expr (HsBracketOut e []) = ppr e
Ian Lynagh's avatar
Ian Lynagh committed
542
ppr_expr (HsBracketOut e ps) = ppr e $$ ptext (sLit "pending") <+> ppr ps
543
ppr_expr (HsQuasiQuoteE qq)  = ppr qq
544

545
ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
Ian Lynagh's avatar
Ian Lynagh committed
546
  = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
547

548
ppr_expr (HsTick tickish exp)
549
  = pprTicks (ppr exp) $
550
    ppr tickish <+> ppr exp
andy@galois.com's avatar
andy@galois.com committed
551
ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
552 553
  = pprTicks (ppr exp) $
    hcat [ptext (sLit "bintick<"),
Ian Lynagh's avatar
Ian Lynagh committed
554
          ppr tickIdTrue,
Ian Lynagh's avatar
Ian Lynagh committed
555
          ptext (sLit ","),
Ian Lynagh's avatar
Ian Lynagh committed
556
          ppr tickIdFalse,
Ian Lynagh's avatar
Ian Lynagh committed
557 558
          ptext (sLit ">("),
          ppr exp,ptext (sLit ")")]
andy@galois.com's avatar
andy@galois.com committed
559
ppr_expr (HsTickPragma externalSrcLoc exp)
560 561
  = pprTicks (ppr exp) $
    hcat [ptext (sLit "tickpragma<"),
Ian Lynagh's avatar
Ian Lynagh committed
562
          ppr externalSrcLoc,
Ian Lynagh's avatar
Ian Lynagh committed
563
          ptext (sLit ">("),
Ian Lynagh's avatar
Ian Lynagh committed
564
          ppr exp,
Ian Lynagh's avatar
Ian Lynagh committed
565
          ptext (sLit ")")]
andy@galois.com's avatar
andy@galois.com committed
566

567
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
Ian Lynagh's avatar
Ian Lynagh committed
568
  = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
569
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
Ian Lynagh's avatar
Ian Lynagh committed
570
  = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
571
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
Ian Lynagh's avatar
Ian Lynagh committed
572
  = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
573
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
Ian Lynagh's avatar
Ian Lynagh committed
574
  = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
575

576
ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
577
  = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
578
ppr_expr (HsArrForm op _ args)
579 580
  = hang (ptext (sLit "(|") <+> ppr_lexpr op)
         4 (sep (map (pprCmdArg.unLoc) args) <+> ptext (sLit "|)"))
581 582
ppr_expr (HsUnboundVar nm)
  = ppr nm
583

584 585
\end{code}

586 587 588 589 590 591 592 593 594 595
HsSyn records exactly where the user put parens, with HsPar.
So generally speaking we print without adding any parens.
However, some code is internally generated, and in some places
parens are absolutely required; so for these places we use
pprParendExpr (but don't print double parens of course).

For operator applications we don't add parens, because the oprerator
fixities should do the job, except in debug mode (-dppr-debug) so we
can see the structure of the parse tree.

596
\begin{code}
597 598 599 600
pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
pprDebugParendExpr expr
  = getPprStyle (\sty ->
    if debugStyle sty then pprParendExpr expr
Ian Lynagh's avatar
Ian Lynagh committed
601 602
                      else pprLExpr      expr)

603
pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
604
pprParendExpr expr
605 606
  | hsExprNeedsParens (unLoc expr) = parens (pprLExpr expr)
  | otherwise                      = pprLExpr expr
Ian Lynagh's avatar
Ian Lynagh committed
607 608
        -- Using pprLExpr makes sure that we go 'deeper'
        -- I think that is usually (always?) right
609 610

hsExprNeedsParens :: HsExpr id -> Bool
611
-- True of expressions for which '(e)' and 'e'
612 613 614 615 616 617
-- mean the same thing
hsExprNeedsParens (ArithSeq {})       = False
hsExprNeedsParens (PArrSeq {})        = False
hsExprNeedsParens (HsLit {})          = False
hsExprNeedsParens (HsOverLit {})      = False
hsExprNeedsParens (HsVar {})          = False
618
hsExprNeedsParens (HsUnboundVar {})   = False
619 620 621 622 623 624 625 626 627 628 629 630
hsExprNeedsParens (HsIPVar {})        = False
hsExprNeedsParens (ExplicitTuple {})  = False
hsExprNeedsParens (ExplicitList {})   = False
hsExprNeedsParens (ExplicitPArr {})   = False
hsExprNeedsParens (HsPar {})          = False
hsExprNeedsParens (HsBracket {})      = False
hsExprNeedsParens (HsBracketOut _ []) = False
hsExprNeedsParens (HsDo sc _ _)
       | isListCompExpr sc            = False
hsExprNeedsParens _ = True


631
isAtomicHsExpr :: HsExpr id -> Bool
632
-- True of a single token
633 634 635 636
isAtomicHsExpr (HsVar {})     = True
isAtomicHsExpr (HsLit {})     = True
isAtomicHsExpr (HsOverLit {}) = True
isAtomicHsExpr (HsIPVar {})   = True
637
isAtomicHsExpr (HsUnboundVar {}) = True
638 639
isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
Ian Lynagh's avatar
Ian Lynagh committed
640
isAtomicHsExpr _              = False
641 642
\end{code}

643
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
644
%*                                                                      *
645
\subsection{Commands (in arrow abstractions)}
Ian Lynagh's avatar
Ian Lynagh committed
646
%*                                                                      *
647 648 649 650 651
%************************************************************************

We re-use HsExpr to represent these.

\begin{code}
652
type LHsCmd id = Located (HsCmd id)
653

654
data HsCmd id
655 656 657 658 659 660 661 662
  = HsCmdArrApp         -- Arrow tail, or arrow application (f -< arg)
        (LHsExpr id)    -- arrow expression, f
        (LHsExpr id)    -- input expression, arg
        PostTcType      -- type of the arrow expressions f,
                        -- of the form a t t', where arg :: t
        HsArrAppType    -- higher-order (-<<) or first-order (-<)
        Bool            -- True => right-to-left (f -< arg)
                        -- False => left-to-right (arg >- f)
663

664 665 666 667 668 669 670
  | HsCmdArrForm        -- Command formation,  (| e cmd1 .. cmdn |)
        (LHsExpr id)    -- the operator
                        -- after type-checking, a type abstraction to be
                        -- applied to the type of the local environment tuple
        (Maybe Fixity)  -- fixity (filled in by the renamer), for forms that
                        -- were converted from OpApp's by the renamer
        [LHsCmdTop id]  -- argument commands
671

672 673
  | HsCmdApp    (LHsCmd id)
                (LHsExpr id)
674

675
  | HsCmdLam    (MatchGroup id (LHsCmd id))     -- kappa
676

677
  | HsCmdPar    (LHsCmd id)                     -- parenthesised command
678

679 680
  | HsCmdCase   (LHsExpr id)
                (MatchGroup id (LHsCmd id))     -- bodies are HsCmd's
681

682 683 684 685
  | HsCmdIf     (Maybe (SyntaxExpr id))         -- cond function
                (LHsExpr id)                    -- predicate
                (LHsCmd id)                     -- then part
                (LHsCmd id)                     -- else part
686

687 688
  | HsCmdLet    (HsLocalBinds id)               -- let(rec)
                (LHsCmd  id)
689

690 691 692
  | HsCmdDo     [CmdLStmt id]
                PostTcType                      -- Type of the whole expression
  deriving (Data, Typeable)
693

694 695
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
  deriving (Data, Typeable)
696

697
\end{code}
698 699 700 701 702 703

Top-level command, introducing a new arrow.
This may occur inside a proc (where the stack is empty) or as an
argument of a command-forming operator.

\begin{code}
704 705
type LHsCmdTop id = Located (HsCmdTop id)

706
data HsCmdTop id
Ian Lynagh's avatar
Ian Lynagh committed
707
  = HsCmdTop (LHsCmd id)
708 709 710
             [PostTcType]        -- types of inputs on the command's stack
             PostTcType          -- return type of the command
             (CmdSyntaxTable id) -- See Note [CmdSyntaxTable]
711
  deriving (Data, Typeable)
712 713
\end{code}

714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803

\begin{code}
instance OutputableBndr id => Outputable (HsCmd id) where
    ppr cmd = pprCmd cmd

-----------------------
-- pprCmd and pprLCmd call pprDeeper;
-- the underscore versions do not
pprLCmd :: OutputableBndr id => LHsCmd id -> SDoc
pprLCmd (L _ c) = pprCmd c

pprCmd :: OutputableBndr id => HsCmd id -> SDoc
pprCmd c | isQuietHsCmd c =            ppr_cmd c
         | otherwise      = pprDeeper (ppr_cmd c)

isQuietHsCmd :: HsCmd id -> Bool
-- Parentheses do display something, but it gives little info and
-- if we go deeper when we go inside them then we get ugly things
-- like (...)
isQuietHsCmd (HsCmdPar _) = True
-- applications don't display anything themselves
isQuietHsCmd (HsCmdApp _ _) = True
isQuietHsCmd _ = False

-----------------------
ppr_lcmd :: OutputableBndr id => LHsCmd id -> SDoc
ppr_lcmd c = ppr_cmd (unLoc c)

ppr_cmd :: forall id. OutputableBndr id => HsCmd id -> SDoc
ppr_cmd (HsCmdPar c) = parens (ppr_lcmd c)

ppr_cmd (HsCmdApp c e)
  = let (fun, args) = collect_args c [e] in
    hang (ppr_lcmd fun) 2 (sep (map pprParendExpr args))
  where
    collect_args (L _ (HsCmdApp fun arg)) args = collect_args fun (arg:args)
    collect_args fun args = (fun, args)

--avoid using PatternSignatures for stage1 code portability
ppr_cmd (HsCmdLam matches)
  = pprMatches (LambdaExpr :: HsMatchContext id) matches

ppr_cmd (HsCmdCase expr matches)
  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
          nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]

ppr_cmd (HsCmdIf _ e ct ce)
  = sep [hsep [ptext (sLit "if"), nest 2 (ppr e), ptext (sLit "then")],
         nest 4 (ppr ct),
         ptext (sLit "else"),
         nest 4 (ppr ce)]

-- special case: let ... in let ...
ppr_cmd (HsCmdLet binds cmd@(L _ (HsCmdLet _ _)))
  = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
         ppr_lcmd cmd]

ppr_cmd (HsCmdLet binds cmd)
  = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
         hang (ptext (sLit "in"))  2 (ppr cmd)]

ppr_cmd (HsCmdDo stmts _) = pprDo ArrowExpr stmts


ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp True)
  = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp False)
  = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp True)
  = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp False)
  = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]

ppr_cmd (HsCmdArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
  = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
ppr_cmd (HsCmdArrForm op _ args)
  = hang (ptext (sLit "(|") <> ppr_lexpr op)
         4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))

pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
pprCmdArg (HsCmdTop cmd@(L _ (HsCmdArrForm _ Nothing [])) _ _ _)
  = ppr_lcmd cmd
pprCmdArg (HsCmdTop cmd _ _ _)
  = parens (ppr_lcmd cmd)

instance OutputableBndr id => Outputable (HsCmdTop id) where
    ppr = pprCmdArg

\end{code}

804
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
805
%*                                                                      *
806
\subsection{Record binds}
Ian Lynagh's avatar
Ian Lynagh committed
807
%*                                                                      *
808 809 810
%************************************************************************

\begin{code}
811
type HsRecordBinds id = HsRecFields id (LHsExpr id)
812 813
\end{code}

814

815
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
816
%*                                                                      *
817
\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
Ian Lynagh's avatar
Ian Lynagh committed
818
%*                                                                      *
819 820
%************************************************************************

821 822 823 824 825 826 827 828 829 830 831 832 833 834
@Match@es are sets of pattern bindings and right hand sides for
functions, patterns or case branches. For example, if a function @g@
is defined as:
\begin{verbatim}
g (x,y) = y
g ((x:ys),y) = y+1,
\end{verbatim}
then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.

It is always the case that each element of an @[Match]@ list has the
same number of @pats@s inside it.  This corresponds to saying that
a function defined by pattern matching must have the same number of
patterns in each equation.

835
\begin{code}
836
data MatchGroup id body
837 838 839 840 841 842
  = MG { mg_alts    :: [LMatch id body]  -- The alternatives
       , mg_arg_tys :: [PostTcType]      -- Types of the arguments, t1..tn
       , mg_res_ty  :: PostTcType  }     -- Type of the result, tr 
     -- The type is the type of the entire group
     --      t1 -> ... -> tn -> tr
     -- where there are n patterns
843
  deriving (Data, Typeable)
844

845
type LMatch id body = Located (Match id body)
846

847
data Match id body
848
  = Match
Ian Lynagh's avatar
Ian Lynagh committed
849 850 851
        [LPat id]               -- The patterns
        (Maybe (LHsType id))    -- A type signature for the result of the match
                                -- Nothing after typechecking
852
        (GRHSs id body)
853
  deriving (Data, Typeable)
854

855
isEmptyMatchGroup :: MatchGroup id body -> Bool
856
isEmptyMatchGroup (MG { mg_alts = ms }) = null ms
857

858
matchGroupArity :: MatchGroup id body -> Arity
859 860 861 862 863
-- Precondition: MatchGroup is non-empty
-- This is called before type checking, when mg_arg_tys is not set
matchGroupArity (MG { mg_alts = alts })
  | (alt1:_) <- alts = length (hsLMatchPats alt1)
  | otherwise        = panic "matchGroupArity"
864

865
hsLMatchPats :: LMatch id body -> [LPat id]
866 867
hsLMatchPats (L _ (Match pats _ _)) = pats

868
-- | GRHSs are used both for pattern bindings and for Matches
869
data GRHSs id body
870
  = GRHSs {
871
      grhssGRHSs :: [LGRHS id body],       -- ^ Guarded RHSs
872
      grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
873
    } deriving (Data, Typeable)
874

875
type LGRHS id body = Located (GRHS id body)
876

877
-- | Guarded Right Hand Side.
878 879
data GRHS id body = GRHS [GuardLStmt id] -- Guards
                         body            -- Right hand side
880
  deriving (Data, Typeable)
881
\end{code}
882

883
We know the list must have at least one @Match@ in it.
884

885
\begin{code}
886 887
pprMatches :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
           => HsMatchContext idL -> MatchGroup idR body -> SDoc
888
pprMatches ctxt (MG { mg_alts = matches })
Ian Lynagh's avatar
Ian Lynagh committed
889
    = vcat (map (pprMatch ctxt) (map unLoc matches))
Ian Lynagh's avatar
Ian Lynagh committed
890
      -- Don't print the type; it's only a place-holder before typechecking
891 892

-- Exported to HsBinds, which can't see the defn of HsMatchContext
893
pprFunBind :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
894
           => idL -> Bool -> MatchGroup idR body -> SDoc
895
pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
896 897

-- Exported to HsBinds, which can't see the defn of HsMatchContext
898 899
pprPatBind :: forall bndr id body. (OutputableBndr bndr, OutputableBndr id, Outputable body)
           => LPat bndr -> GRHSs id body -> SDoc
900 901
pprPatBind pat (grhss)
 = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext id) grhss)]
902

903 904
pprMatch :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
         => HsMatchContext idL -> Match idR body -> SDoc
905
pprMatch ctxt (Match pats maybe_ty grhss)
906 907 908
  = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats)
        , nest 2 ppr_maybe_ty
        , nest 2 (pprGRHSs ctxt grhss) ]
909
  where
Ian Lynagh's avatar
Ian Lynagh committed
910 911 912 913 914 915 916 917
    (herald, other_pats)
        = case ctxt of
            FunRhs fun is_infix
                | not is_infix -> (ppr fun, pats)
                        -- f x y z = e
                        -- Not pprBndr; the AbsBinds will
                        -- have printed the signature

918
                | null pats2 -> (pp_infix, [])
Ian Lynagh's avatar
Ian Lynagh committed
919 920
                        -- x &&& y = e

921
                | otherwise -> (parens pp_infix, pats2)
Ian Lynagh's avatar
Ian Lynagh committed
922 923
                        -- (x &&& y) z = e
                where
924
                  pp_infix = pprParendLPat pat1 <+> ppr fun <+> pprParendLPat pat2
Ian Lynagh's avatar
Ian Lynagh committed
925 926

            LambdaExpr -> (char '\\', pats)
927

928
            _  -> ASSERT( null pats1 )
929
                  (ppr pat1, [])        -- No parens around the single pat
930

931 932
    (pat1:pats1) = pats
    (pat2:pats2) = pats1
933
    ppr_maybe_ty = case maybe_ty of
Ian Lynagh's avatar
Ian Lynagh committed
934 935
                        Just ty -> dcolon <+> ppr ty
                        Nothing -> empty
936 937


938 939
pprGRHSs :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
         => HsMatchContext idL -> GRHSs idR body -> SDoc
940
pprGRHSs ctxt (GRHSs grhss binds)
Ian Lynagh's avatar
Ian Lynagh committed
941
  = vcat (map (pprGRHS ctxt . unLoc) grhss)
942 943
 $$ ppUnless (isEmptyLocalBinds binds)
      (text "where" $$ nest 4 (pprBinds binds))
944

945 946 947 948
pprGRHS :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
        => HsMatchContext idL -> GRHS idR body -> SDoc
pprGRHS ctxt (GRHS [] body)
 =  pp_rhs ctxt body
949

950 951
pprGRHS ctxt (GRHS guards body)
 = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt body]
952

953
pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc
954
pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
955
\end{code}
956

957
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
958
%*                                                                      *
959
\subsection{Do stmts and list comprehensions}
Ian Lynagh's avatar
Ian Lynagh committed
960
%*                                                                      *
961 962 963
%************************************************************************

\begin{code}
964 965 966 967 968 969 970 971 972
type LStmt id body = Located (StmtLR id id body)
type LStmtLR idL idR body = Located (StmtLR idL idR body)

type Stmt id body = StmtLR id id body

type CmdLStmt   id = LStmt id (LHsCmd  id)
type CmdStmt    id = Stmt  id (LHsCmd  id)
type ExprLStmt  id = LStmt id (LHsExpr id)
type ExprStmt   id = Stmt  id (LHsExpr id)
973

974 975 976 977
type GuardLStmt id = LStmt id (LHsExpr id)
type GuardStmt  id = Stmt  id (LHsExpr id)
type GhciLStmt  id = LStmt id (LHsExpr id)
type GhciStmt   id = Stmt  id (LHsExpr id)
978

979 980
-- The SyntaxExprs in here are used *only* for do-notation and monad
-- comprehensions, which have rebindable syntax. Otherwise they are unused.
981
data StmtLR idL idR body -- body should always be (LHs**** idR)
982 983
  = LastStmt  -- Always the last Stmt in ListComp, MonadComp, PArrComp,
              -- and (after the renamer) DoExpr, MDoExpr
984 985
              -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff
               body
986
               (SyntaxExpr idR)   -- The return operator, used only for MonadComp
987 988 989
                                  -- For ListComp, PArrComp, we use the baked-in 'return'
                                  -- For DoExpr, MDoExpr, we don't appply a 'return' at all
                                  -- See Note [Monad Comprehensions]
990
  | BindStmt (LPat idL)
991
             body
992
             (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind]
Ian Lynagh's avatar
Ian Lynagh committed
993 994 995
             (SyntaxExpr idR) -- The fail operator
             -- The fail operator is noSyntaxExpr
             -- if the pattern match can't fail
996

997
  | BodyStmt body             -- See Note [BodyStmt]
Ian Lynagh's avatar
Ian Lynagh committed
998
             (SyntaxExpr idR) -- The (>>) operator
999
             (SyntaxExpr idR) -- The `guard` operator; used only in MonadComp
1000
                              -- See notes [Monad Comprehensions]
Ian Lynagh's avatar
Ian Lynagh committed
1001
             PostTcType       -- Element type of the RHS (used for arrows)
1002

Ian Lynagh's avatar
Ian Lynagh committed
1003
  | LetStmt  (HsLocalBindsLR idL idR)
1004

1005
  -- ParStmts only occur in a list/monad comprehension
1006
  | ParStmt  [ParStmtBlock idL idR]
1007
             (SyntaxExpr idR)           -- Polymorphic `mzip` for monad comprehensions
1008 1009
             (SyntaxExpr idR)           -- The `>>=` operator
                                        -- See notes [Monad Comprehensions]
1010 1011
            -- After renaming, the ids are the binders
            -- bound by the stmts and used after themp
1012

1013 1014
  | TransStmt {
      trS_form  :: TransForm,
1015
      trS_stmts :: [ExprLStmt idL],   -- Stmts to the *left* of the 'group'
1016
                                      -- which generates the tuples to be grouped
1017

1018
      trS_bndrs :: [(idR, idR)],      -- See Note [TransStmt binder map]
1019

1020
      trS_using :: LHsExpr idR,
1021
      trS_by :: Maybe (LHsExpr idR),  -- "by e" (optional)
1022
        -- Invariant: if trS_form = GroupBy, then grp_by = Just e
1023

1024 1025
      trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for
                                      -- the inner monad comprehensions