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