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