Several TH/quasiquote changes
[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   | 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 pprParendLPat 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 pats2 -> (pp_infix, [])
760                         -- x &&& y = e
761
762                 | otherwise -> (parens pp_infix, pats2)
763                         -- (x &&& y) z = e
764                 where
765                   pp_infix = pprParendLPat pat1 <+> ppr fun <+> pprParendLPat pat2
766
767             LambdaExpr -> (char '\\', pats)
768             
769             _  -> ASSERT( null pats1 )
770                   (ppr pat1, [])        -- No parens around the single pat
771
772     (pat1:pats1) = pats
773     (pat2:pats2) = pats1
774     ppr_maybe_ty = case maybe_ty of
775                         Just ty -> dcolon <+> ppr ty
776                         Nothing -> empty
777
778
779 pprGRHSs :: (OutputableBndr idL, OutputableBndr idR)
780          => HsMatchContext idL -> GRHSs idR -> SDoc
781 pprGRHSs ctxt (GRHSs grhss binds)
782   = vcat (map (pprGRHS ctxt . unLoc) grhss)
783  $$ ppUnless (isEmptyLocalBinds binds)
784       (text "where" $$ nest 4 (pprBinds binds))
785
786 pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
787         => HsMatchContext idL -> GRHS idR -> SDoc
788
789 pprGRHS ctxt (GRHS [] expr)
790  =  pp_rhs ctxt expr
791
792 pprGRHS ctxt (GRHS guards expr)
793  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
794
795 pp_rhs :: OutputableBndr idR => HsMatchContext idL -> LHsExpr idR -> SDoc
796 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
797 \end{code}
798
799 %************************************************************************
800 %*                                                                      *
801 \subsection{Do stmts and list comprehensions}
802 %*                                                                      *
803 %************************************************************************
804
805 \begin{code}
806 type LStmt id = Located (StmtLR id id)
807 type LStmtLR idL idR = Located (StmtLR idL idR)
808
809 type Stmt id = StmtLR id id
810
811 data GroupByClause id
812     = GroupByNothing (LHsExpr id) -- Using expression, i.e.
813                                   -- "then group using f" ==> GroupByNothing f
814     | GroupBySomething (Either (LHsExpr id) (SyntaxExpr id)) (LHsExpr id)
815       -- "then group using f by e" ==> GroupBySomething (Left f) e
816       -- "then group by e"         ==> GroupBySomething (Right _) e: in
817       --                               this case the expression is filled
818       --                               in by the renamer
819
820 -- The SyntaxExprs in here are used *only* for do-notation, which
821 -- has rebindable syntax.  Otherwise they are unused.
822 data StmtLR idL idR
823   = BindStmt (LPat idL)
824              (LHsExpr idR)
825              (SyntaxExpr idR) -- The (>>=) operator
826              (SyntaxExpr idR) -- The fail operator
827              -- The fail operator is noSyntaxExpr
828              -- if the pattern match can't fail
829
830   | ExprStmt (LHsExpr idR)
831              (SyntaxExpr idR) -- The (>>) operator
832              PostTcType       -- Element type of the RHS (used for arrows)
833
834   | LetStmt  (HsLocalBindsLR idL idR)
835
836   -- ParStmts only occur in a list comprehension
837   | ParStmt  [([LStmt idL], [idR])]
838   -- After renaming, the ids are the binders bound by the stmts and used
839   -- after them
840
841   | TransformStmt ([LStmt idL], [idR]) (LHsExpr idR) (Maybe (LHsExpr idR))
842   -- After renaming, the IDs are the binders occurring within this
843   -- transform statement that are used after it
844   -- "qs, then f by e" ==> TransformStmt (qs, binders) f (Just e)
845   -- "qs, then f"      ==> TransformStmt (qs, binders) f Nothing
846
847   | GroupStmt ([LStmt idL], [(idR, idR)]) (GroupByClause idR)
848   -- After renaming, the IDs are the binders occurring within this
849   -- transform statement that are used after it which are paired with
850   -- the names which they group over in statements
851
852   -- Recursive statement (see Note [RecStmt] below)
853   | RecStmt
854      { recS_stmts :: [LStmtLR idL idR]
855
856         -- The next two fields are only valid after renaming
857      , recS_later_ids :: [idR] -- The ids are a subset of the variables bound by the
858                                -- stmts that are used in stmts that follow the RecStmt
859
860      , recS_rec_ids :: [idR]   -- Ditto, but these variables are the "recursive" ones,
861                                -- that are used before they are bound in the stmts of
862                                -- the RecStmt. 
863         -- An Id can be in both groups
864         -- Both sets of Ids are (now) treated monomorphically
865         -- See Note [How RecStmt works] for why they are separate
866
867         -- Rebindable syntax
868      , recS_bind_fn :: SyntaxExpr idR -- The bind function
869      , recS_ret_fn  :: SyntaxExpr idR -- The return function
870      , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
871
872         -- These fields are only valid after typechecking
873      , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1 with
874                                      -- recS_rec_ids, and are the
875                                      -- expressions that should be returned by
876                                      -- the recursion.
877                                      -- They may not quite be the Ids themselves,
878                                      -- because the Id may be *polymorphic*, but
879                                      -- the returned thing has to be *monomorphic*, 
880                                      -- so they may be type applications
881
882       , recS_dicts :: DictBinds idR  -- Method bindings of Ids bound by the
883                                      -- RecStmt, and used afterwards
884       }
885 \end{code}
886
887 ExprStmts are a bit tricky, because what they mean
888 depends on the context.  Consider the following contexts:
889
890         A do expression of type (m res_ty)
891         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
892         * ExprStmt E any_ty:   do { ....; E; ... }
893                 E :: m any_ty
894           Translation: E >> ...
895
896         A list comprehensions of type [elt_ty]
897         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
898         * ExprStmt E Bool:   [ .. | .... E ]
899                         [ .. | ..., E, ... ]
900                         [ .. | .... | ..., E | ... ]
901                 E :: Bool
902           Translation: if E then fail else ...
903
904         A guard list, guarding a RHS of type rhs_ty
905         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
906         * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
907                 E :: Bool
908           Translation: if E then fail else ...
909
910 Array comprehensions are handled like list comprehensions -=chak
911
912 Note [How RecStmt works]
913 ~~~~~~~~~~~~~~~~~~~~~~~~
914 Example:
915    HsDo [ BindStmt x ex
916
917         , RecStmt { recS_rec_ids   = [a, c]
918                   , recS_stmts     = [ BindStmt b (return (a,c))
919                                      , LetStmt a = ...b...
920                                      , BindStmt c ec ]
921                   , recS_later_ids = [a, b]
922
923         , return (a b) ]
924
925 Here, the RecStmt binds a,b,c; but
926   - Only a,b are used in the stmts *following* the RecStmt,
927   - Only a,c are used in the stmts *inside* the RecStmt
928         *before* their bindings
929
930 Why do we need *both* rec_ids and later_ids?  For monads they could be
931 combined into a single set of variables, but not for arrows.  That
932 follows from the types of the respective feedback operators:
933
934         mfix :: MonadFix m => (a -> m a) -> m a
935         loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
936
937 * For mfix, the 'a' covers the union of the later_ids and the rec_ids 
938 * For 'loop', 'c' is the later_ids and 'd' is the rec_ids 
939
940 Note [Typing a RecStmt]
941 ~~~~~~~~~~~~~~~~~~~~~~~
942 A (RecStmt stmts) types as if you had written
943
944   (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->
945                                  do { stmts 
946                                     ; return (v1,..vn, r1, ..., rm) })
947
948 where v1..vn are the later_ids
949       r1..rm are the rec_ids
950
951
952 \begin{code}
953 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) where
954     ppr stmt = pprStmt stmt
955
956 pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
957 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, ptext (sLit "<-"), ppr expr]
958 pprStmt (LetStmt binds)           = hsep [ptext (sLit "let"), pprBinds binds]
959 pprStmt (ExprStmt expr _ _)       = ppr expr
960 pprStmt (ParStmt stmtss)          = hsep (map doStmts stmtss)
961   where doStmts stmts = ptext (sLit "| ") <> ppr stmts
962 pprStmt (TransformStmt (stmts, _) usingExpr maybeByExpr)
963     = (hsep [stmtsDoc, ptext (sLit "then"), ppr usingExpr, byExprDoc])
964   where stmtsDoc = interpp'SP stmts
965         byExprDoc = maybe empty (\byExpr -> hsep [ptext (sLit "by"), ppr byExpr]) maybeByExpr
966 pprStmt (GroupStmt (stmts, _) groupByClause) = (hsep [stmtsDoc, ptext (sLit "then group"), pprGroupByClause groupByClause])
967   where stmtsDoc = interpp'SP stmts
968 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids, recS_later_ids = later_ids })
969   = ptext (sLit "rec") <+> 
970     vcat [ braces (vcat (map ppr segment))
971          , ifPprDebug (vcat [ ptext (sLit "rec_ids=") <> ppr rec_ids
972                             , ptext (sLit "later_ids=") <> ppr later_ids])]
973
974 pprGroupByClause :: (OutputableBndr id) => GroupByClause id -> SDoc
975 pprGroupByClause (GroupByNothing usingExpr) = hsep [ptext (sLit "using"), ppr usingExpr]
976 pprGroupByClause (GroupBySomething eitherUsingExpr byExpr) = hsep [ptext (sLit "by"), ppr byExpr, usingExprDoc]
977   where usingExprDoc = either (\usingExpr -> hsep [ptext (sLit "using"), ppr usingExpr]) (const empty) eitherUsingExpr
978
979 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
980 pprDo DoExpr      stmts body = ptext (sLit "do")  <+> ppr_do_stmts stmts body
981 pprDo GhciStmt    stmts body = ptext (sLit "do")  <+> ppr_do_stmts stmts body
982 pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> ppr_do_stmts stmts body
983 pprDo ListComp    stmts body = pprComp brackets    stmts body
984 pprDo PArrComp    stmts body = pprComp pa_brackets stmts body
985 pprDo _           _     _    = panic "pprDo" -- PatGuard, ParStmtCxt
986
987 ppr_do_stmts :: OutputableBndr id => [LStmt id] -> LHsExpr id -> SDoc
988 -- Print a bunch of do stmts, with explicit braces and semicolons,
989 -- so that we are not vulnerable to layout bugs
990 ppr_do_stmts stmts body
991   = lbrace <+> pprDeeperList vcat ([ ppr s <> semi | s <- stmts] ++ [ppr body])
992            <+> rbrace
993
994 pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
995 pprComp brack quals body
996   = brack $
997         hang (ppr body <+> char '|')
998              4 (interpp'SP quals)
999 \end{code}
1000
1001 %************************************************************************
1002 %*                                                                      *
1003                 Template Haskell quotation brackets
1004 %*                                                                      *
1005 %************************************************************************
1006
1007 \begin{code}
1008 data HsSplice id  = HsSplice            --  $z  or $(f 4)
1009                         id              -- The id is just a unique name to
1010                         (LHsExpr id)    -- identify this splice point
1011
1012 instance OutputableBndr id => Outputable (HsSplice id) where
1013   ppr = pprSplice
1014
1015 pprSplice :: OutputableBndr id => HsSplice id -> SDoc
1016 pprSplice (HsSplice n e)
1017     = char '$' <> ifPprDebug (brackets (ppr n)) <> pprParendExpr e
1018
1019
1020 data HsBracket id = ExpBr (LHsExpr id)   -- [|  expr  |]
1021                   | PatBr (LPat id)      -- [p| pat   |]
1022                   | DecBrL [LHsDecl id]  -- [d| decls |]; result of parser
1023                   | DecBrG (HsGroup id)  -- [d| decls |]; result of renamer
1024                   | TypBr (LHsType id)   -- [t| type  |]
1025                   | VarBr id             -- 'x, ''T
1026
1027 instance OutputableBndr id => Outputable (HsBracket id) where
1028   ppr = pprHsBracket
1029
1030
1031 pprHsBracket :: OutputableBndr id => HsBracket id -> SDoc
1032 pprHsBracket (ExpBr e)   = thBrackets empty (ppr e)
1033 pprHsBracket (PatBr p)   = thBrackets (char 'p') (ppr p)
1034 pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
1035 pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
1036 pprHsBracket (TypBr t)   = thBrackets (char 't') (ppr t)
1037 pprHsBracket (VarBr n)   = char '\'' <> ppr n
1038 -- Infelicity: can't show ' vs '', because
1039 -- we can't ask n what its OccName is, because the
1040 -- pretty-printer for HsExpr doesn't ask for NamedThings
1041 -- But the pretty-printer for names will show the OccName class
1042
1043 thBrackets :: SDoc -> SDoc -> SDoc
1044 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
1045                              pp_body <+> ptext (sLit "|]")
1046 \end{code}
1047
1048 %************************************************************************
1049 %*                                                                      *
1050 \subsection{Enumerations and list comprehensions}
1051 %*                                                                      *
1052 %************************************************************************
1053
1054 \begin{code}
1055 data ArithSeqInfo id
1056   = From            (LHsExpr id)
1057   | FromThen        (LHsExpr id)
1058                     (LHsExpr id)
1059   | FromTo          (LHsExpr id)
1060                     (LHsExpr id)
1061   | FromThenTo      (LHsExpr id)
1062                     (LHsExpr id)
1063                     (LHsExpr id)
1064 \end{code}
1065
1066 \begin{code}
1067 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
1068     ppr (From e1)             = hcat [ppr e1, pp_dotdot]
1069     ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
1070     ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]
1071     ppr (FromThenTo e1 e2 e3)
1072       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
1073
1074 pp_dotdot :: SDoc
1075 pp_dotdot = ptext (sLit " .. ")
1076 \end{code}
1077
1078
1079 %************************************************************************
1080 %*                                                                      *
1081 \subsection{HsMatchCtxt}
1082 %*                                                                      *
1083 %************************************************************************
1084
1085 \begin{code}
1086 data HsMatchContext id  -- Context of a Match
1087   = FunRhs id Bool              -- Function binding for f; True <=> written infix
1088   | CaseAlt                     -- Patterns and guards on a case alternative
1089   | LambdaExpr                  -- Patterns of a lambda
1090   | ProcExpr                    -- Patterns of a proc
1091   | PatBindRhs                  -- Patterns in the *guards* of a pattern binding
1092   | RecUpd                      -- Record update [used only in DsExpr to
1093                                 --    tell matchWrapper what sort of
1094                                 --    runtime error message to generate]
1095   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
1096   | ThPatQuote                  -- A Template Haskell pattern quotation [p| (a,b) |]
1097   deriving ()
1098
1099 data HsStmtContext id
1100   = ListComp
1101   | DoExpr
1102   | GhciStmt                             -- A command-line Stmt in GHCi pat <- rhs
1103   | MDoExpr PostTcTable                  -- Recursive do-expression
1104                                          -- (tiresomely, it needs table
1105                                          --  of its return/bind ops)
1106   | PArrComp                             -- Parallel array comprehension
1107   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
1108   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
1109   | TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt
1110 \end{code}
1111
1112 \begin{code}
1113 isDoExpr :: HsStmtContext id -> Bool
1114 isDoExpr DoExpr      = True
1115 isDoExpr (MDoExpr _) = True
1116 isDoExpr _           = False
1117
1118 isListCompExpr :: HsStmtContext id -> Bool
1119 isListCompExpr ListComp = True
1120 isListCompExpr PArrComp = True
1121 isListCompExpr _        = False
1122 \end{code}
1123
1124 \begin{code}
1125 matchSeparator :: HsMatchContext id -> SDoc
1126 matchSeparator (FunRhs {})  = ptext (sLit "=")
1127 matchSeparator CaseAlt      = ptext (sLit "->")
1128 matchSeparator LambdaExpr   = ptext (sLit "->")
1129 matchSeparator ProcExpr     = ptext (sLit "->")
1130 matchSeparator PatBindRhs   = ptext (sLit "=")
1131 matchSeparator (StmtCtxt _) = ptext (sLit "<-")
1132 matchSeparator RecUpd       = panic "unused"
1133 matchSeparator ThPatQuote   = panic "unused"
1134 \end{code}
1135
1136 \begin{code}
1137 pprMatchContext :: Outputable id => HsMatchContext id -> SDoc
1138 pprMatchContext (FunRhs fun _)    = ptext (sLit "the definition of")
1139                                     <+> quotes (ppr fun)
1140 pprMatchContext CaseAlt           = ptext (sLit "a case alternative")
1141 pprMatchContext RecUpd            = ptext (sLit "a record-update construct")
1142 pprMatchContext ThPatQuote        = ptext (sLit "a Template Haskell pattern quotation")
1143 pprMatchContext PatBindRhs        = ptext (sLit "a pattern binding")
1144 pprMatchContext LambdaExpr        = ptext (sLit "a lambda abstraction")
1145 pprMatchContext ProcExpr          = ptext (sLit "an arrow abstraction")
1146 pprMatchContext (StmtCtxt ctxt)   = ptext (sLit "a pattern binding in")
1147                                     $$ pprStmtContext ctxt
1148
1149 pprStmtContext :: Outputable id => HsStmtContext id -> SDoc
1150 pprStmtContext (ParStmtCtxt c)
1151  = sep [ptext (sLit "a parallel branch of"), pprStmtContext c]
1152 pprStmtContext (TransformStmtCtxt c)
1153  = sep [ptext (sLit "a transformed branch of"), pprStmtContext c]
1154 pprStmtContext (PatGuard ctxt)
1155  = ptext (sLit "a pattern guard for") $$ pprMatchContext ctxt
1156 pprStmtContext GhciStmt        = ptext (sLit "an interactive GHCi command")
1157 pprStmtContext DoExpr          = ptext (sLit "a 'do' expression")
1158 pprStmtContext (MDoExpr _)     = ptext (sLit "an 'mdo' expression")
1159 pprStmtContext ListComp        = ptext (sLit "a list comprehension")
1160 pprStmtContext PArrComp        = ptext (sLit "an array comprehension")
1161
1162 {-
1163 pprMatchRhsContext (FunRhs fun) = ptext (sLit "a right-hand side of function") <+> quotes (ppr fun)
1164 pprMatchRhsContext CaseAlt      = ptext (sLit "the body of a case alternative")
1165 pprMatchRhsContext PatBindRhs   = ptext (sLit "the right-hand side of a pattern binding")
1166 pprMatchRhsContext LambdaExpr   = ptext (sLit "the body of a lambda")
1167 pprMatchRhsContext ProcExpr     = ptext (sLit "the body of a proc")
1168 pprMatchRhsContext other        = panic "pprMatchRhsContext"    -- RecUpd, StmtCtxt
1169
1170 -- Used for the result statement of comprehension
1171 -- e.g. the 'e' in      [ e | ... ]
1172 --      or the 'r' in   f x = r
1173 pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
1174 pprStmtResultContext other           = ptext (sLit "the result of") <+> pprStmtContext other
1175 -}
1176
1177 -- Used to generate the string for a *runtime* error message
1178 matchContextErrString :: Outputable id => HsMatchContext id -> SDoc
1179 matchContextErrString (FunRhs fun _)             = ptext (sLit "function") <+> ppr fun
1180 matchContextErrString CaseAlt                    = ptext (sLit "case")
1181 matchContextErrString PatBindRhs                 = ptext (sLit "pattern binding")
1182 matchContextErrString RecUpd                     = ptext (sLit "record update")
1183 matchContextErrString LambdaExpr                 = ptext (sLit "lambda")
1184 matchContextErrString ProcExpr                   = ptext (sLit "proc")
1185 matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime
1186 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1187 matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1188 matchContextErrString (StmtCtxt (PatGuard _))    = ptext (sLit "pattern guard")
1189 matchContextErrString (StmtCtxt GhciStmt)        = ptext (sLit "interactive GHCi command")
1190 matchContextErrString (StmtCtxt DoExpr)          = ptext (sLit "'do' expression")
1191 matchContextErrString (StmtCtxt (MDoExpr _))     = ptext (sLit "'mdo' expression")
1192 matchContextErrString (StmtCtxt ListComp)        = ptext (sLit "list comprehension")
1193 matchContextErrString (StmtCtxt PArrComp)        = ptext (sLit "array comprehension")
1194 \end{code}
1195
1196 \begin{code}
1197 pprMatchInCtxt :: (OutputableBndr idL, OutputableBndr idR)
1198                => HsMatchContext idL -> Match idR -> SDoc
1199 pprMatchInCtxt ctxt match  = hang (ptext (sLit "In") <+> pprMatchContext ctxt <> colon) 
1200                              4 (pprMatch ctxt match)
1201
1202 pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR)
1203                => HsStmtContext idL -> StmtLR idL idR -> SDoc
1204 pprStmtInCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprStmtContext ctxt <> colon)
1205                           4 (ppr stmt)
1206 \end{code}