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