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