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