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