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