Implement Partial Type Signatures
[ghc.git] / 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 CPP, DeriveDataTypeable, ScopedTypeVariables #-}
7 {-# LANGUAGE StandaloneDeriving #-}
8 {-# LANGUAGE FlexibleContexts #-}
9 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
10                                       -- in module PlaceHolder
11 {-# LANGUAGE ConstraintKinds #-}
12
13 -- | Abstract Haskell syntax for expressions.
14 module HsExpr where
15
16 #include "HsVersions.h"
17
18 -- friends:
19 import HsDecls
20 import HsPat
21 import HsLit
22 import PlaceHolder ( PostTc,PostRn,DataId )
23 import HsTypes
24 import HsBinds
25
26 -- others:
27 import TcEvidence
28 import CoreSyn
29 import Var
30 import RdrName
31 import Name
32 import BasicTypes
33 import DataCon
34 import SrcLoc
35 import Util
36 import StaticFlags( opt_PprStyle_Debug )
37 import Outputable
38 import FastString
39 import Type
40
41 -- libraries:
42 import Data.Data hiding (Fixity)
43 \end{code}
44
45 %************************************************************************
46 %*                                                                      *
47 \subsection{Expressions proper}
48 %*                                                                      *
49 %************************************************************************
50
51 \begin{code}
52 -- * Expressions proper
53
54 type LHsExpr id = Located (HsExpr id)
55   -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
56   --   in a list
57
58 -------------------------
59 -- | PostTcExpr is an evidence expression attached to the syntax tree by the
60 -- type checker (c.f. postTcType).
61 type PostTcExpr  = HsExpr Id
62 -- | We use a PostTcTable where there are a bunch of pieces of evidence, more
63 -- than is convenient to keep individually.
64 type PostTcTable = [(Name, PostTcExpr)]
65
66 noPostTcExpr :: PostTcExpr
67 noPostTcExpr = HsLit (HsString "" (fsLit "noPostTcExpr"))
68
69 noPostTcTable :: PostTcTable
70 noPostTcTable = []
71
72 -------------------------
73 -- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
74 -- by the renamer.  It's used for rebindable syntax.
75 --
76 -- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
77 --      @(>>=)@, and then instantiated by the type checker with its type args
78 --      etc
79
80 type SyntaxExpr id = HsExpr id
81
82 noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
83                               -- (if the syntax slot makes no sense)
84 noSyntaxExpr = HsLit (HsString "" (fsLit "noSyntaxExpr"))
85
86
87 type CmdSyntaxTable id = [(Name, SyntaxExpr id)]
88 -- See Note [CmdSyntaxTable]
89
90 \end{code}
91
92 Note [CmdSyntaxtable]
93 ~~~~~~~~~~~~~~~~~~~~~
94 Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps
95 track of the methods needed for a Cmd.
96
97 * Before the renamer, this list is an empty list
98
99 * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
100   For example, for the 'arr' method
101    * normal case:            (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr)
102    * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22)
103              where @arr_22@ is whatever 'arr' is in scope
104
105 * After the type checker, it takes the form [(std_name, <expression>)]
106   where <expression> is the evidence for the method.  This evidence is
107   instantiated with the class, but is still polymorphic in everything
108   else.  For example, in the case of 'arr', the evidence has type
109          forall b c. (b->c) -> a b c
110   where 'a' is the ambient type of the arrow.  This polymorphism is
111   important because the desugarer uses the same evidence at multiple
112   different types.
113
114 This is Less Cool than what we normally do for rebindable syntax, which is to
115 make fully-instantiated piece of evidence at every use site.  The Cmd way
116 is Less Cool because
117   * The renamer has to predict which methods are needed.
118     See the tedious RnExpr.methodNamesCmd.
119
120   * The desugarer has to know the polymorphic type of the instantiated
121     method. This is checked by Inst.tcSyntaxName, but is less flexible
122     than the rest of rebindable syntax, where the type is less
123     pre-ordained.  (And this flexibility is useful; for example we can
124     typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
125
126
127 \begin{code}
128 -- | A Haskell expression.
129 data HsExpr id
130   = HsVar     id                        -- ^ Variable
131   | HsIPVar   HsIPName                  -- ^ Implicit parameter
132   | HsOverLit (HsOverLit id)            -- ^ Overloaded literals
133
134   | HsLit     HsLit                     -- ^ Simple (non-overloaded) literals
135
136   | HsLam     (MatchGroup id (LHsExpr id)) -- ^ Lambda abstraction. Currently always a single match
137        --
138        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
139        --       'ApiAnnotation.AnnRarrow',
140
141   | HsLamCase (PostTc id Type) (MatchGroup id (LHsExpr id)) -- ^ Lambda-case
142        --
143        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
144        --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
145        --           'ApiAnnotation.AnnClose'
146   | HsApp     (LHsExpr id) (LHsExpr id) -- ^ Application
147
148   -- | Operator applications:
149   -- NB Bracketed ops such as (+) come out as Vars.
150
151   -- NB We need an expr for the operator in an OpApp/Section since
152   -- the typechecker may need to apply the operator to a few types.
153
154   | OpApp       (LHsExpr id)    -- left operand
155                 (LHsExpr id)    -- operator
156                 (PostRn id Fixity) -- Renamer adds fixity; bottom until then
157                 (LHsExpr id)    -- right operand
158
159   -- | Negation operator. Contains the negated expression and the name
160   -- of 'negate'
161   --
162   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
163   | NegApp      (LHsExpr id)
164                 (SyntaxExpr id)
165
166   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
167   --             'ApiAnnotation.AnnClose'
168   --   - Note: if 'ApiAnnotation.AnnVal' is present this is actually an
169   --           inactive 'HsSCC'
170   --   - Note: if multiple 'ApiAnnotation.AnnVal' are
171   --            present this is actually an inactive 'HsTickPragma'
172   | HsPar       (LHsExpr id)    -- ^ Parenthesised expr; see Note [Parens in HsSyn]
173
174   | SectionL    (LHsExpr id)    -- operand; see Note [Sections in HsSyn]
175                 (LHsExpr id)    -- operator
176   | SectionR    (LHsExpr id)    -- operator; see Note [Sections in HsSyn]
177                 (LHsExpr id)    -- operand
178
179   -- | Used for explicit tuples and sections thereof
180   --
181   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
182   --         'ApiAnnotation.AnnClose'
183   | ExplicitTuple
184         [LHsTupArg id]
185         Boxity
186
187   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
188   --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen',
189   --       'ApiAnnotation.AnnClose'
190   | HsCase      (LHsExpr id)
191                 (MatchGroup id (LHsExpr id))
192
193   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
194   --       'ApiAnnotation.AnnSemi',
195   --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi2',
196   --       'ApiAnnotation.AnnElse',
197   | HsIf        (Maybe (SyntaxExpr id)) -- cond function
198                                         -- Nothing => use the built-in 'if'
199                                         -- See Note [Rebindable if]
200                 (LHsExpr id)    --  predicate
201                 (LHsExpr id)    --  then part
202                 (LHsExpr id)    --  else part
203
204   -- | Multi-way if
205   --
206   -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'
207   --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
208   | HsMultiIf   (PostTc id Type) [LGRHS id (LHsExpr id)]
209
210   -- | let(rec)
211   --
212   -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
213   --       'ApiAnnotation.AnnIn','ApiAnnotation.AnnOpen',
214   --       'ApiAnnotation.AnnClose'
215   | HsLet       (HsLocalBinds id)
216                 (LHsExpr  id)
217
218   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
219   --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
220   --             'ApiAnnotation.AnnVbar',
221   --             'ApiAnnotation.AnnClose'
222   | HsDo        (HsStmtContext Name) -- The parameterisation is unimportant
223                                      -- because in this context we never use
224                                      -- the PatGuard or ParStmt variant
225                 [ExprLStmt id]       -- "do":one or more stmts
226                 (PostTc id Type)     -- Type of the whole expression
227
228   -- | Syntactic list: [a,b,c,...]
229   --
230   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
231   --              'ApiAnnotation.AnnClose'
232   | ExplicitList
233                 (PostTc id Type)        -- Gives type of components of list
234                 (Maybe (SyntaxExpr id)) -- For OverloadedLists, the fromListN witness
235                 [LHsExpr id]
236
237   -- | Syntactic parallel array: [:e1, ..., en:]
238   --
239   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
240   --              'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnComma',
241   --              'ApiAnnotation.AnnVbar'
242   --              'ApiAnnotation.AnnClose'
243   | ExplicitPArr
244                 (PostTc id Type)   -- type of elements of the parallel array
245                 [LHsExpr id]
246
247   -- | Record construction
248   --
249   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
250   --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose'
251   | RecordCon   (Located id)       -- The constructor.  After type checking
252                                    -- it's the dataConWrapId of the constructor
253                 PostTcExpr         -- Data con Id applied to type args
254                 (HsRecordBinds id)
255
256   -- | Record update
257   --
258   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
259   --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose'
260   | RecordUpd   (LHsExpr id)
261                 (HsRecordBinds id)
262 --              (HsMatchGroup Id)  -- Filled in by the type checker to be
263 --                                 -- a match that does the job
264                 [DataCon]          -- Filled in by the type checker to the
265                                    -- _non-empty_ list of DataCons that have
266                                    -- all the upd'd fields
267                 [PostTc id Type]   -- Argument types of *input* record type
268                 [PostTc id Type]   --              and  *output* record type
269   -- For a type family, the arg types are of the *instance* tycon,
270   -- not the family tycon
271
272   -- | Expression with an explicit type signature. @e :: type@
273   --
274   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
275   | ExprWithTySig
276                 (LHsExpr id)
277                 (LHsType id)
278                 (PostRn id [Name])      -- After renaming, the list of Names
279                                         -- contains the named and unnamed
280                                         -- wildcards brought in scope by the
281                                         -- signature
282
283   | ExprWithTySigOut                    -- TRANSLATION
284                 (LHsExpr id)
285                 (LHsType Name)          -- Retain the signature for
286                                         -- round-tripping purposes
287
288   -- | Arithmetic sequence
289   --
290   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
291   --              'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnComma',
292   --              'ApiAnnotation.AnnClose'
293   | ArithSeq
294                 PostTcExpr
295                 (Maybe (SyntaxExpr id))   -- For OverloadedLists, the fromList witness
296                 (ArithSeqInfo id)
297
298   -- | Arithmetic sequence for parallel array
299   | PArrSeq                             
300                 PostTcExpr              -- [:e1..e2:] or [:e1, e2..e3:]
301                 (ArithSeqInfo id)
302
303   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
304   --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose'
305   | HsSCC       FastString              -- "set cost centre" SCC pragma
306                 (LHsExpr id)            -- expr whose cost is to be measured
307
308   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
309   --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose'
310   | HsCoreAnn   FastString              -- hdaume: core annotation
311                 (LHsExpr id)
312
313   -----------------------------------------------------------
314   -- MetaHaskell Extensions
315
316   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
317   --         'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
318   --         'ApiAnnotation.AnnClose'
319   | HsBracket    (HsBracket id)
320
321     -- See Note [Pending Splices]
322   | HsRnBracketOut
323       (HsBracket Name)     -- Output of the renamer is the *original* renamed
324                            -- expression, plus
325       [PendingRnSplice]    -- _renamed_ splices to be type checked
326
327   | HsTcBracketOut
328       (HsBracket Name)     -- Output of the type checker is the *original*
329                            -- renamed expression, plus
330       [PendingTcSplice]    -- _typechecked_ splices to be
331                            -- pasted back in by the desugarer
332
333   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
334   --         'ApiAnnotation.AnnClose'
335   | HsSpliceE    Bool                   -- True <=> typed splice
336                  (HsSplice id)          -- False <=> untyped
337
338   | HsQuasiQuoteE (HsQuasiQuote id)
339         -- See Note [Quasi-quote overview] in TcSplice
340
341   -----------------------------------------------------------
342   -- Arrow notation extension
343
344   -- | @proc@ notation for Arrows
345   --
346   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',
347   --          'ApiAnnotation.AnnRarrow'
348   | HsProc      (LPat id)               -- arrow abstraction, proc
349                 (LHsCmdTop id)          -- body of the abstraction
350                                         -- always has an empty stack
351
352   ---------------------------------------
353   -- The following are commands, not expressions proper
354   -- They are only used in the parsing stage and are removed
355   --    immediately in parser.RdrHsSyn.checkCommand
356
357   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
358   --          'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
359   --          'ApiAnnotation.AnnRarrowtail'
360   | HsArrApp             -- Arrow tail, or arrow application (f -< arg)
361         (LHsExpr id)     -- arrow expression, f
362         (LHsExpr id)     -- input expression, arg
363         (PostTc id Type) -- type of the arrow expressions f,
364                          -- of the form a t t', where arg :: t
365         HsArrAppType     -- higher-order (-<<) or first-order (-<)
366         Bool             -- True => right-to-left (f -< arg)
367                          -- False => left-to-right (arg >- f)
368
369   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
370   --         'ApiAnnotation.AnnClose'
371   | HsArrForm            -- Command formation,  (| e cmd1 .. cmdn |)
372         (LHsExpr id)     -- the operator
373                          -- after type-checking, a type abstraction to be
374                          -- applied to the type of the local environment tuple
375         (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that
376                          -- were converted from OpApp's by the renamer
377         [LHsCmdTop id]   -- argument commands
378
379   ---------------------------------------
380   -- Haskell program coverage (Hpc) Support
381
382   | HsTick
383      (Tickish id)
384      (LHsExpr id)                       -- sub-expression
385
386   | HsBinTick
387      Int                                -- module-local tick number for True
388      Int                                -- module-local tick number for False
389      (LHsExpr id)                       -- sub-expression
390
391   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
392   --       'ApiAnnotation.AnnOpen',
393   --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal2',
394   --       'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal3',
395   --       'ApiAnnotation.AnnMinus',
396   --       'ApiAnnotation.AnnVal4','ApiAnnotation.AnnColon2',
397   --       'ApiAnnotation.AnnVal5',
398   --       'ApiAnnotation.AnnClose'
399   | HsTickPragma                        -- A pragma introduced tick
400      (FastString,(Int,Int),(Int,Int))   -- external span for this tick
401      (LHsExpr id)
402
403   ---------------------------------------
404   -- These constructors only appear temporarily in the parser.
405   -- The renamer translates them into the Right Thing.
406
407   | EWildPat                 -- wildcard
408
409   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
410   | EAsPat      (Located id) -- as pattern
411                 (LHsExpr id)
412
413   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
414   | EViewPat    (LHsExpr id) -- view pattern
415                 (LHsExpr id)
416
417   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
418   | ELazyPat    (LHsExpr id) -- ~ pattern
419
420   | HsType      (LHsType id) -- Explicit type argument; e.g  f {| Int |} x y
421
422   ---------------------------------------
423   -- Finally, HsWrap appears only in typechecker output
424
425   |  HsWrap     HsWrapper    -- TRANSLATION
426                 (HsExpr id)
427   |  HsUnboundVar RdrName
428   deriving (Typeable)
429 deriving instance (DataId id) => Data (HsExpr id)
430
431 -- | HsTupArg is used for tuple sections
432 --  (,a,) is represented by  ExplicitTuple [Missing ty1, Present a, Missing ty3]
433 --  Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
434 type LHsTupArg id = Located (HsTupArg id)
435 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
436 data HsTupArg id
437   = Present (LHsExpr id)     -- ^ The argument
438   | Missing (PostTc id Type) -- ^ The argument is missing, but this is its type
439   deriving (Typeable)
440 deriving instance (DataId id) => Data (HsTupArg id)
441
442 tupArgPresent :: LHsTupArg id -> Bool
443 tupArgPresent (L _ (Present {})) = True
444 tupArgPresent (L _ (Missing {})) = False
445 \end{code}
446
447 Note [Parens in HsSyn]
448 ~~~~~~~~~~~~~~~~~~~~~~
449 HsPar (and ParPat in patterns, HsParTy in types) is used as follows
450
451   * Generally HsPar is optional; the pretty printer adds parens where
452     necessary.  Eg (HsApp f (HsApp g x)) is fine, and prints 'f (g x)'
453
454   * HsPars are pretty printed as '( .. )' regardless of whether
455     or not they are strictly necssary
456
457   * HsPars are respected when rearranging operator fixities.
458     So   a * (b + c)  means what it says (where the parens are an HsPar)
459
460 Note [Sections in HsSyn]
461 ~~~~~~~~~~~~~~~~~~~~~~~~
462 Sections should always appear wrapped in an HsPar, thus
463          HsPar (SectionR ...)
464 The parser parses sections in a wider variety of situations
465 (See Note [Parsing sections]), but the renamer checks for those
466 parens.  This invariant makes pretty-printing easier; we don't need
467 a special case for adding the parens round sections.
468
469 Note [Rebindable if]
470 ~~~~~~~~~~~~~~~~~~~~
471 The rebindable syntax for 'if' is a bit special, because when
472 rebindable syntax is *off* we do not want to treat
473    (if c then t else e)
474 as if it was an application (ifThenElse c t e).  Why not?
475 Because we allow an 'if' to return *unboxed* results, thus
476   if blah then 3# else 4#
477 whereas that would not be possible using a all to a polymorphic function
478 (because you can't call a polymorphic function at an unboxed type).
479
480 So we use Nothing to mean "use the old built-in typing rule".
481
482 \begin{code}
483 instance OutputableBndr id => Outputable (HsExpr id) where
484     ppr expr = pprExpr expr
485 \end{code}
486
487 \begin{code}
488 -----------------------
489 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
490 -- the underscore versions do not
491 pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
492 pprLExpr (L _ e) = pprExpr e
493
494 pprExpr :: OutputableBndr id => HsExpr id -> SDoc
495 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
496           | otherwise                           = pprDeeper (ppr_expr e)
497
498 isQuietHsExpr :: HsExpr id -> Bool
499 -- Parentheses do display something, but it gives little info and
500 -- if we go deeper when we go inside them then we get ugly things
501 -- like (...)
502 isQuietHsExpr (HsPar _) = True
503 -- applications don't display anything themselves
504 isQuietHsExpr (HsApp _ _) = True
505 isQuietHsExpr (OpApp _ _ _ _) = True
506 isQuietHsExpr _ = False
507
508 pprBinds :: (OutputableBndr idL, OutputableBndr idR)
509          => HsLocalBindsLR idL idR -> SDoc
510 pprBinds b = pprDeeper (ppr b)
511
512 -----------------------
513 ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
514 ppr_lexpr e = ppr_expr (unLoc e)
515
516 ppr_expr :: forall id. OutputableBndr id => HsExpr id -> SDoc
517 ppr_expr (HsVar v)       = pprPrefixOcc v
518 ppr_expr (HsIPVar v)     = ppr v
519 ppr_expr (HsLit lit)     = ppr lit
520 ppr_expr (HsOverLit lit) = ppr lit
521 ppr_expr (HsPar e)       = parens (ppr_lexpr e)
522
523 ppr_expr (HsCoreAnn s e)
524   = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
525
526 ppr_expr (HsApp e1 e2)
527   = let (fun, args) = collect_args e1 [e2] in
528     hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
529   where
530     collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
531     collect_args fun args = (fun, args)
532
533 ppr_expr (OpApp e1 op _ e2)
534   = case unLoc op of
535       HsVar v -> pp_infixly v
536       _       -> pp_prefixly
537   where
538     pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
539     pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
540
541     pp_prefixly
542       = hang (ppr op) 2 (sep [pp_e1, pp_e2])
543
544     pp_infixly v
545       = sep [pp_e1, sep [pprInfixOcc v, nest 2 pp_e2]]
546
547 ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
548
549 ppr_expr (SectionL expr op)
550   = case unLoc op of
551       HsVar v -> pp_infixly v
552       _       -> pp_prefixly
553   where
554     pp_expr = pprDebugParendExpr expr
555
556     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
557                        4 (hsep [pp_expr, ptext (sLit "x_ )")])
558     pp_infixly v = (sep [pp_expr, pprInfixOcc v])
559
560 ppr_expr (SectionR op expr)
561   = case unLoc op of
562       HsVar v -> pp_infixly v
563       _       -> pp_prefixly
564   where
565     pp_expr = pprDebugParendExpr expr
566
567     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
568                        4 (pp_expr <> rparen)
569     pp_infixly v = sep [pprInfixOcc v, pp_expr]
570
571 ppr_expr (ExplicitTuple exprs boxity)
572   = tupleParens (boxityNormalTupleSort boxity)
573                 (fcat (ppr_tup_args $ map unLoc exprs))
574   where
575     ppr_tup_args []               = []
576     ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
577     ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
578
579     punc (Present {} : _) = comma <> space
580     punc (Missing {} : _) = comma
581     punc []               = empty
582
583 --avoid using PatternSignatures for stage1 code portability
584 ppr_expr (HsLam matches)
585   = pprMatches (LambdaExpr :: HsMatchContext id) matches
586
587 ppr_expr (HsLamCase _ matches)
588   = sep [ sep [ptext (sLit "\\case {")],
589           nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
590
591 ppr_expr (HsCase expr matches)
592   = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
593           nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
594
595 ppr_expr (HsIf _ e1 e2 e3)
596   = sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
597          nest 4 (ppr e2),
598          ptext (sLit "else"),
599          nest 4 (ppr e3)]
600
601 ppr_expr (HsMultiIf _ alts)
602   = sep $ ptext (sLit "if") : map ppr_alt alts
603   where ppr_alt (L _ (GRHS guards expr)) =
604           sep [ char '|' <+> interpp'SP guards
605               , ptext (sLit "->") <+> pprDeeper (ppr expr) ]
606
607 -- special case: let ... in let ...
608 ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
609   = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
610          ppr_lexpr expr]
611
612 ppr_expr (HsLet binds expr)
613   = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
614          hang (ptext (sLit "in"))  2 (ppr expr)]
615
616 ppr_expr (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp stmts
617
618 ppr_expr (ExplicitList _ _ exprs)
619   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
620
621 ppr_expr (ExplicitPArr _ exprs)
622   = paBrackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
623
624 ppr_expr (RecordCon con_id _ rbinds)
625   = hang (ppr con_id) 2 (ppr rbinds)
626
627 ppr_expr (RecordUpd aexp rbinds _ _ _)
628   = hang (pprParendExpr aexp) 2 (ppr rbinds)
629
630 ppr_expr (ExprWithTySig expr sig _)
631   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
632          4 (ppr sig)
633 ppr_expr (ExprWithTySigOut expr sig)
634   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
635          4 (ppr sig)
636
637 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
638 ppr_expr (PArrSeq  _ info) = paBrackets (ppr info)
639
640 ppr_expr EWildPat       = char '_'
641 ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
642 ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
643 ppr_expr (EViewPat p e) = ppr p <+> ptext (sLit "->") <+> ppr e
644
645 ppr_expr (HsSCC lbl expr)
646   = sep [ ptext (sLit "{-# SCC") <+> doubleQuotes (ftext lbl) <+> ptext (sLit "#-}"),
647           pprParendExpr expr ]
648
649 ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
650 ppr_expr (HsType id)      = ppr id
651
652 ppr_expr (HsSpliceE t s)       = pprSplice t s
653 ppr_expr (HsBracket b)         = pprHsBracket b
654 ppr_expr (HsRnBracketOut e []) = ppr e
655 ppr_expr (HsRnBracketOut e ps) = ppr e $$ ptext (sLit "pending(rn)") <+> ppr ps
656 ppr_expr (HsTcBracketOut e []) = ppr e
657 ppr_expr (HsTcBracketOut e ps) = ppr e $$ ptext (sLit "pending(tc)") <+> ppr ps
658 ppr_expr (HsQuasiQuoteE qq)    = ppr qq
659
660 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
661   = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
662
663 ppr_expr (HsTick tickish exp)
664   = pprTicks (ppr exp) $
665     ppr tickish <+> ppr exp
666 ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
667   = pprTicks (ppr exp) $
668     hcat [ptext (sLit "bintick<"),
669           ppr tickIdTrue,
670           ptext (sLit ","),
671           ppr tickIdFalse,
672           ptext (sLit ">("),
673           ppr exp,ptext (sLit ")")]
674 ppr_expr (HsTickPragma externalSrcLoc exp)
675   = pprTicks (ppr exp) $
676     hcat [ptext (sLit "tickpragma<"),
677           ppr externalSrcLoc,
678           ptext (sLit ">("),
679           ppr exp,
680           ptext (sLit ")")]
681
682 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
683   = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
684 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
685   = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
686 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
687   = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
688 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
689   = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
690
691 ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
692   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
693 ppr_expr (HsArrForm op _ args)
694   = hang (ptext (sLit "(|") <+> ppr_lexpr op)
695          4 (sep (map (pprCmdArg.unLoc) args) <+> ptext (sLit "|)"))
696 ppr_expr (HsUnboundVar nm)
697   = ppr nm
698
699 \end{code}
700
701 HsSyn records exactly where the user put parens, with HsPar.
702 So generally speaking we print without adding any parens.
703 However, some code is internally generated, and in some places
704 parens are absolutely required; so for these places we use
705 pprParendExpr (but don't print double parens of course).
706
707 For operator applications we don't add parens, because the oprerator
708 fixities should do the job, except in debug mode (-dppr-debug) so we
709 can see the structure of the parse tree.
710
711 \begin{code}
712 pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
713 pprDebugParendExpr expr
714   = getPprStyle (\sty ->
715     if debugStyle sty then pprParendExpr expr
716                       else pprLExpr      expr)
717
718 pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
719 pprParendExpr expr
720   | hsExprNeedsParens (unLoc expr) = parens (pprLExpr expr)
721   | otherwise                      = pprLExpr expr
722         -- Using pprLExpr makes sure that we go 'deeper'
723         -- I think that is usually (always?) right
724
725 hsExprNeedsParens :: HsExpr id -> Bool
726 -- True of expressions for which '(e)' and 'e'
727 -- mean the same thing
728 hsExprNeedsParens (ArithSeq {})       = False
729 hsExprNeedsParens (PArrSeq {})        = False
730 hsExprNeedsParens (HsLit {})          = False
731 hsExprNeedsParens (HsOverLit {})      = False
732 hsExprNeedsParens (HsVar {})          = False
733 hsExprNeedsParens (HsUnboundVar {})   = False
734 hsExprNeedsParens (HsIPVar {})        = False
735 hsExprNeedsParens (ExplicitTuple {})  = False
736 hsExprNeedsParens (ExplicitList {})   = False
737 hsExprNeedsParens (ExplicitPArr {})   = False
738 hsExprNeedsParens (HsPar {})          = False
739 hsExprNeedsParens (HsBracket {})      = False
740 hsExprNeedsParens (HsRnBracketOut {}) = False
741 hsExprNeedsParens (HsTcBracketOut {}) = False
742 hsExprNeedsParens (HsDo sc _ _)
743        | isListCompExpr sc            = False
744 hsExprNeedsParens _ = True
745
746
747 isAtomicHsExpr :: HsExpr id -> Bool
748 -- True of a single token
749 isAtomicHsExpr (HsVar {})     = True
750 isAtomicHsExpr (HsLit {})     = True
751 isAtomicHsExpr (HsOverLit {}) = True
752 isAtomicHsExpr (HsIPVar {})   = True
753 isAtomicHsExpr (HsUnboundVar {}) = True
754 isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
755 isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
756 isAtomicHsExpr _              = False
757 \end{code}
758
759 %************************************************************************
760 %*                                                                      *
761 \subsection{Commands (in arrow abstractions)}
762 %*                                                                      *
763 %************************************************************************
764
765 We re-use HsExpr to represent these.
766
767 \begin{code}
768 type LHsCmd id = Located (HsCmd id)
769
770 data HsCmd id
771   = HsCmdArrApp          -- Arrow tail, or arrow application (f -< arg)
772         (LHsExpr id)     -- arrow expression, f
773         (LHsExpr id)     -- input expression, arg
774         (PostTc id Type) -- type of the arrow expressions f,
775                          -- of the form a t t', where arg :: t
776         HsArrAppType     -- higher-order (-<<) or first-order (-<)
777         Bool             -- True => right-to-left (f -< arg)
778                          -- False => left-to-right (arg >- f)
779
780   | HsCmdArrForm         -- Command formation,  (| e cmd1 .. cmdn |)
781         (LHsExpr id)     -- the operator
782                          -- after type-checking, a type abstraction to be
783                          -- applied to the type of the local environment tuple
784         (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that
785                          -- were converted from OpApp's by the renamer
786         [LHsCmdTop id]   -- argument commands
787
788   | HsCmdApp    (LHsCmd id)
789                 (LHsExpr id)
790
791   | HsCmdLam    (MatchGroup id (LHsCmd id))     -- kappa
792
793   | HsCmdPar    (LHsCmd id)                     -- parenthesised command
794
795   | HsCmdCase   (LHsExpr id)
796                 (MatchGroup id (LHsCmd id))     -- bodies are HsCmd's
797
798   | HsCmdIf     (Maybe (SyntaxExpr id))         -- cond function
799                 (LHsExpr id)                    -- predicate
800                 (LHsCmd id)                     -- then part
801                 (LHsCmd id)                     -- else part
802
803   | HsCmdLet    (HsLocalBinds id)               -- let(rec)
804                 (LHsCmd  id)
805
806   | HsCmdDo     [CmdLStmt id]
807                 (PostTc id Type)                -- Type of the whole expression
808
809   | HsCmdCast   TcCoercion     -- A simpler version of HsWrap in HsExpr
810                 (HsCmd id)     -- If   cmd :: arg1 --> res
811                                --       co :: arg1 ~ arg2
812                                -- Then (HsCmdCast co cmd) :: arg2 --> res
813   deriving (Typeable)
814 deriving instance (DataId id) => Data (HsCmd id)
815
816 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
817   deriving (Data, Typeable)
818
819 \end{code}
820
821 Top-level command, introducing a new arrow.
822 This may occur inside a proc (where the stack is empty) or as an
823 argument of a command-forming operator.
824
825 \begin{code}
826 type LHsCmdTop id = Located (HsCmdTop id)
827
828 data HsCmdTop id
829   = HsCmdTop (LHsCmd id)
830              (PostTc id Type)   -- Nested tuple of inputs on the command's stack
831              (PostTc id Type)   -- return type of the command
832              (CmdSyntaxTable id) -- See Note [CmdSyntaxTable]
833   deriving (Typeable)
834 deriving instance (DataId id) => Data (HsCmdTop id)
835 \end{code}
836
837
838 \begin{code}
839 instance OutputableBndr id => Outputable (HsCmd id) where
840     ppr cmd = pprCmd cmd
841
842 -----------------------
843 -- pprCmd and pprLCmd call pprDeeper;
844 -- the underscore versions do not
845 pprLCmd :: OutputableBndr id => LHsCmd id -> SDoc
846 pprLCmd (L _ c) = pprCmd c
847
848 pprCmd :: OutputableBndr id => HsCmd id -> SDoc
849 pprCmd c | isQuietHsCmd c =            ppr_cmd c
850          | otherwise      = pprDeeper (ppr_cmd c)
851
852 isQuietHsCmd :: HsCmd id -> Bool
853 -- Parentheses do display something, but it gives little info and
854 -- if we go deeper when we go inside them then we get ugly things
855 -- like (...)
856 isQuietHsCmd (HsCmdPar _) = True
857 -- applications don't display anything themselves
858 isQuietHsCmd (HsCmdApp _ _) = True
859 isQuietHsCmd _ = False
860
861 -----------------------
862 ppr_lcmd :: OutputableBndr id => LHsCmd id -> SDoc
863 ppr_lcmd c = ppr_cmd (unLoc c)
864
865 ppr_cmd :: forall id. OutputableBndr id => HsCmd id -> SDoc
866 ppr_cmd (HsCmdPar c) = parens (ppr_lcmd c)
867
868 ppr_cmd (HsCmdApp c e)
869   = let (fun, args) = collect_args c [e] in
870     hang (ppr_lcmd fun) 2 (sep (map pprParendExpr args))
871   where
872     collect_args (L _ (HsCmdApp fun arg)) args = collect_args fun (arg:args)
873     collect_args fun args = (fun, args)
874
875 --avoid using PatternSignatures for stage1 code portability
876 ppr_cmd (HsCmdLam matches)
877   = pprMatches (LambdaExpr :: HsMatchContext id) matches
878
879 ppr_cmd (HsCmdCase expr matches)
880   = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
881           nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
882
883 ppr_cmd (HsCmdIf _ e ct ce)
884   = sep [hsep [ptext (sLit "if"), nest 2 (ppr e), ptext (sLit "then")],
885          nest 4 (ppr ct),
886          ptext (sLit "else"),
887          nest 4 (ppr ce)]
888
889 -- special case: let ... in let ...
890 ppr_cmd (HsCmdLet binds cmd@(L _ (HsCmdLet _ _)))
891   = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
892          ppr_lcmd cmd]
893
894 ppr_cmd (HsCmdLet binds cmd)
895   = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
896          hang (ptext (sLit "in"))  2 (ppr cmd)]
897
898 ppr_cmd (HsCmdDo stmts _)  = pprDo ArrowExpr stmts
899 ppr_cmd (HsCmdCast co cmd) = sep [ ppr_cmd cmd
900                                  , ptext (sLit "|>") <+> ppr co ]
901
902 ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp True)
903   = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
904 ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp False)
905   = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
906 ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp True)
907   = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
908 ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp False)
909   = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
910
911 ppr_cmd (HsCmdArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
912   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
913 ppr_cmd (HsCmdArrForm op _ args)
914   = hang (ptext (sLit "(|") <> ppr_lexpr op)
915          4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
916
917 pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
918 pprCmdArg (HsCmdTop cmd@(L _ (HsCmdArrForm _ Nothing [])) _ _ _)
919   = ppr_lcmd cmd
920 pprCmdArg (HsCmdTop cmd _ _ _)
921   = parens (ppr_lcmd cmd)
922
923 instance OutputableBndr id => Outputable (HsCmdTop id) where
924     ppr = pprCmdArg
925
926 \end{code}
927
928 %************************************************************************
929 %*                                                                      *
930 \subsection{Record binds}
931 %*                                                                      *
932 %************************************************************************
933
934 \begin{code}
935 type HsRecordBinds id = HsRecFields id (LHsExpr id)
936 \end{code}
937
938
939 %************************************************************************
940 %*                                                                      *
941 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
942 %*                                                                      *
943 %************************************************************************
944
945 @Match@es are sets of pattern bindings and right hand sides for
946 functions, patterns or case branches. For example, if a function @g@
947 is defined as:
948 \begin{verbatim}
949 g (x,y) = y
950 g ((x:ys),y) = y+1,
951 \end{verbatim}
952 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
953
954 It is always the case that each element of an @[Match]@ list has the
955 same number of @pats@s inside it.  This corresponds to saying that
956 a function defined by pattern matching must have the same number of
957 patterns in each equation.
958
959 \begin{code}
960 data MatchGroup id body
961   = MG { mg_alts    :: [LMatch id body]  -- The alternatives
962        , mg_arg_tys :: [PostTc id Type]  -- Types of the arguments, t1..tn
963        , mg_res_ty  :: PostTc id Type    -- Type of the result, tr
964        , mg_origin  :: Origin }
965      -- The type is the type of the entire group
966      --      t1 -> ... -> tn -> tr
967      -- where there are n patterns
968   deriving (Typeable)
969 deriving instance (Data body,DataId id) => Data (MatchGroup id body)
970
971 type LMatch id body = Located (Match id body)
972 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
973 --   list
974 data Match id body
975   = Match
976         [LPat id]               -- The patterns
977         (Maybe (LHsType id))    -- A type signature for the result of the match
978                                 -- Nothing after typechecking
979         (GRHSs id body)
980   deriving (Typeable)
981 deriving instance (Data body,DataId id) => Data (Match id body)
982
983 isEmptyMatchGroup :: MatchGroup id body -> Bool
984 isEmptyMatchGroup (MG { mg_alts = ms }) = null ms
985
986 matchGroupArity :: MatchGroup id body -> Arity
987 -- Precondition: MatchGroup is non-empty
988 -- This is called before type checking, when mg_arg_tys is not set
989 matchGroupArity (MG { mg_alts = alts })
990   | (alt1:_) <- alts = length (hsLMatchPats alt1)
991   | otherwise        = panic "matchGroupArity"
992
993 hsLMatchPats :: LMatch id body -> [LPat id]
994 hsLMatchPats (L _ (Match pats _ _)) = pats
995
996 -- | GRHSs are used both for pattern bindings and for Matches
997 --
998 --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
999 --        'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
1000 --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1001 --        'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
1002 data GRHSs id body
1003   = GRHSs {
1004       grhssGRHSs :: [LGRHS id body],       -- ^ Guarded RHSs
1005       grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
1006     } deriving (Typeable)
1007 deriving instance (Data body,DataId id) => Data (GRHSs id body)
1008
1009 type LGRHS id body = Located (GRHS id body)
1010
1011 -- | Guarded Right Hand Side.
1012 data GRHS id body = GRHS [GuardLStmt id] -- Guards
1013                          body            -- Right hand side
1014   deriving (Typeable)
1015 deriving instance (Data body,DataId id) => Data (GRHS id body)
1016 \end{code}
1017
1018 We know the list must have at least one @Match@ in it.
1019
1020 \begin{code}
1021 pprMatches :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1022            => HsMatchContext idL -> MatchGroup idR body -> SDoc
1023 pprMatches ctxt (MG { mg_alts = matches })
1024     = vcat (map (pprMatch ctxt) (map unLoc matches))
1025       -- Don't print the type; it's only a place-holder before typechecking
1026
1027 -- Exported to HsBinds, which can't see the defn of HsMatchContext
1028 pprFunBind :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1029            => idL -> Bool -> MatchGroup idR body -> SDoc
1030 pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
1031
1032 -- Exported to HsBinds, which can't see the defn of HsMatchContext
1033 pprPatBind :: forall bndr id body. (OutputableBndr bndr, OutputableBndr id, Outputable body)
1034            => LPat bndr -> GRHSs id body -> SDoc
1035 pprPatBind pat (grhss)
1036  = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext id) grhss)]
1037
1038 pprMatch :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1039          => HsMatchContext idL -> Match idR body -> SDoc
1040 pprMatch ctxt (Match pats maybe_ty grhss)
1041   = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats)
1042         , nest 2 ppr_maybe_ty
1043         , nest 2 (pprGRHSs ctxt grhss) ]
1044   where
1045     (herald, other_pats)
1046         = case ctxt of
1047             FunRhs fun is_infix
1048                 | not is_infix -> (pprPrefixOcc fun, pats)
1049                         -- f x y z = e
1050                         -- Not pprBndr; the AbsBinds will
1051                         -- have printed the signature
1052
1053                 | null pats2 -> (pp_infix, [])
1054                         -- x &&& y = e
1055
1056                 | otherwise -> (parens pp_infix, pats2)
1057                         -- (x &&& y) z = e
1058                 where
1059                   pp_infix = pprParendLPat pat1 <+> pprInfixOcc fun <+> pprParendLPat pat2
1060
1061             LambdaExpr -> (char '\\', pats)
1062
1063             _  -> ASSERT( null pats1 )
1064                   (ppr pat1, [])        -- No parens around the single pat
1065
1066     (pat1:pats1) = pats
1067     (pat2:pats2) = pats1
1068     ppr_maybe_ty = case maybe_ty of
1069                         Just ty -> dcolon <+> ppr ty
1070                         Nothing -> empty
1071
1072
1073 pprGRHSs :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1074          => HsMatchContext idL -> GRHSs idR body -> SDoc
1075 pprGRHSs ctxt (GRHSs grhss binds)
1076   = vcat (map (pprGRHS ctxt . unLoc) grhss)
1077  $$ ppUnless (isEmptyLocalBinds binds)
1078       (text "where" $$ nest 4 (pprBinds binds))
1079
1080 pprGRHS :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1081         => HsMatchContext idL -> GRHS idR body -> SDoc
1082 pprGRHS ctxt (GRHS [] body)
1083  =  pp_rhs ctxt body
1084
1085 pprGRHS ctxt (GRHS guards body)
1086  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt body]
1087
1088 pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc
1089 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
1090 \end{code}
1091
1092 %************************************************************************
1093 %*                                                                      *
1094 \subsection{Do stmts and list comprehensions}
1095 %*                                                                      *
1096 %************************************************************************
1097
1098 \begin{code}
1099 type LStmt id body = Located (StmtLR id id body)
1100 type LStmtLR idL idR body = Located (StmtLR idL idR body)
1101
1102 type Stmt id body = StmtLR id id body
1103
1104 type CmdLStmt   id = LStmt id (LHsCmd  id)
1105 type CmdStmt    id = Stmt  id (LHsCmd  id)
1106 type ExprLStmt  id = LStmt id (LHsExpr id)
1107 type ExprStmt   id = Stmt  id (LHsExpr id)
1108
1109 type GuardLStmt id = LStmt id (LHsExpr id)
1110 type GuardStmt  id = Stmt  id (LHsExpr id)
1111 type GhciLStmt  id = LStmt id (LHsExpr id)
1112 type GhciStmt   id = Stmt  id (LHsExpr id)
1113
1114 -- The SyntaxExprs in here are used *only* for do-notation and monad
1115 -- comprehensions, which have rebindable syntax. Otherwise they are unused.
1116 -- | API Annotations when in qualifier lists or guards
1117 --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
1118 --         'ApiAnnotation.AnnComma','ApiAnnotation.AnnThen',
1119 --         'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',
1120 --         'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'
1121 data StmtLR idL idR body -- body should always be (LHs**** idR)
1122   = LastStmt  -- Always the last Stmt in ListComp, MonadComp, PArrComp,
1123               -- and (after the renamer) DoExpr, MDoExpr
1124               -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff
1125                body
1126                (SyntaxExpr idR)   -- The return operator, used only for MonadComp
1127                                   -- For ListComp, PArrComp, we use the baked-in 'return'
1128                                   -- For DoExpr, MDoExpr, we don't appply a 'return' at all
1129                                   -- See Note [Monad Comprehensions]
1130   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'
1131   | BindStmt (LPat idL)
1132              body
1133              (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind]
1134              (SyntaxExpr idR) -- The fail operator
1135              -- The fail operator is noSyntaxExpr
1136              -- if the pattern match can't fail
1137
1138   | BodyStmt body              -- See Note [BodyStmt]
1139              (SyntaxExpr idR)  -- The (>>) operator
1140              (SyntaxExpr idR)  -- The `guard` operator; used only in MonadComp
1141                                -- See notes [Monad Comprehensions]
1142              (PostTc idR Type) -- Element type of the RHS (used for arrows)
1143
1144   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'
1145   | LetStmt  (HsLocalBindsLR idL idR)
1146
1147   -- ParStmts only occur in a list/monad comprehension
1148   | ParStmt  [ParStmtBlock idL idR]
1149              (SyntaxExpr idR)           -- Polymorphic `mzip` for monad comprehensions
1150              (SyntaxExpr idR)           -- The `>>=` operator
1151                                         -- See notes [Monad Comprehensions]
1152             -- After renaming, the ids are the binders
1153             -- bound by the stmts and used after themp
1154
1155   | TransStmt {
1156       trS_form  :: TransForm,
1157       trS_stmts :: [ExprLStmt idL],   -- Stmts to the *left* of the 'group'
1158                                       -- which generates the tuples to be grouped
1159
1160       trS_bndrs :: [(idR, idR)],      -- See Note [TransStmt binder map]
1161
1162       trS_using :: LHsExpr idR,
1163       trS_by :: Maybe (LHsExpr idR),  -- "by e" (optional)
1164         -- Invariant: if trS_form = GroupBy, then grp_by = Just e
1165
1166       trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for
1167                                       -- the inner monad comprehensions
1168       trS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator
1169       trS_fmap :: SyntaxExpr idR      -- The polymorphic 'fmap' function for desugaring
1170                                       -- Only for 'group' forms
1171     }                                 -- See Note [Monad Comprehensions]
1172
1173   -- Recursive statement (see Note [How RecStmt works] below)
1174   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'
1175   | RecStmt
1176      { recS_stmts :: [LStmtLR idL idR body]
1177
1178         -- The next two fields are only valid after renaming
1179      , recS_later_ids :: [idR] -- The ids are a subset of the variables bound by the
1180                                -- stmts that are used in stmts that follow the RecStmt
1181
1182      , recS_rec_ids :: [idR]   -- Ditto, but these variables are the "recursive" ones,
1183                                -- that are used before they are bound in the stmts of
1184                                -- the RecStmt.
1185         -- An Id can be in both groups
1186         -- Both sets of Ids are (now) treated monomorphically
1187         -- See Note [How RecStmt works] for why they are separate
1188
1189         -- Rebindable syntax
1190      , recS_bind_fn :: SyntaxExpr idR -- The bind function
1191      , recS_ret_fn  :: SyntaxExpr idR -- The return function
1192      , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
1193
1194         -- These fields are only valid after typechecking
1195      , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)
1196      , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1
1197                                      -- with recS_later_ids and recS_rec_ids,
1198                                      -- and are the expressions that should be
1199                                      -- returned by the recursion.
1200                                      -- They may not quite be the Ids themselves,
1201                                      -- because the Id may be *polymorphic*, but
1202                                      -- the returned thing has to be *monomorphic*,
1203                                      -- so they may be type applications
1204
1205       , recS_ret_ty :: PostTc idR Type -- The type of
1206                                        -- do { stmts; return (a,b,c) }
1207                                    -- With rebindable syntax the type might not
1208                                    -- be quite as simple as (m (tya, tyb, tyc)).
1209       }
1210   deriving (Typeable)
1211 deriving instance (Data body, DataId idL, DataId idR)
1212   => Data (StmtLR idL idR body)
1213
1214 data TransForm   -- The 'f' below is the 'using' function, 'e' is the by function
1215   = ThenForm     -- then f               or    then f by e             (depending on trS_by)
1216   | GroupForm    -- then group using f   or    then group by e using f (depending on trS_by)
1217   deriving (Data, Typeable)
1218
1219 data ParStmtBlock idL idR
1220   = ParStmtBlock
1221         [ExprLStmt idL]
1222         [idR]              -- The variables to be returned
1223         (SyntaxExpr idR)   -- The return operator
1224   deriving( Typeable )
1225 deriving instance (DataId idL, DataId idR) => Data (ParStmtBlock idL idR)
1226 \end{code}
1227
1228 Note [The type of bind in Stmts]
1229 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1230 Some Stmts, notably BindStmt, keep the (>>=) bind operator.
1231 We do NOT assume that it has type
1232     (>>=) :: m a -> (a -> m b) -> m b
1233 In some cases (see Trac #303, #1537) it might have a more
1234 exotic type, such as
1235     (>>=) :: m i j a -> (a -> m j k b) -> m i k b
1236 So we must be careful not to make assumptions about the type.
1237 In particular, the monad may not be uniform throughout.
1238
1239 Note [TransStmt binder map]
1240 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1241 The [(idR,idR)] in a TransStmt behaves as follows:
1242
1243   * Before renaming: []
1244
1245   * After renaming:
1246           [ (x27,x27), ..., (z35,z35) ]
1247     These are the variables
1248        bound by the stmts to the left of the 'group'
1249        and used either in the 'by' clause,
1250                 or     in the stmts following the 'group'
1251     Each item is a pair of identical variables.
1252
1253   * After typechecking:
1254           [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]
1255     Each pair has the same unique, but different *types*.
1256
1257 Note [BodyStmt]
1258 ~~~~~~~~~~~~~~~
1259 BodyStmts are a bit tricky, because what they mean
1260 depends on the context.  Consider the following contexts:
1261
1262         A do expression of type (m res_ty)
1263         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1264         * BodyStmt E any_ty:   do { ....; E; ... }
1265                 E :: m any_ty
1266           Translation: E >> ...
1267
1268         A list comprehensions of type [elt_ty]
1269         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1270         * BodyStmt E Bool:   [ .. | .... E ]
1271                         [ .. | ..., E, ... ]
1272                         [ .. | .... | ..., E | ... ]
1273                 E :: Bool
1274           Translation: if E then fail else ...
1275
1276         A guard list, guarding a RHS of type rhs_ty
1277         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1278         * BodyStmt E BooParStmtBlockl:   f x | ..., E, ... = ...rhs...
1279                 E :: Bool
1280           Translation: if E then fail else ...
1281
1282         A monad comprehension of type (m res_ty)
1283         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1284         * BodyStmt E Bool:   [ .. | .... E ]
1285                 E :: Bool
1286           Translation: guard E >> ...
1287
1288 Array comprehensions are handled like list comprehensions.
1289
1290 Note [How RecStmt works]
1291 ~~~~~~~~~~~~~~~~~~~~~~~~
1292 Example:
1293    HsDo [ BindStmt x ex
1294
1295         , RecStmt { recS_rec_ids   = [a, c]
1296                   , recS_stmts     = [ BindStmt b (return (a,c))
1297                                      , LetStmt a = ...b...
1298                                      , BindStmt c ec ]
1299                   , recS_later_ids = [a, b]
1300
1301         , return (a b) ]
1302
1303 Here, the RecStmt binds a,b,c; but
1304   - Only a,b are used in the stmts *following* the RecStmt,
1305   - Only a,c are used in the stmts *inside* the RecStmt
1306         *before* their bindings
1307
1308 Why do we need *both* rec_ids and later_ids?  For monads they could be
1309 combined into a single set of variables, but not for arrows.  That
1310 follows from the types of the respective feedback operators:
1311
1312         mfix :: MonadFix m => (a -> m a) -> m a
1313         loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
1314
1315 * For mfix, the 'a' covers the union of the later_ids and the rec_ids
1316 * For 'loop', 'c' is the later_ids and 'd' is the rec_ids
1317
1318 Note [Typing a RecStmt]
1319 ~~~~~~~~~~~~~~~~~~~~~~~
1320 A (RecStmt stmts) types as if you had written
1321
1322   (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->
1323                                  do { stmts
1324                                     ; return (v1,..vn, r1, ..., rm) })
1325
1326 where v1..vn are the later_ids
1327       r1..rm are the rec_ids
1328
1329 Note [Monad Comprehensions]
1330 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1331 Monad comprehensions require separate functions like 'return' and
1332 '>>=' for desugaring. These functions are stored in the statements
1333 used in monad comprehensions. For example, the 'return' of the 'LastStmt'
1334 expression is used to lift the body of the monad comprehension:
1335
1336   [ body | stmts ]
1337    =>
1338   stmts >>= \bndrs -> return body
1339
1340 In transform and grouping statements ('then ..' and 'then group ..') the
1341 'return' function is required for nested monad comprehensions, for example:
1342
1343   [ body | stmts, then f, rest ]
1344    =>
1345   f [ env | stmts ] >>= \bndrs -> [ body | rest ]
1346
1347 BodyStmts require the 'Control.Monad.guard' function for boolean
1348 expressions:
1349
1350   [ body | exp, stmts ]
1351    =>
1352   guard exp >> [ body | stmts ]
1353
1354 Parallel statements require the 'Control.Monad.Zip.mzip' function:
1355
1356   [ body | stmts1 | stmts2 | .. ]
1357    =>
1358   mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body
1359
1360 In any other context than 'MonadComp', the fields for most of these
1361 'SyntaxExpr's stay bottom.
1362
1363
1364 \begin{code}
1365 instance (OutputableBndr idL, OutputableBndr idR)
1366     => Outputable (ParStmtBlock idL idR) where
1367   ppr (ParStmtBlock stmts _ _) = interpp'SP stmts
1368
1369 instance (OutputableBndr idL, OutputableBndr idR, Outputable body)
1370          => Outputable (StmtLR idL idR body) where
1371     ppr stmt = pprStmt stmt
1372
1373 pprStmt :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1374         => (StmtLR idL idR body) -> SDoc
1375 pprStmt (LastStmt expr _)         = ifPprDebug (ptext (sLit "[last]")) <+> ppr expr
1376 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, larrow, ppr expr]
1377 pprStmt (LetStmt binds)           = hsep [ptext (sLit "let"), pprBinds binds]
1378 pprStmt (BodyStmt expr _ _ _)     = ppr expr
1379 pprStmt (ParStmt stmtss _ _)      = sep (punctuate (ptext (sLit " | ")) (map ppr stmtss))
1380
1381 pprStmt (TransStmt { trS_stmts = stmts, trS_by = by, trS_using = using, trS_form = form })
1382   = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])
1383
1384 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
1385                  , recS_later_ids = later_ids })
1386   = ptext (sLit "rec") <+>
1387     vcat [ ppr_do_stmts segment
1388          , ifPprDebug (vcat [ ptext (sLit "rec_ids=") <> ppr rec_ids
1389                             , ptext (sLit "later_ids=") <> ppr later_ids])]
1390
1391 pprTransformStmt :: OutputableBndr id => [id] -> LHsExpr id -> Maybe (LHsExpr id) -> SDoc
1392 pprTransformStmt bndrs using by
1393   = sep [ ptext (sLit "then") <+> ifPprDebug (braces (ppr bndrs))
1394         , nest 2 (ppr using)
1395         , nest 2 (pprBy by)]
1396
1397 pprTransStmt :: Outputable body => Maybe body -> body -> TransForm -> SDoc
1398 pprTransStmt by using ThenForm
1399   = sep [ ptext (sLit "then"), nest 2 (ppr using), nest 2 (pprBy by)]
1400 pprTransStmt by using GroupForm
1401   = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]
1402
1403 pprBy :: Outputable body => Maybe body -> SDoc
1404 pprBy Nothing  = empty
1405 pprBy (Just e) = ptext (sLit "by") <+> ppr e
1406
1407 pprDo :: (OutputableBndr id, Outputable body)
1408       => HsStmtContext any -> [LStmt id body] -> SDoc
1409 pprDo DoExpr        stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
1410 pprDo GhciStmtCtxt  stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
1411 pprDo ArrowExpr     stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
1412 pprDo MDoExpr       stmts = ptext (sLit "mdo") <+> ppr_do_stmts stmts
1413 pprDo ListComp      stmts = brackets    $ pprComp stmts
1414 pprDo PArrComp      stmts = paBrackets  $ pprComp stmts
1415 pprDo MonadComp     stmts = brackets    $ pprComp stmts
1416 pprDo _             _     = panic "pprDo" -- PatGuard, ParStmtCxt
1417
1418 ppr_do_stmts :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1419              => [LStmtLR idL idR body] -> SDoc
1420 -- Print a bunch of do stmts, with explicit braces and semicolons,
1421 -- so that we are not vulnerable to layout bugs
1422 ppr_do_stmts stmts
1423   = lbrace <+> pprDeeperList vcat (punctuate semi (map ppr stmts))
1424            <+> rbrace
1425
1426 pprComp :: (OutputableBndr id, Outputable body)
1427         => [LStmt id body] -> SDoc
1428 pprComp quals     -- Prints:  body | qual1, ..., qualn
1429   | not (null quals)
1430   , L _ (LastStmt body _) <- last quals
1431   = hang (ppr body <+> char '|') 2 (pprQuals (dropTail 1 quals))
1432   | otherwise
1433   = pprPanic "pprComp" (pprQuals quals)
1434
1435 pprQuals :: (OutputableBndr id, Outputable body)
1436         => [LStmt id body] -> SDoc
1437 -- Show list comprehension qualifiers separated by commas
1438 pprQuals quals = interpp'SP quals
1439 \end{code}
1440
1441 %************************************************************************
1442 %*                                                                      *
1443                 Template Haskell quotation brackets
1444 %*                                                                      *
1445 %************************************************************************
1446
1447 \begin{code}
1448 data HsSplice id
1449    = HsSplice            --  $z  or $(f 4)
1450         id               -- A unique name to identify this splice point
1451         (LHsExpr id)     -- See Note [Pending Splices]
1452   deriving (Typeable )
1453
1454 -- See Note [Pending Splices]
1455 data PendingSplice id
1456   = PendSplice Name (LHsExpr id)
1457   deriving( Typeable )
1458         -- It'd be convenient to re-use HsSplice, but the splice-name
1459         -- really is a Name, never an Id.  Using (PostRn id Name) is
1460         -- nearly OK, but annoyingly we can't pretty-print it.
1461
1462 data PendingRnSplice
1463   = PendingRnExpSplice        (PendingSplice Name)
1464   | PendingRnPatSplice        (PendingSplice Name)
1465   | PendingRnTypeSplice       (PendingSplice Name)
1466   | PendingRnDeclSplice       (PendingSplice Name)
1467   | PendingRnCrossStageSplice Name
1468   deriving (Data, Typeable)
1469
1470 type PendingTcSplice = PendingSplice Id
1471
1472 deriving instance (DataId id) => Data (HsSplice id)
1473 deriving instance (DataId id) => Data (PendingSplice id)
1474 \end{code}
1475
1476 Note [Pending Splices]
1477 ~~~~~~~~~~~~~~~~~~~~~~
1478 When we rename an untyped bracket, we name and lift out all the nested
1479 splices, so that when the typechecker hits the bracket, it can
1480 typecheck those nested splices without having to walk over the untyped
1481 bracket code.  So for example
1482     [| f $(g x) |]
1483 looks like
1484
1485     HsBracket (HsApp (HsVar "f") (HsSpliceE _ (g x)))
1486
1487 which the renamer rewrites to
1488
1489     HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))
1490                    [PendingRnExpSplice (HsSplice sn (g x))]
1491
1492 * The 'sn' is the Name of the splice point.
1493
1494 * The PendingRnExpSplice gives the splice that splice-point name maps to;
1495   and the typechecker can now conveniently find these sub-expressions
1496
1497 * The other copy of the splice, in the second argument of HsSpliceE
1498                                 in the renamed first arg of HsRnBracketOut
1499   is used only for pretty printing
1500
1501 There are four varieties of pending splices generated by the renamer:
1502
1503  * Pending expression splices (PendingRnExpSplice), e.g.,
1504
1505    [|$(f x) + 2|]
1506
1507  * Pending pattern splices (PendingRnPatSplice), e.g.,
1508
1509    [|\ $(f x) -> x|]
1510
1511  * Pending type splices (PendingRnTypeSplice), e.g.,
1512
1513    [|f :: $(g x)|]
1514
1515  * Pending cross-stage splices (PendingRnCrossStageSplice), e.g.,
1516
1517    \x -> [| x |]
1518
1519 There is a fifth variety of pending splice, which is generated by the type
1520 checker:
1521
1522   * Pending *typed* expression splices, (PendingTcSplice), e.g.,
1523
1524     [||1 + $$(f 2)||]
1525
1526 It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
1527 output of the renamer. However, when pretty printing the output of the renamer,
1528 e.g., in a type error message, we *do not* want to print out the pending
1529 splices. In contrast, when pretty printing the output of the type checker, we
1530 *do* want to print the pending splices. So splitting them up seems to make
1531 sense, although I hate to add another constructor to HsExpr.
1532
1533 \begin{code}
1534 instance OutputableBndr id => Outputable (HsSplice id) where
1535   ppr (HsSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
1536
1537 instance OutputableBndr id => Outputable (PendingSplice id) where
1538   ppr (PendSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
1539
1540 pprUntypedSplice :: OutputableBndr id => HsSplice id -> SDoc
1541 pprUntypedSplice = pprSplice False
1542
1543 pprTypedSplice :: OutputableBndr id => HsSplice id -> SDoc
1544 pprTypedSplice = pprSplice True
1545
1546 pprSplice :: OutputableBndr id => Bool -> HsSplice id -> SDoc
1547 pprSplice is_typed (HsSplice n e)
1548     = (if is_typed then ptext (sLit "$$") else char '$')
1549       <> ifPprDebug (brackets (ppr n)) <> eDoc
1550     where
1551           -- We use pprLExpr to match pprParendExpr:
1552           --     Using pprLExpr makes sure that we go 'deeper'
1553           --     I think that is usually (always?) right
1554           pp_as_was = pprLExpr e
1555           eDoc = case unLoc e of
1556                  HsPar _ -> pp_as_was
1557                  HsVar _ -> pp_as_was
1558                  _ -> parens pp_as_was
1559
1560 data HsBracket id = ExpBr (LHsExpr id)   -- [|  expr  |]
1561                   | PatBr (LPat id)      -- [p| pat   |]
1562                   | DecBrL [LHsDecl id]  -- [d| decls |]; result of parser
1563                   | DecBrG (HsGroup id)  -- [d| decls |]; result of renamer
1564                   | TypBr (LHsType id)   -- [t| type  |]
1565                   | VarBr Bool id        -- True: 'x, False: ''T
1566                                          -- (The Bool flag is used only in pprHsBracket)
1567                   | TExpBr (LHsExpr id)  -- [||  expr  ||]
1568   deriving (Typeable)
1569 deriving instance (DataId id) => Data (HsBracket id)
1570
1571 isTypedBracket :: HsBracket id -> Bool
1572 isTypedBracket (TExpBr {}) = True
1573 isTypedBracket _           = False
1574
1575 instance OutputableBndr id => Outputable (HsBracket id) where
1576   ppr = pprHsBracket
1577
1578
1579 pprHsBracket :: OutputableBndr id => HsBracket id -> SDoc
1580 pprHsBracket (ExpBr e)   = thBrackets empty (ppr e)
1581 pprHsBracket (PatBr p)   = thBrackets (char 'p') (ppr p)
1582 pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
1583 pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
1584 pprHsBracket (TypBr t)   = thBrackets (char 't') (ppr t)
1585 pprHsBracket (VarBr True n)  = char '\''         <> ppr n
1586 pprHsBracket (VarBr False n) = ptext (sLit "''") <> ppr n
1587 pprHsBracket (TExpBr e)  = thTyBrackets (ppr e)
1588
1589 thBrackets :: SDoc -> SDoc -> SDoc
1590 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
1591                              pp_body <+> ptext (sLit "|]")
1592
1593 thTyBrackets :: SDoc -> SDoc
1594 thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]")
1595
1596 instance Outputable PendingRnSplice where
1597   ppr (PendingRnExpSplice s)   = ppr s
1598   ppr (PendingRnPatSplice s)   = ppr s
1599   ppr (PendingRnTypeSplice s)  = ppr s
1600   ppr (PendingRnDeclSplice s)  = ppr s
1601   ppr (PendingRnCrossStageSplice name) = ppr name
1602 \end{code}
1603
1604 %************************************************************************
1605 %*                                                                      *
1606 \subsection{Enumerations and list comprehensions}
1607 %*                                                                      *
1608 %************************************************************************
1609
1610 \begin{code}
1611 data ArithSeqInfo id
1612   = From            (LHsExpr id)
1613   | FromThen        (LHsExpr id)
1614                     (LHsExpr id)
1615   | FromTo          (LHsExpr id)
1616                     (LHsExpr id)
1617   | FromThenTo      (LHsExpr id)
1618                     (LHsExpr id)
1619                     (LHsExpr id)
1620   deriving (Typeable)
1621 deriving instance (DataId id) => Data (ArithSeqInfo id)
1622 \end{code}
1623
1624 \begin{code}
1625 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
1626     ppr (From e1)             = hcat [ppr e1, pp_dotdot]
1627     ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
1628     ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]
1629     ppr (FromThenTo e1 e2 e3)
1630       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
1631
1632 pp_dotdot :: SDoc
1633 pp_dotdot = ptext (sLit " .. ")
1634 \end{code}
1635
1636
1637 %************************************************************************
1638 %*                                                                      *
1639 \subsection{HsMatchCtxt}
1640 %*                                                                      *
1641 %************************************************************************
1642
1643 \begin{code}
1644 data HsMatchContext id  -- Context of a Match
1645   = FunRhs id Bool              -- Function binding for f; True <=> written infix
1646   | LambdaExpr                  -- Patterns of a lambda
1647   | CaseAlt                     -- Patterns and guards on a case alternative
1648   | IfAlt                       -- Guards of a multi-way if alternative
1649   | ProcExpr                    -- Patterns of a proc
1650   | PatBindRhs                  -- A pattern binding  eg [y] <- e = e
1651
1652   | RecUpd                      -- Record update [used only in DsExpr to
1653                                 --    tell matchWrapper what sort of
1654                                 --    runtime error message to generate]
1655
1656   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt, list comprehension,
1657                                 -- pattern guard, etc
1658
1659   | ThPatSplice                 -- A Template Haskell pattern splice
1660   | ThPatQuote                  -- A Template Haskell pattern quotation [p| (a,b) |]
1661   | PatSyn                      -- A pattern synonym declaration
1662   deriving (Data, Typeable)
1663
1664 data HsStmtContext id
1665   = ListComp
1666   | MonadComp
1667   | PArrComp                             -- Parallel array comprehension
1668
1669   | DoExpr                               -- do { ... }
1670   | MDoExpr                              -- mdo { ... }  ie recursive do-expression
1671   | ArrowExpr                            -- do-notation in an arrow-command context
1672
1673   | GhciStmtCtxt                         -- A command-line Stmt in GHCi pat <- rhs
1674   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
1675   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
1676   | TransStmtCtxt (HsStmtContext id)     -- A branch of a transform stmt
1677   deriving (Data, Typeable)
1678 \end{code}
1679
1680 \begin{code}
1681 isListCompExpr :: HsStmtContext id -> Bool
1682 -- Uses syntax [ e | quals ]
1683 isListCompExpr ListComp          = True
1684 isListCompExpr PArrComp          = True
1685 isListCompExpr MonadComp         = True
1686 isListCompExpr (ParStmtCtxt c)   = isListCompExpr c
1687 isListCompExpr (TransStmtCtxt c) = isListCompExpr c
1688 isListCompExpr _                 = False
1689
1690 isMonadCompExpr :: HsStmtContext id -> Bool
1691 isMonadCompExpr MonadComp            = True
1692 isMonadCompExpr (ParStmtCtxt ctxt)   = isMonadCompExpr ctxt
1693 isMonadCompExpr (TransStmtCtxt ctxt) = isMonadCompExpr ctxt
1694 isMonadCompExpr _                    = False
1695 \end{code}
1696
1697 \begin{code}
1698 matchSeparator :: HsMatchContext id -> SDoc
1699 matchSeparator (FunRhs {})  = ptext (sLit "=")
1700 matchSeparator CaseAlt      = ptext (sLit "->")
1701 matchSeparator IfAlt        = ptext (sLit "->")
1702 matchSeparator LambdaExpr   = ptext (sLit "->")
1703 matchSeparator ProcExpr     = ptext (sLit "->")
1704 matchSeparator PatBindRhs   = ptext (sLit "=")
1705 matchSeparator (StmtCtxt _) = ptext (sLit "<-")
1706 matchSeparator RecUpd       = panic "unused"
1707 matchSeparator ThPatSplice  = panic "unused"
1708 matchSeparator ThPatQuote   = panic "unused"
1709 matchSeparator PatSyn       = panic "unused"
1710 \end{code}
1711
1712 \begin{code}
1713 pprMatchContext :: Outputable id => HsMatchContext id -> SDoc
1714 pprMatchContext ctxt
1715   | want_an ctxt = ptext (sLit "an") <+> pprMatchContextNoun ctxt
1716   | otherwise    = ptext (sLit "a")  <+> pprMatchContextNoun ctxt
1717   where
1718     want_an (FunRhs {}) = True  -- Use "an" in front
1719     want_an ProcExpr    = True
1720     want_an _           = False
1721
1722 pprMatchContextNoun :: Outputable id => HsMatchContext id -> SDoc
1723 pprMatchContextNoun (FunRhs fun _)  = ptext (sLit "equation for")
1724                                       <+> quotes (ppr fun)
1725 pprMatchContextNoun CaseAlt         = ptext (sLit "case alternative")
1726 pprMatchContextNoun IfAlt           = ptext (sLit "multi-way if alternative")
1727 pprMatchContextNoun RecUpd          = ptext (sLit "record-update construct")
1728 pprMatchContextNoun ThPatSplice     = ptext (sLit "Template Haskell pattern splice")
1729 pprMatchContextNoun ThPatQuote      = ptext (sLit "Template Haskell pattern quotation")
1730 pprMatchContextNoun PatBindRhs      = ptext (sLit "pattern binding")
1731 pprMatchContextNoun LambdaExpr      = ptext (sLit "lambda abstraction")
1732 pprMatchContextNoun ProcExpr        = ptext (sLit "arrow abstraction")
1733 pprMatchContextNoun (StmtCtxt ctxt) = ptext (sLit "pattern binding in")
1734                                       $$ pprStmtContext ctxt
1735 pprMatchContextNoun PatSyn          = ptext (sLit "pattern synonym declaration")
1736
1737 -----------------
1738 pprAStmtContext, pprStmtContext :: Outputable id => HsStmtContext id -> SDoc
1739 pprAStmtContext ctxt = article <+> pprStmtContext ctxt
1740   where
1741     pp_an = ptext (sLit "an")
1742     pp_a  = ptext (sLit "a")
1743     article = case ctxt of
1744                   MDoExpr       -> pp_an
1745                   PArrComp      -> pp_an
1746                   GhciStmtCtxt  -> pp_an
1747                   _             -> pp_a
1748
1749
1750 -----------------
1751 pprStmtContext GhciStmtCtxt    = ptext (sLit "interactive GHCi command")
1752 pprStmtContext DoExpr          = ptext (sLit "'do' block")
1753 pprStmtContext MDoExpr         = ptext (sLit "'mdo' block")
1754 pprStmtContext ArrowExpr       = ptext (sLit "'do' block in an arrow command")
1755 pprStmtContext ListComp        = ptext (sLit "list comprehension")
1756 pprStmtContext MonadComp       = ptext (sLit "monad comprehension")
1757 pprStmtContext PArrComp        = ptext (sLit "array comprehension")
1758 pprStmtContext (PatGuard ctxt) = ptext (sLit "pattern guard for") $$ pprMatchContext ctxt
1759
1760 -- Drop the inner contexts when reporting errors, else we get
1761 --     Unexpected transform statement
1762 --     in a transformed branch of
1763 --          transformed branch of
1764 --          transformed branch of monad comprehension
1765 pprStmtContext (ParStmtCtxt c)
1766  | opt_PprStyle_Debug = sep [ptext (sLit "parallel branch of"), pprAStmtContext c]
1767  | otherwise          = pprStmtContext c
1768 pprStmtContext (TransStmtCtxt c)
1769  | opt_PprStyle_Debug = sep [ptext (sLit "transformed branch of"), pprAStmtContext c]
1770  | otherwise          = pprStmtContext c
1771
1772
1773 -- Used to generate the string for a *runtime* error message
1774 matchContextErrString :: Outputable id => HsMatchContext id -> SDoc
1775 matchContextErrString (FunRhs fun _)             = ptext (sLit "function") <+> ppr fun
1776 matchContextErrString CaseAlt                    = ptext (sLit "case")
1777 matchContextErrString IfAlt                      = ptext (sLit "multi-way if")
1778 matchContextErrString PatBindRhs                 = ptext (sLit "pattern binding")
1779 matchContextErrString RecUpd                     = ptext (sLit "record update")
1780 matchContextErrString LambdaExpr                 = ptext (sLit "lambda")
1781 matchContextErrString ProcExpr                   = ptext (sLit "proc")
1782 matchContextErrString ThPatSplice                = panic "matchContextErrString"  -- Not used at runtime
1783 matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime
1784 matchContextErrString PatSyn                     = panic "matchContextErrString"  -- Not used at runtime
1785 matchContextErrString (StmtCtxt (ParStmtCtxt c))   = matchContextErrString (StmtCtxt c)
1786 matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1787 matchContextErrString (StmtCtxt (PatGuard _))      = ptext (sLit "pattern guard")
1788 matchContextErrString (StmtCtxt GhciStmtCtxt)      = ptext (sLit "interactive GHCi command")
1789 matchContextErrString (StmtCtxt DoExpr)            = ptext (sLit "'do' block")
1790 matchContextErrString (StmtCtxt ArrowExpr)         = ptext (sLit "'do' block")
1791 matchContextErrString (StmtCtxt MDoExpr)           = ptext (sLit "'mdo' block")
1792 matchContextErrString (StmtCtxt ListComp)          = ptext (sLit "list comprehension")
1793 matchContextErrString (StmtCtxt MonadComp)         = ptext (sLit "monad comprehension")
1794 matchContextErrString (StmtCtxt PArrComp)          = ptext (sLit "array comprehension")
1795 \end{code}
1796
1797 \begin{code}
1798 pprMatchInCtxt :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1799                => HsMatchContext idL -> Match idR body -> SDoc
1800 pprMatchInCtxt ctxt match  = hang (ptext (sLit "In") <+> pprMatchContext ctxt <> colon)
1801                              4 (pprMatch ctxt match)
1802
1803 pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
1804                => HsStmtContext idL -> StmtLR idL idR body -> SDoc
1805 pprStmtInCtxt ctxt (LastStmt e _)
1806   | isListCompExpr ctxt      -- For [ e | .. ], do not mutter about "stmts"
1807   = hang (ptext (sLit "In the expression:")) 2 (ppr e)
1808
1809 pprStmtInCtxt ctxt stmt
1810   = hang (ptext (sLit "In a stmt of") <+> pprAStmtContext ctxt <> colon)
1811        2 (ppr_stmt stmt)
1812   where
1813     -- For Group and Transform Stmts, don't print the nested stmts!
1814     ppr_stmt (TransStmt { trS_by = by, trS_using = using
1815                         , trS_form = form }) = pprTransStmt by using form
1816     ppr_stmt stmt = pprStmt stmt
1817 \end{code}