Implement unboxed sum primitive type
[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 {-# LANGUAGE ExistentialQuantification #-}
13 {-# LANGUAGE DeriveFunctor #-}
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 PlaceHolder ( PostTc,PostRn,DataId,DataIdPost,
25 NameOrRdrName,OutputableBndrId )
26 import HsTypes
27 import HsBinds
28
29 -- others:
30 import TcEvidence
31 import CoreSyn
32 import Var
33 import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
34 import Name
35 import NameSet
36 import RdrName ( GlobalRdrEnv )
37 import BasicTypes
38 import ConLike
39 import SrcLoc
40 import Util
41 import StaticFlags( opt_PprStyle_Debug )
42 import Outputable
43 import FastString
44 import Type
45
46 -- libraries:
47 import Data.Data hiding (Fixity(..))
48 import qualified Data.Data as Data (Fixity(..))
49 import Data.Maybe (isNothing)
50
51 #ifdef GHCI
52 import GHCi.RemoteTypes ( ForeignRef )
53 import qualified Language.Haskell.TH as TH (Q)
54 #endif
55
56 {-
57 ************************************************************************
58 * *
59 \subsection{Expressions proper}
60 * *
61 ************************************************************************
62 -}
63
64 -- * Expressions proper
65
66 type LHsExpr id = Located (HsExpr id)
67 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
68 -- in a list
69
70 -- For details on above see note [Api annotations] in ApiAnnotation
71
72 -------------------------
73 -- | PostTcExpr is an evidence expression attached to the syntax tree by the
74 -- type checker (c.f. postTcType).
75 type PostTcExpr = HsExpr Id
76 -- | We use a PostTcTable where there are a bunch of pieces of evidence, more
77 -- than is convenient to keep individually.
78 type PostTcTable = [(Name, PostTcExpr)]
79
80 noPostTcExpr :: PostTcExpr
81 noPostTcExpr = HsLit (HsString "" (fsLit "noPostTcExpr"))
82
83 noPostTcTable :: PostTcTable
84 noPostTcTable = []
85
86 -------------------------
87 -- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
88 -- by the renamer. It's used for rebindable syntax.
89 --
90 -- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
91 -- @(>>=)@, and then instantiated by the type checker with its type args
92 -- etc
93 --
94 -- This should desugar to
95 --
96 -- > syn_res_wrap $ syn_expr (syn_arg_wraps[0] arg0)
97 -- > (syn_arg_wraps[1] arg1) ...
98 --
99 -- where the actual arguments come from elsewhere in the AST.
100 -- This could be defined using @PostRn@ and @PostTc@ and such, but it's
101 -- harder to get it all to work out that way. ('noSyntaxExpr' is hard to
102 -- write, for example.)
103 data SyntaxExpr id = SyntaxExpr { syn_expr :: HsExpr id
104 , syn_arg_wraps :: [HsWrapper]
105 , syn_res_wrap :: HsWrapper }
106 deriving instance (DataId id) => Data (SyntaxExpr id)
107
108 -- | This is used for rebindable-syntax pieces that are too polymorphic
109 -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
110 noExpr :: HsExpr id
111 noExpr = HsLit (HsString "" (fsLit "noExpr"))
112
113 noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
114 -- (if the syntax slot makes no sense)
115 noSyntaxExpr = SyntaxExpr { syn_expr = HsLit (HsString "" (fsLit "noSyntaxExpr"))
116 , syn_arg_wraps = []
117 , syn_res_wrap = WpHole }
118
119 -- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
120 -- renamer), missing its HsWrappers.
121 mkRnSyntaxExpr :: Name -> SyntaxExpr Name
122 mkRnSyntaxExpr name = SyntaxExpr { syn_expr = HsVar $ noLoc name
123 , syn_arg_wraps = []
124 , syn_res_wrap = WpHole }
125 -- don't care about filling in syn_arg_wraps because we're clearly
126 -- not past the typechecker
127
128 instance (OutputableBndrId id) => Outputable (SyntaxExpr id) where
129 ppr (SyntaxExpr { syn_expr = expr
130 , syn_arg_wraps = arg_wraps
131 , syn_res_wrap = res_wrap })
132 = sdocWithDynFlags $ \ dflags ->
133 getPprStyle $ \s ->
134 if debugStyle s || gopt Opt_PrintExplicitCoercions dflags
135 then ppr expr <> braces (pprWithCommas ppr arg_wraps)
136 <> braces (ppr res_wrap)
137 else ppr expr
138
139 type CmdSyntaxTable id = [(Name, HsExpr id)]
140 -- See Note [CmdSyntaxTable]
141
142 {-
143 Note [CmdSyntaxtable]
144 ~~~~~~~~~~~~~~~~~~~~~
145 Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps
146 track of the methods needed for a Cmd.
147
148 * Before the renamer, this list is an empty list
149
150 * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
151 For example, for the 'arr' method
152 * normal case: (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr)
153 * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22)
154 where @arr_22@ is whatever 'arr' is in scope
155
156 * After the type checker, it takes the form [(std_name, <expression>)]
157 where <expression> is the evidence for the method. This evidence is
158 instantiated with the class, but is still polymorphic in everything
159 else. For example, in the case of 'arr', the evidence has type
160 forall b c. (b->c) -> a b c
161 where 'a' is the ambient type of the arrow. This polymorphism is
162 important because the desugarer uses the same evidence at multiple
163 different types.
164
165 This is Less Cool than what we normally do for rebindable syntax, which is to
166 make fully-instantiated piece of evidence at every use site. The Cmd way
167 is Less Cool because
168 * The renamer has to predict which methods are needed.
169 See the tedious RnExpr.methodNamesCmd.
170
171 * The desugarer has to know the polymorphic type of the instantiated
172 method. This is checked by Inst.tcSyntaxName, but is less flexible
173 than the rest of rebindable syntax, where the type is less
174 pre-ordained. (And this flexibility is useful; for example we can
175 typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
176 -}
177
178 -- | An unbound variable; used for treating out-of-scope variables as
179 -- expression holes
180 data UnboundVar
181 = OutOfScope OccName GlobalRdrEnv -- ^ An (unqualified) out-of-scope
182 -- variable, together with the GlobalRdrEnv
183 -- with respect to which it is unbound
184
185 -- See Note [OutOfScope and GlobalRdrEnv]
186
187 | TrueExprHole OccName -- ^ A "true" expression hole (_ or _x)
188
189 deriving Data
190
191 instance Outputable UnboundVar where
192 ppr = ppr . unboundVarOcc
193
194 unboundVarOcc :: UnboundVar -> OccName
195 unboundVarOcc (OutOfScope occ _) = occ
196 unboundVarOcc (TrueExprHole occ) = occ
197
198 {-
199 Note [OutOfScope and GlobalRdrEnv]
200 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
201 To understand why we bundle a GlobalRdrEnv with an out-of-scope variable,
202 consider the following module:
203
204 module A where
205
206 foo :: ()
207 foo = bar
208
209 bat :: [Double]
210 bat = [1.2, 3.4]
211
212 $(return [])
213
214 bar = ()
215 bad = False
216
217 When A is compiled, the renamer determines that `bar` is not in scope in the
218 declaration of `foo` (since `bar` is declared in the following inter-splice
219 group). Once it has finished typechecking the entire module, the typechecker
220 then generates the associated error message, which specifies both the type of
221 `bar` and a list of possible in-scope alternatives:
222
223 A.hs:6:7: error:
224 • Variable not in scope: bar :: ()
225 • ‘bar’ (line 13) is not in scope before the splice on line 11
226 Perhaps you meant ‘bat’ (line 9)
227
228 When it calls RnEnv.unknownNameSuggestions to identify these alternatives, the
229 typechecker must provide a GlobalRdrEnv. If it provided the current one, which
230 contains top-level declarations for the entire module, the error message would
231 incorrectly suggest the out-of-scope `bar` and `bad` as possible alternatives
232 for `bar` (see Trac #11680). Instead, the typechecker must use the same
233 GlobalRdrEnv the renamer used when it determined that `bar` is out-of-scope.
234
235 To obtain this GlobalRdrEnv, can the typechecker simply use the out-of-scope
236 `bar`'s location to either reconstruct it (from the current GlobalRdrEnv) or to
237 look it up in some global store? Unfortunately, no. The problem is that
238 location information is not always sufficient for this task. This is most
239 apparent when dealing with the TH function addTopDecls, which adds its
240 declarations to the FOLLOWING inter-splice group. Consider these declarations:
241
242 ex9 = cat -- cat is NOT in scope here
243
244 $(do -------------------------------------------------------------
245 ds <- [d| f = cab -- cat and cap are both in scope here
246 cat = ()
247 |]
248 addTopDecls ds
249 [d| g = cab -- only cap is in scope here
250 cap = True
251 |])
252
253 ex10 = cat -- cat is NOT in scope here
254
255 $(return []) -----------------------------------------------------
256
257 ex11 = cat -- cat is in scope
258
259 Here, both occurrences of `cab` are out-of-scope, and so the typechecker needs
260 the GlobalRdrEnvs which were used when they were renamed. These GlobalRdrEnvs
261 are different (`cat` is present only in the GlobalRdrEnv for f's `cab'), but the
262 locations of the two `cab`s are the same (they are both created in the same
263 splice). Thus, we must include some additional information with each `cab` to
264 allow the typechecker to obtain the correct GlobalRdrEnv. Clearly, the simplest
265 information to use is the GlobalRdrEnv itself.
266 -}
267
268 -- | A Haskell expression.
269 data HsExpr id
270 = HsVar (Located id) -- ^ Variable
271
272 -- See Note [Located RdrNames]
273
274 | HsUnboundVar UnboundVar -- ^ Unbound variable; also used for "holes"
275 -- (_ or _x).
276 -- Turned from HsVar to HsUnboundVar by the
277 -- renamer, when it finds an out-of-scope
278 -- variable or hole.
279 -- Turned into HsVar by type checker, to support
280 -- deferred type errors.
281
282 | HsRecFld (AmbiguousFieldOcc id) -- ^ Variable pointing to record selector
283
284 | HsOverLabel FastString -- ^ Overloaded label (See Note [Overloaded labels]
285 -- in GHC.OverloadedLabels)
286 | HsIPVar HsIPName -- ^ Implicit parameter
287 | HsOverLit (HsOverLit id) -- ^ Overloaded literals
288
289 | HsLit HsLit -- ^ Simple (non-overloaded) literals
290
291 | HsLam (MatchGroup id (LHsExpr id)) -- ^ Lambda abstraction. Currently always a single match
292 --
293 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
294 -- 'ApiAnnotation.AnnRarrow',
295
296 -- For details on above see note [Api annotations] in ApiAnnotation
297
298 | HsLamCase (MatchGroup id (LHsExpr id)) -- ^ Lambda-case
299 --
300 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
301 -- 'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
302 -- 'ApiAnnotation.AnnClose'
303
304 -- For details on above see note [Api annotations] in ApiAnnotation
305
306 | HsApp (LHsExpr id) (LHsExpr id) -- ^ Application
307
308 | HsAppType (LHsExpr id) (LHsWcType id) -- ^ Visible type application
309 --
310 -- Explicit type argument; e.g f @Int x y
311 -- NB: Has wildcards, but no implicit quantification
312 --
313 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',
314
315 | HsAppTypeOut (LHsExpr id) (LHsWcType Name) -- just for pretty-printing
316
317
318 -- | Operator applications:
319 -- NB Bracketed ops such as (+) come out as Vars.
320
321 -- NB We need an expr for the operator in an OpApp/Section since
322 -- the typechecker may need to apply the operator to a few types.
323
324 | OpApp (LHsExpr id) -- left operand
325 (LHsExpr id) -- operator
326 (PostRn id Fixity) -- Renamer adds fixity; bottom until then
327 (LHsExpr id) -- right operand
328
329 -- | Negation operator. Contains the negated expression and the name
330 -- of 'negate'
331 --
332 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
333
334 -- For details on above see note [Api annotations] in ApiAnnotation
335 | NegApp (LHsExpr id)
336 (SyntaxExpr id)
337
338 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
339 -- 'ApiAnnotation.AnnClose' @')'@
340
341 -- For details on above see note [Api annotations] in ApiAnnotation
342 | HsPar (LHsExpr id) -- ^ Parenthesised expr; see Note [Parens in HsSyn]
343
344 | SectionL (LHsExpr id) -- operand; see Note [Sections in HsSyn]
345 (LHsExpr id) -- operator
346 | SectionR (LHsExpr id) -- operator; see Note [Sections in HsSyn]
347 (LHsExpr id) -- operand
348
349 -- | Used for explicit tuples and sections thereof
350 --
351 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
352 -- 'ApiAnnotation.AnnClose'
353
354 -- For details on above see note [Api annotations] in ApiAnnotation
355 | ExplicitTuple
356 [LHsTupArg id]
357 Boxity
358
359 | ExplicitSum
360 ConTag -- Alternative (one-based)
361 Arity -- Sum arity
362 (LHsExpr id)
363 (PostTc id [Type]) -- the type arguments
364
365 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
366 -- 'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
367 -- 'ApiAnnotation.AnnClose' @'}'@
368
369 -- For details on above see note [Api annotations] in ApiAnnotation
370 | HsCase (LHsExpr id)
371 (MatchGroup id (LHsExpr id))
372
373 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
374 -- 'ApiAnnotation.AnnSemi',
375 -- 'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
376 -- 'ApiAnnotation.AnnElse',
377
378 -- For details on above see note [Api annotations] in ApiAnnotation
379 | HsIf (Maybe (SyntaxExpr id)) -- cond function
380 -- Nothing => use the built-in 'if'
381 -- See Note [Rebindable if]
382 (LHsExpr id) -- predicate
383 (LHsExpr id) -- then part
384 (LHsExpr id) -- else part
385
386 -- | Multi-way if
387 --
388 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'
389 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
390
391 -- For details on above see note [Api annotations] in ApiAnnotation
392 | HsMultiIf (PostTc id Type) [LGRHS id (LHsExpr id)]
393
394 -- | let(rec)
395 --
396 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
397 -- 'ApiAnnotation.AnnOpen' @'{'@,
398 -- 'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
399
400 -- For details on above see note [Api annotations] in ApiAnnotation
401 | HsLet (Located (HsLocalBinds id))
402 (LHsExpr id)
403
404 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
405 -- 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
406 -- 'ApiAnnotation.AnnVbar',
407 -- 'ApiAnnotation.AnnClose'
408
409 -- For details on above see note [Api annotations] in ApiAnnotation
410 | HsDo (HsStmtContext Name) -- The parameterisation is unimportant
411 -- because in this context we never use
412 -- the PatGuard or ParStmt variant
413 (Located [ExprLStmt id]) -- "do":one or more stmts
414 (PostTc id Type) -- Type of the whole expression
415
416 -- | Syntactic list: [a,b,c,...]
417 --
418 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
419 -- 'ApiAnnotation.AnnClose' @']'@
420
421 -- For details on above see note [Api annotations] in ApiAnnotation
422 | ExplicitList
423 (PostTc id Type) -- Gives type of components of list
424 (Maybe (SyntaxExpr id)) -- For OverloadedLists, the fromListN witness
425 [LHsExpr id]
426
427 -- | Syntactic parallel array: [:e1, ..., en:]
428 --
429 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
430 -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnComma',
431 -- 'ApiAnnotation.AnnVbar'
432 -- 'ApiAnnotation.AnnClose' @':]'@
433
434 -- For details on above see note [Api annotations] in ApiAnnotation
435 | ExplicitPArr
436 (PostTc id Type) -- type of elements of the parallel array
437 [LHsExpr id]
438
439 -- | Record construction
440 --
441 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
442 -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
443
444 -- For details on above see note [Api annotations] in ApiAnnotation
445 | RecordCon
446 { rcon_con_name :: Located id -- The constructor name;
447 -- not used after type checking
448 , rcon_con_like :: PostTc id ConLike -- The data constructor or pattern synonym
449 , rcon_con_expr :: PostTcExpr -- Instantiated constructor function
450 , rcon_flds :: HsRecordBinds id } -- The fields
451
452 -- | Record update
453 --
454 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
455 -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
456
457 -- For details on above see note [Api annotations] in ApiAnnotation
458 | RecordUpd
459 { rupd_expr :: LHsExpr id
460 , rupd_flds :: [LHsRecUpdField id]
461 , rupd_cons :: PostTc id [ConLike]
462 -- Filled in by the type checker to the
463 -- _non-empty_ list of DataCons that have
464 -- all the upd'd fields
465
466 , rupd_in_tys :: PostTc id [Type] -- Argument types of *input* record type
467 , rupd_out_tys :: PostTc id [Type] -- and *output* record type
468 -- The original type can be reconstructed
469 -- with conLikeResTy
470 , rupd_wrap :: PostTc id HsWrapper -- See note [Record Update HsWrapper]
471 }
472 -- For a type family, the arg types are of the *instance* tycon,
473 -- not the family tycon
474
475 -- | Expression with an explicit type signature. @e :: type@
476 --
477 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
478
479 -- For details on above see note [Api annotations] in ApiAnnotation
480 | ExprWithTySig
481 (LHsExpr id)
482 (LHsSigWcType id)
483
484 | ExprWithTySigOut -- Post typechecking
485 (LHsExpr id)
486 (LHsSigWcType Name) -- Retain the signature,
487 -- as HsSigType Name, for
488 -- round-tripping purposes
489
490 -- | Arithmetic sequence
491 --
492 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
493 -- 'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
494 -- 'ApiAnnotation.AnnClose' @']'@
495
496 -- For details on above see note [Api annotations] in ApiAnnotation
497 | ArithSeq
498 PostTcExpr
499 (Maybe (SyntaxExpr id)) -- For OverloadedLists, the fromList witness
500 (ArithSeqInfo id)
501
502 -- | Arithmetic sequence for parallel array
503 --
504 -- > [:e1..e2:] or [:e1, e2..e3:]
505 --
506 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
507 -- 'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
508 -- 'ApiAnnotation.AnnVbar',
509 -- 'ApiAnnotation.AnnClose' @':]'@
510
511 -- For details on above see note [Api annotations] in ApiAnnotation
512 | PArrSeq
513 PostTcExpr
514 (ArithSeqInfo id)
515
516 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# SCC'@,
517 -- 'ApiAnnotation.AnnVal' or 'ApiAnnotation.AnnValStr',
518 -- 'ApiAnnotation.AnnClose' @'\#-}'@
519
520 -- For details on above see note [Api annotations] in ApiAnnotation
521 | HsSCC SourceText -- Note [Pragma source text] in BasicTypes
522 StringLiteral -- "set cost centre" SCC pragma
523 (LHsExpr id) -- expr whose cost is to be measured
524
525 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,
526 -- 'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
527
528 -- For details on above see note [Api annotations] in ApiAnnotation
529 | HsCoreAnn SourceText -- Note [Pragma source text] in BasicTypes
530 StringLiteral -- hdaume: core annotation
531 (LHsExpr id)
532
533 -----------------------------------------------------------
534 -- MetaHaskell Extensions
535
536 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
537 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
538 -- 'ApiAnnotation.AnnClose'
539
540 -- For details on above see note [Api annotations] in ApiAnnotation
541 | HsBracket (HsBracket id)
542
543 -- See Note [Pending Splices]
544 | HsRnBracketOut
545 (HsBracket Name) -- Output of the renamer is the *original* renamed
546 -- expression, plus
547 [PendingRnSplice] -- _renamed_ splices to be type checked
548
549 | HsTcBracketOut
550 (HsBracket Name) -- Output of the type checker is the *original*
551 -- renamed expression, plus
552 [PendingTcSplice] -- _typechecked_ splices to be
553 -- pasted back in by the desugarer
554
555 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
556 -- 'ApiAnnotation.AnnClose'
557
558 -- For details on above see note [Api annotations] in ApiAnnotation
559 | HsSpliceE (HsSplice id)
560
561 -----------------------------------------------------------
562 -- Arrow notation extension
563
564 -- | @proc@ notation for Arrows
565 --
566 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',
567 -- 'ApiAnnotation.AnnRarrow'
568
569 -- For details on above see note [Api annotations] in ApiAnnotation
570 | HsProc (LPat id) -- arrow abstraction, proc
571 (LHsCmdTop id) -- body of the abstraction
572 -- always has an empty stack
573
574 ---------------------------------------
575 -- static pointers extension
576 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
577
578 -- For details on above see note [Api annotations] in ApiAnnotation
579 | HsStatic (PostRn id NameSet) -- Free variables of the body
580 (LHsExpr id) -- Body
581
582 ---------------------------------------
583 -- The following are commands, not expressions proper
584 -- They are only used in the parsing stage and are removed
585 -- immediately in parser.RdrHsSyn.checkCommand
586
587 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
588 -- 'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
589 -- 'ApiAnnotation.AnnRarrowtail'
590
591 -- For details on above see note [Api annotations] in ApiAnnotation
592 | HsArrApp -- Arrow tail, or arrow application (f -< arg)
593 (LHsExpr id) -- arrow expression, f
594 (LHsExpr id) -- input expression, arg
595 (PostTc id Type) -- type of the arrow expressions f,
596 -- of the form a t t', where arg :: t
597 HsArrAppType -- higher-order (-<<) or first-order (-<)
598 Bool -- True => right-to-left (f -< arg)
599 -- False => left-to-right (arg >- f)
600
601 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(|'@,
602 -- 'ApiAnnotation.AnnClose' @'|)'@
603
604 -- For details on above see note [Api annotations] in ApiAnnotation
605 | HsArrForm -- Command formation, (| e cmd1 .. cmdn |)
606 (LHsExpr id) -- the operator
607 -- after type-checking, a type abstraction to be
608 -- applied to the type of the local environment tuple
609 (Maybe Fixity) -- fixity (filled in by the renamer), for forms that
610 -- were converted from OpApp's by the renamer
611 [LHsCmdTop id] -- argument commands
612
613 ---------------------------------------
614 -- Haskell program coverage (Hpc) Support
615
616 | HsTick
617 (Tickish id)
618 (LHsExpr id) -- sub-expression
619
620 | HsBinTick
621 Int -- module-local tick number for True
622 Int -- module-local tick number for False
623 (LHsExpr id) -- sub-expression
624
625 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
626 -- 'ApiAnnotation.AnnOpen' @'{-\# GENERATED'@,
627 -- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal',
628 -- 'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal',
629 -- 'ApiAnnotation.AnnMinus',
630 -- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnColon',
631 -- 'ApiAnnotation.AnnVal',
632 -- 'ApiAnnotation.AnnClose' @'\#-}'@
633
634 -- For details on above see note [Api annotations] in ApiAnnotation
635 | HsTickPragma -- A pragma introduced tick
636 SourceText -- Note [Pragma source text] in BasicTypes
637 (StringLiteral,(Int,Int),(Int,Int))
638 -- external span for this tick
639 ((SourceText,SourceText),(SourceText,SourceText))
640 -- Source text for the four integers used in the span.
641 -- See note [Pragma source text] in BasicTypes
642 (LHsExpr id)
643
644 ---------------------------------------
645 -- These constructors only appear temporarily in the parser.
646 -- The renamer translates them into the Right Thing.
647
648 | EWildPat -- wildcard
649
650 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
651
652 -- For details on above see note [Api annotations] in ApiAnnotation
653 | EAsPat (Located id) -- as pattern
654 (LHsExpr id)
655
656 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
657
658 -- For details on above see note [Api annotations] in ApiAnnotation
659 | EViewPat (LHsExpr id) -- view pattern
660 (LHsExpr id)
661
662 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
663
664 -- For details on above see note [Api annotations] in ApiAnnotation
665 | ELazyPat (LHsExpr id) -- ~ pattern
666
667
668 ---------------------------------------
669 -- Finally, HsWrap appears only in typechecker output
670
671 | HsWrap HsWrapper -- TRANSLATION
672 (HsExpr id)
673
674 deriving instance (DataId id) => Data (HsExpr id)
675
676 -- | HsTupArg is used for tuple sections
677 -- (,a,) is represented by ExplicitTuple [Missing ty1, Present a, Missing ty3]
678 -- Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
679 type LHsTupArg id = Located (HsTupArg id)
680 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
681
682 -- For details on above see note [Api annotations] in ApiAnnotation
683 data HsTupArg id
684 = Present (LHsExpr id) -- ^ The argument
685 | Missing (PostTc id Type) -- ^ The argument is missing, but this is its type
686 deriving instance (DataId id) => Data (HsTupArg id)
687
688 tupArgPresent :: LHsTupArg id -> Bool
689 tupArgPresent (L _ (Present {})) = True
690 tupArgPresent (L _ (Missing {})) = False
691
692 {-
693 Note [Parens in HsSyn]
694 ~~~~~~~~~~~~~~~~~~~~~~
695 HsPar (and ParPat in patterns, HsParTy in types) is used as follows
696
697 * Generally HsPar is optional; the pretty printer adds parens where
698 necessary. Eg (HsApp f (HsApp g x)) is fine, and prints 'f (g x)'
699
700 * HsPars are pretty printed as '( .. )' regardless of whether
701 or not they are strictly necssary
702
703 * HsPars are respected when rearranging operator fixities.
704 So a * (b + c) means what it says (where the parens are an HsPar)
705
706 Note [Sections in HsSyn]
707 ~~~~~~~~~~~~~~~~~~~~~~~~
708 Sections should always appear wrapped in an HsPar, thus
709 HsPar (SectionR ...)
710 The parser parses sections in a wider variety of situations
711 (See Note [Parsing sections]), but the renamer checks for those
712 parens. This invariant makes pretty-printing easier; we don't need
713 a special case for adding the parens round sections.
714
715 Note [Rebindable if]
716 ~~~~~~~~~~~~~~~~~~~~
717 The rebindable syntax for 'if' is a bit special, because when
718 rebindable syntax is *off* we do not want to treat
719 (if c then t else e)
720 as if it was an application (ifThenElse c t e). Why not?
721 Because we allow an 'if' to return *unboxed* results, thus
722 if blah then 3# else 4#
723 whereas that would not be possible using a all to a polymorphic function
724 (because you can't call a polymorphic function at an unboxed type).
725
726 So we use Nothing to mean "use the old built-in typing rule".
727
728 Note [Record Update HsWrapper]
729 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
730 There is a wrapper in RecordUpd which is used for the *required*
731 constraints for pattern synonyms. This wrapper is created in the
732 typechecking and is then directly used in the desugaring without
733 modification.
734
735 For example, if we have the record pattern synonym P,
736 pattern P :: (Show a) => a -> Maybe a
737 pattern P{x} = Just x
738
739 foo = (Just True) { x = False }
740 then `foo` desugars to something like
741 foo = case Just True of
742 P x -> P False
743 hence we need to provide the correct dictionaries to P's matcher on
744 the RHS so that we can build the expression.
745
746 Note [Located RdrNames]
747 ~~~~~~~~~~~~~~~~~~~~~~~
748 A number of syntax elements have seemingly redundant locations attached to them.
749 This is deliberate, to allow transformations making use of the API Annotations
750 to easily correlate a Located Name in the RenamedSource with a Located RdrName
751 in the ParsedSource.
752
753 There are unfortunately enough differences between the ParsedSource and the
754 RenamedSource that the API Annotations cannot be used directly with
755 RenamedSource, so this allows a simple mapping to be used based on the location.
756 -}
757
758 instance (OutputableBndrId id) => Outputable (HsExpr id) where
759 ppr expr = pprExpr expr
760
761 -----------------------
762 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
763 -- the underscore versions do not
764 pprLExpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
765 pprLExpr (L _ e) = pprExpr e
766
767 pprExpr :: (OutputableBndrId id) => HsExpr id -> SDoc
768 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e = ppr_expr e
769 | otherwise = pprDeeper (ppr_expr e)
770
771 isQuietHsExpr :: HsExpr id -> Bool
772 -- Parentheses do display something, but it gives little info and
773 -- if we go deeper when we go inside them then we get ugly things
774 -- like (...)
775 isQuietHsExpr (HsPar _) = True
776 -- applications don't display anything themselves
777 isQuietHsExpr (HsApp _ _) = True
778 isQuietHsExpr (HsAppType _ _) = True
779 isQuietHsExpr (HsAppTypeOut _ _) = True
780 isQuietHsExpr (OpApp _ _ _ _) = True
781 isQuietHsExpr _ = False
782
783 pprBinds :: (OutputableBndrId idL, OutputableBndrId idR)
784 => HsLocalBindsLR idL idR -> SDoc
785 pprBinds b = pprDeeper (ppr b)
786
787 -----------------------
788 ppr_lexpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
789 ppr_lexpr e = ppr_expr (unLoc e)
790
791 ppr_expr :: forall id. (OutputableBndrId id) => HsExpr id -> SDoc
792 ppr_expr (HsVar (L _ v)) = pprPrefixOcc v
793 ppr_expr (HsUnboundVar uv)= pprPrefixOcc (unboundVarOcc uv)
794 ppr_expr (HsIPVar v) = ppr v
795 ppr_expr (HsOverLabel l) = char '#' <> ppr l
796 ppr_expr (HsLit lit) = ppr lit
797 ppr_expr (HsOverLit lit) = ppr lit
798 ppr_expr (HsPar e) = parens (ppr_lexpr e)
799
800 ppr_expr (HsCoreAnn _ (StringLiteral _ s) e)
801 = vcat [text "HsCoreAnn" <+> ftext s, ppr_lexpr e]
802
803 ppr_expr e@(HsApp {}) = ppr_apps e []
804 ppr_expr e@(HsAppType {}) = ppr_apps e []
805 ppr_expr e@(HsAppTypeOut {}) = ppr_apps e []
806
807 ppr_expr (OpApp e1 op _ e2)
808 = case unLoc op of
809 HsVar (L _ v) -> pp_infixly v
810 HsRecFld f -> pp_infixly f
811 _ -> pp_prefixly
812 where
813 pp_e1 = pprDebugParendExpr e1 -- In debug mode, add parens
814 pp_e2 = pprDebugParendExpr e2 -- to make precedence clear
815
816 pp_prefixly
817 = hang (ppr op) 2 (sep [pp_e1, pp_e2])
818
819 pp_infixly v
820 = sep [pp_e1, sep [pprInfixOcc v, nest 2 pp_e2]]
821
822 ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
823
824 ppr_expr (SectionL expr op)
825 = case unLoc op of
826 HsVar (L _ v) -> pp_infixly v
827 _ -> pp_prefixly
828 where
829 pp_expr = pprDebugParendExpr expr
830
831 pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
832 4 (hsep [pp_expr, text "x_ )"])
833 pp_infixly v = (sep [pp_expr, pprInfixOcc v])
834
835 ppr_expr (SectionR op expr)
836 = case unLoc op of
837 HsVar (L _ v) -> pp_infixly v
838 _ -> pp_prefixly
839 where
840 pp_expr = pprDebugParendExpr expr
841
842 pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
843 4 (pp_expr <> rparen)
844 pp_infixly v = sep [pprInfixOcc v, pp_expr]
845
846 ppr_expr (ExplicitTuple exprs boxity)
847 = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
848 where
849 ppr_tup_args [] = []
850 ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
851 ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
852
853 punc (Present {} : _) = comma <> space
854 punc (Missing {} : _) = comma
855 punc [] = empty
856
857 ppr_expr (ExplicitSum alt arity expr _)
858 = text "(#" <+> ppr_bars (alt - 1) <+> ppr expr <+> ppr_bars (arity - alt) <+> text "#)"
859 where
860 ppr_bars n = hsep (replicate n (char '|'))
861
862 ppr_expr (HsLam matches)
863 = pprMatches matches
864
865 ppr_expr (HsLamCase matches)
866 = sep [ sep [text "\\case {"],
867 nest 2 (pprMatches matches <+> char '}') ]
868
869 ppr_expr (HsCase expr matches)
870 = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
871 nest 2 (pprMatches matches <+> char '}') ]
872
873 ppr_expr (HsIf _ e1 e2 e3)
874 = sep [hsep [text "if", nest 2 (ppr e1), ptext (sLit "then")],
875 nest 4 (ppr e2),
876 text "else",
877 nest 4 (ppr e3)]
878
879 ppr_expr (HsMultiIf _ alts)
880 = sep $ text "if" : map ppr_alt alts
881 where ppr_alt (L _ (GRHS guards expr)) =
882 sep [ vbar <+> interpp'SP guards
883 , text "->" <+> pprDeeper (ppr expr) ]
884
885 -- special case: let ... in let ...
886 ppr_expr (HsLet (L _ binds) expr@(L _ (HsLet _ _)))
887 = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
888 ppr_lexpr expr]
889
890 ppr_expr (HsLet (L _ binds) expr)
891 = sep [hang (text "let") 2 (pprBinds binds),
892 hang (text "in") 2 (ppr expr)]
893
894 ppr_expr (HsDo do_or_list_comp (L _ stmts) _) = pprDo do_or_list_comp stmts
895
896 ppr_expr (ExplicitList _ _ exprs)
897 = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
898
899 ppr_expr (ExplicitPArr _ exprs)
900 = paBrackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
901
902 ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })
903 = hang (ppr con_id) 2 (ppr rbinds)
904
905 ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
906 = hang (pprParendExpr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
907
908 ppr_expr (ExprWithTySig expr sig)
909 = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
910 4 (ppr sig)
911 ppr_expr (ExprWithTySigOut expr sig)
912 = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
913 4 (ppr sig)
914
915 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
916 ppr_expr (PArrSeq _ info) = paBrackets (ppr info)
917
918 ppr_expr EWildPat = char '_'
919 ppr_expr (ELazyPat e) = char '~' <> pprParendLExpr e
920 ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendLExpr e
921 ppr_expr (EViewPat p e) = ppr p <+> text "->" <+> ppr e
922
923 ppr_expr (HsSCC _ (StringLiteral _ lbl) expr)
924 = sep [ text "{-# SCC" <+> doubleQuotes (ftext lbl) <+> ptext (sLit "#-}"),
925 pprParendLExpr expr ]
926
927 ppr_expr (HsWrap co_fn e)
928 = pprHsWrapper co_fn (\parens -> if parens then pprParendExpr e
929 else pprExpr e)
930
931 ppr_expr (HsSpliceE s) = pprSplice s
932 ppr_expr (HsBracket b) = pprHsBracket b
933 ppr_expr (HsRnBracketOut e []) = ppr e
934 ppr_expr (HsRnBracketOut e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
935 ppr_expr (HsTcBracketOut e []) = ppr e
936 ppr_expr (HsTcBracketOut e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
937
938 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
939 = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]
940
941 ppr_expr (HsStatic _ e)
942 = hsep [text "static", pprParendLExpr e]
943
944 ppr_expr (HsTick tickish exp)
945 = pprTicks (ppr exp) $
946 ppr tickish <+> ppr_lexpr exp
947 ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
948 = pprTicks (ppr exp) $
949 hcat [text "bintick<",
950 ppr tickIdTrue,
951 text ",",
952 ppr tickIdFalse,
953 text ">(",
954 ppr exp, text ")"]
955 ppr_expr (HsTickPragma _ externalSrcLoc _ exp)
956 = pprTicks (ppr exp) $
957 hcat [text "tickpragma<",
958 pprExternalSrcLoc externalSrcLoc,
959 text ">(",
960 ppr exp,
961 text ")"]
962
963 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
964 = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
965 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
966 = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
967 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
968 = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
969 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
970 = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
971
972 ppr_expr (HsArrForm (L _ (HsVar (L _ v))) (Just _) [arg1, arg2])
973 = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
974 ppr_expr (HsArrForm op _ args)
975 = hang (text "(|" <+> ppr_lexpr op)
976 4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")
977 ppr_expr (HsRecFld f) = ppr f
978
979 -- We must tiresomely make the "id" parameter to the LHsWcType existential
980 -- because it's different in the HsAppType case and the HsAppTypeOut case
981 data LHsWcTypeX = forall id. (OutputableBndrId id) => LHsWcTypeX (LHsWcType id)
982
983 ppr_apps :: (OutputableBndrId id)
984 => HsExpr id
985 -> [Either (LHsExpr id) LHsWcTypeX]
986 -> SDoc
987 ppr_apps (HsApp (L _ fun) arg) args
988 = ppr_apps fun (Left arg : args)
989 ppr_apps (HsAppType (L _ fun) arg) args
990 = ppr_apps fun (Right (LHsWcTypeX arg) : args)
991 ppr_apps (HsAppTypeOut (L _ fun) arg) args
992 = ppr_apps fun (Right (LHsWcTypeX arg) : args)
993 ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))
994 where
995 pp (Left arg) = pprParendLExpr arg
996 pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
997 = char '@' <> pprParendHsType arg
998
999 pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
1000 pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))
1001 = ppr (src,(n1,n2),(n3,n4))
1002
1003 {-
1004 HsSyn records exactly where the user put parens, with HsPar.
1005 So generally speaking we print without adding any parens.
1006 However, some code is internally generated, and in some places
1007 parens are absolutely required; so for these places we use
1008 pprParendLExpr (but don't print double parens of course).
1009
1010 For operator applications we don't add parens, because the operator
1011 fixities should do the job, except in debug mode (-dppr-debug) so we
1012 can see the structure of the parse tree.
1013 -}
1014
1015 pprDebugParendExpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
1016 pprDebugParendExpr expr
1017 = getPprStyle (\sty ->
1018 if debugStyle sty then pprParendLExpr expr
1019 else pprLExpr expr)
1020
1021 pprParendLExpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
1022 pprParendLExpr (L _ e) = pprParendExpr e
1023
1024 pprParendExpr :: (OutputableBndrId id) => HsExpr id -> SDoc
1025 pprParendExpr expr
1026 | hsExprNeedsParens expr = parens (pprExpr expr)
1027 | otherwise = pprExpr expr
1028 -- Using pprLExpr makes sure that we go 'deeper'
1029 -- I think that is usually (always?) right
1030
1031 hsExprNeedsParens :: HsExpr id -> Bool
1032 -- True of expressions for which '(e)' and 'e'
1033 -- mean the same thing
1034 hsExprNeedsParens (ArithSeq {}) = False
1035 hsExprNeedsParens (PArrSeq {}) = False
1036 hsExprNeedsParens (HsLit {}) = False
1037 hsExprNeedsParens (HsOverLit {}) = False
1038 hsExprNeedsParens (HsVar {}) = False
1039 hsExprNeedsParens (HsUnboundVar {}) = False
1040 hsExprNeedsParens (HsIPVar {}) = False
1041 hsExprNeedsParens (HsOverLabel {}) = False
1042 hsExprNeedsParens (ExplicitTuple {}) = False
1043 hsExprNeedsParens (ExplicitList {}) = False
1044 hsExprNeedsParens (ExplicitPArr {}) = False
1045 hsExprNeedsParens (HsPar {}) = False
1046 hsExprNeedsParens (HsBracket {}) = False
1047 hsExprNeedsParens (HsRnBracketOut {}) = False
1048 hsExprNeedsParens (HsTcBracketOut {}) = False
1049 hsExprNeedsParens (HsDo sc _ _)
1050 | isListCompExpr sc = False
1051 hsExprNeedsParens (HsRecFld{}) = False
1052 hsExprNeedsParens _ = True
1053
1054
1055 isAtomicHsExpr :: HsExpr id -> Bool
1056 -- True of a single token
1057 isAtomicHsExpr (HsVar {}) = True
1058 isAtomicHsExpr (HsLit {}) = True
1059 isAtomicHsExpr (HsOverLit {}) = True
1060 isAtomicHsExpr (HsIPVar {}) = True
1061 isAtomicHsExpr (HsOverLabel {}) = True
1062 isAtomicHsExpr (HsUnboundVar {}) = True
1063 isAtomicHsExpr (HsWrap _ e) = isAtomicHsExpr e
1064 isAtomicHsExpr (HsPar e) = isAtomicHsExpr (unLoc e)
1065 isAtomicHsExpr (HsRecFld{}) = True
1066 isAtomicHsExpr _ = False
1067
1068 {-
1069 ************************************************************************
1070 * *
1071 \subsection{Commands (in arrow abstractions)}
1072 * *
1073 ************************************************************************
1074
1075 We re-use HsExpr to represent these.
1076 -}
1077
1078 type LHsCmd id = Located (HsCmd id)
1079
1080 data HsCmd id
1081 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
1082 -- 'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
1083 -- 'ApiAnnotation.AnnRarrowtail'
1084
1085 -- For details on above see note [Api annotations] in ApiAnnotation
1086 = HsCmdArrApp -- Arrow tail, or arrow application (f -< arg)
1087 (LHsExpr id) -- arrow expression, f
1088 (LHsExpr id) -- input expression, arg
1089 (PostTc id Type) -- type of the arrow expressions f,
1090 -- of the form a t t', where arg :: t
1091 HsArrAppType -- higher-order (-<<) or first-order (-<)
1092 Bool -- True => right-to-left (f -< arg)
1093 -- False => left-to-right (arg >- f)
1094
1095 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(|'@,
1096 -- 'ApiAnnotation.AnnClose' @'|)'@
1097
1098 -- For details on above see note [Api annotations] in ApiAnnotation
1099 | HsCmdArrForm -- Command formation, (| e cmd1 .. cmdn |)
1100 (LHsExpr id) -- the operator
1101 -- after type-checking, a type abstraction to be
1102 -- applied to the type of the local environment tuple
1103 (Maybe Fixity) -- fixity (filled in by the renamer), for forms that
1104 -- were converted from OpApp's by the renamer
1105 [LHsCmdTop id] -- argument commands
1106
1107 | HsCmdApp (LHsCmd id)
1108 (LHsExpr id)
1109
1110 | HsCmdLam (MatchGroup id (LHsCmd id)) -- kappa
1111 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
1112 -- 'ApiAnnotation.AnnRarrow',
1113
1114 -- For details on above see note [Api annotations] in ApiAnnotation
1115
1116 | HsCmdPar (LHsCmd id) -- parenthesised command
1117 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
1118 -- 'ApiAnnotation.AnnClose' @')'@
1119
1120 -- For details on above see note [Api annotations] in ApiAnnotation
1121
1122 | HsCmdCase (LHsExpr id)
1123 (MatchGroup id (LHsCmd id)) -- bodies are HsCmd's
1124 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
1125 -- 'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
1126 -- 'ApiAnnotation.AnnClose' @'}'@
1127
1128 -- For details on above see note [Api annotations] in ApiAnnotation
1129
1130 | HsCmdIf (Maybe (SyntaxExpr id)) -- cond function
1131 (LHsExpr id) -- predicate
1132 (LHsCmd id) -- then part
1133 (LHsCmd id) -- else part
1134 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
1135 -- 'ApiAnnotation.AnnSemi',
1136 -- 'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
1137 -- 'ApiAnnotation.AnnElse',
1138
1139 -- For details on above see note [Api annotations] in ApiAnnotation
1140
1141 | HsCmdLet (Located (HsLocalBinds id)) -- let(rec)
1142 (LHsCmd id)
1143 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
1144 -- 'ApiAnnotation.AnnOpen' @'{'@,
1145 -- 'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
1146
1147 -- For details on above see note [Api annotations] in ApiAnnotation
1148
1149 | HsCmdDo (Located [CmdLStmt id])
1150 (PostTc id Type) -- Type of the whole expression
1151 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
1152 -- 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
1153 -- 'ApiAnnotation.AnnVbar',
1154 -- 'ApiAnnotation.AnnClose'
1155
1156 -- For details on above see note [Api annotations] in ApiAnnotation
1157
1158 | HsCmdWrap HsWrapper
1159 (HsCmd id) -- If cmd :: arg1 --> res
1160 -- wrap :: arg1 "->" arg2
1161 -- Then (HsCmdWrap wrap cmd) :: arg2 --> res
1162 deriving instance (DataId id) => Data (HsCmd id)
1163
1164 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
1165 deriving Data
1166
1167
1168 {- | Top-level command, introducing a new arrow.
1169 This may occur inside a proc (where the stack is empty) or as an
1170 argument of a command-forming operator.
1171 -}
1172
1173 type LHsCmdTop id = Located (HsCmdTop id)
1174
1175 data HsCmdTop id
1176 = HsCmdTop (LHsCmd id)
1177 (PostTc id Type) -- Nested tuple of inputs on the command's stack
1178 (PostTc id Type) -- return type of the command
1179 (CmdSyntaxTable id) -- See Note [CmdSyntaxTable]
1180 deriving instance (DataId id) => Data (HsCmdTop id)
1181
1182 instance (OutputableBndrId id) => Outputable (HsCmd id) where
1183 ppr cmd = pprCmd cmd
1184
1185 -----------------------
1186 -- pprCmd and pprLCmd call pprDeeper;
1187 -- the underscore versions do not
1188 pprLCmd :: (OutputableBndrId id) => LHsCmd id -> SDoc
1189 pprLCmd (L _ c) = pprCmd c
1190
1191 pprCmd :: (OutputableBndrId id) => HsCmd id -> SDoc
1192 pprCmd c | isQuietHsCmd c = ppr_cmd c
1193 | otherwise = pprDeeper (ppr_cmd c)
1194
1195 isQuietHsCmd :: HsCmd id -> Bool
1196 -- Parentheses do display something, but it gives little info and
1197 -- if we go deeper when we go inside them then we get ugly things
1198 -- like (...)
1199 isQuietHsCmd (HsCmdPar _) = True
1200 -- applications don't display anything themselves
1201 isQuietHsCmd (HsCmdApp _ _) = True
1202 isQuietHsCmd _ = False
1203
1204 -----------------------
1205 ppr_lcmd :: (OutputableBndrId id) => LHsCmd id -> SDoc
1206 ppr_lcmd c = ppr_cmd (unLoc c)
1207
1208 ppr_cmd :: forall id. (OutputableBndrId id) => HsCmd id -> SDoc
1209 ppr_cmd (HsCmdPar c) = parens (ppr_lcmd c)
1210
1211 ppr_cmd (HsCmdApp c e)
1212 = let (fun, args) = collect_args c [e] in
1213 hang (ppr_lcmd fun) 2 (sep (map pprParendLExpr args))
1214 where
1215 collect_args (L _ (HsCmdApp fun arg)) args = collect_args fun (arg:args)
1216 collect_args fun args = (fun, args)
1217
1218 ppr_cmd (HsCmdLam matches)
1219 = pprMatches matches
1220
1221 ppr_cmd (HsCmdCase expr matches)
1222 = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
1223 nest 2 (pprMatches matches <+> char '}') ]
1224
1225 ppr_cmd (HsCmdIf _ e ct ce)
1226 = sep [hsep [text "if", nest 2 (ppr e), ptext (sLit "then")],
1227 nest 4 (ppr ct),
1228 text "else",
1229 nest 4 (ppr ce)]
1230
1231 -- special case: let ... in let ...
1232 ppr_cmd (HsCmdLet (L _ binds) cmd@(L _ (HsCmdLet _ _)))
1233 = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
1234 ppr_lcmd cmd]
1235
1236 ppr_cmd (HsCmdLet (L _ binds) cmd)
1237 = sep [hang (text "let") 2 (pprBinds binds),
1238 hang (text "in") 2 (ppr cmd)]
1239
1240 ppr_cmd (HsCmdDo (L _ stmts) _) = pprDo ArrowExpr stmts
1241
1242 ppr_cmd (HsCmdWrap w cmd)
1243 = pprHsWrapper w (\_ -> parens (ppr_cmd cmd))
1244 ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp True)
1245 = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
1246 ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp False)
1247 = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
1248 ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp True)
1249 = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
1250 ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp False)
1251 = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
1252
1253 ppr_cmd (HsCmdArrForm (L _ (HsVar (L _ v))) (Just _) [arg1, arg2])
1254 = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
1255 ppr_cmd (HsCmdArrForm op _ args)
1256 = hang (text "(|" <> ppr_lexpr op)
1257 4 (sep (map (pprCmdArg.unLoc) args) <> text "|)")
1258
1259 pprCmdArg :: (OutputableBndrId id) => HsCmdTop id -> SDoc
1260 pprCmdArg (HsCmdTop cmd@(L _ (HsCmdArrForm _ Nothing [])) _ _ _)
1261 = ppr_lcmd cmd
1262 pprCmdArg (HsCmdTop cmd _ _ _)
1263 = parens (ppr_lcmd cmd)
1264
1265 instance (OutputableBndrId id) => Outputable (HsCmdTop id) where
1266 ppr = pprCmdArg
1267
1268 {-
1269 ************************************************************************
1270 * *
1271 \subsection{Record binds}
1272 * *
1273 ************************************************************************
1274 -}
1275
1276 type HsRecordBinds id = HsRecFields id (LHsExpr id)
1277
1278 {-
1279 ************************************************************************
1280 * *
1281 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
1282 * *
1283 ************************************************************************
1284
1285 @Match@es are sets of pattern bindings and right hand sides for
1286 functions, patterns or case branches. For example, if a function @g@
1287 is defined as:
1288 \begin{verbatim}
1289 g (x,y) = y
1290 g ((x:ys),y) = y+1,
1291 \end{verbatim}
1292 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
1293
1294 It is always the case that each element of an @[Match]@ list has the
1295 same number of @pats@s inside it. This corresponds to saying that
1296 a function defined by pattern matching must have the same number of
1297 patterns in each equation.
1298 -}
1299
1300 data MatchGroup id body
1301 = MG { mg_alts :: Located [LMatch id body] -- The alternatives
1302 , mg_arg_tys :: [PostTc id Type] -- Types of the arguments, t1..tn
1303 , mg_res_ty :: PostTc id Type -- Type of the result, tr
1304 , mg_origin :: Origin }
1305 -- The type is the type of the entire group
1306 -- t1 -> ... -> tn -> tr
1307 -- where there are n patterns
1308 deriving instance (Data body,DataId id) => Data (MatchGroup id body)
1309
1310 type LMatch id body = Located (Match id body)
1311 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
1312 -- list
1313
1314 -- For details on above see note [Api annotations] in ApiAnnotation
1315 data Match id body
1316 = Match {
1317 m_ctxt :: HsMatchContext (NameOrRdrName id),
1318 -- See note [m_ctxt in Match]
1319 m_pats :: [LPat id], -- The patterns
1320 m_type :: (Maybe (LHsType id)),
1321 -- A type signature for the result of the match
1322 -- Nothing after typechecking
1323 -- NB: No longer supported
1324 m_grhss :: (GRHSs id body)
1325 }
1326 deriving instance (Data body,DataId id) => Data (Match id body)
1327
1328 {-
1329 Note [m_ctxt in Match]
1330 ~~~~~~~~~~~~~~~~~~~~~~
1331
1332 A Match can occur in a number of contexts, such as a FunBind, HsCase, HsLam and
1333 so on.
1334
1335 In order to simplify tooling processing and pretty print output, the provenance
1336 is captured in an HsMatchContext.
1337
1338 This is particularly important for the API Annotations for a multi-equation
1339 FunBind.
1340
1341 The parser initially creates a FunBind with a single Match in it for
1342 every function definition it sees.
1343
1344 These are then grouped together by getMonoBind into a single FunBind,
1345 where all the Matches are combined.
1346
1347 In the process, all the original FunBind fun_id's bar one are
1348 discarded, including the locations.
1349
1350 This causes a problem for source to source conversions via API
1351 Annotations, so the original fun_ids and infix flags are preserved in
1352 the Match, when it originates from a FunBind.
1353
1354 Example infix function definition requiring individual API Annotations
1355
1356 (&&& ) [] [] = []
1357 xs &&& [] = xs
1358 ( &&& ) [] ys = ys
1359
1360
1361
1362 -}
1363
1364
1365 isInfixMatch :: Match id body -> Bool
1366 isInfixMatch match = case m_ctxt match of
1367 FunRhs _ Infix -> True
1368 _ -> False
1369
1370 isEmptyMatchGroup :: MatchGroup id body -> Bool
1371 isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
1372
1373 -- | Is there only one RHS in this list of matches?
1374 isSingletonMatchGroup :: [LMatch id body] -> Bool
1375 isSingletonMatchGroup matches
1376 | [L _ match] <- matches
1377 , Match { m_grhss = GRHSs { grhssGRHSs = [_] } } <- match
1378 = True
1379 | otherwise
1380 = False
1381
1382 matchGroupArity :: MatchGroup id body -> Arity
1383 -- Precondition: MatchGroup is non-empty
1384 -- This is called before type checking, when mg_arg_tys is not set
1385 matchGroupArity (MG { mg_alts = alts })
1386 | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
1387 | otherwise = panic "matchGroupArity"
1388
1389 hsLMatchPats :: LMatch id body -> [LPat id]
1390 hsLMatchPats (L _ (Match _ pats _ _)) = pats
1391
1392 -- | GRHSs are used both for pattern bindings and for Matches
1393 --
1394 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
1395 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
1396 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1397 -- 'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
1398
1399 -- For details on above see note [Api annotations] in ApiAnnotation
1400 data GRHSs id body
1401 = GRHSs {
1402 grhssGRHSs :: [LGRHS id body], -- ^ Guarded RHSs
1403 grhssLocalBinds :: Located (HsLocalBinds id) -- ^ The where clause
1404 }
1405 deriving instance (Data body,DataId id) => Data (GRHSs id body)
1406
1407 type LGRHS id body = Located (GRHS id body)
1408
1409 -- | Guarded Right Hand Side.
1410 data GRHS id body = GRHS [GuardLStmt id] -- Guards
1411 body -- Right hand side
1412 deriving instance (Data body,DataId id) => Data (GRHS id body)
1413
1414 -- We know the list must have at least one @Match@ in it.
1415
1416 pprMatches :: (OutputableBndrId idR, Outputable body)
1417 => MatchGroup idR body -> SDoc
1418 pprMatches MG { mg_alts = matches }
1419 = vcat (map pprMatch (map unLoc (unLoc matches)))
1420 -- Don't print the type; it's only a place-holder before typechecking
1421
1422 -- Exported to HsBinds, which can't see the defn of HsMatchContext
1423 pprFunBind :: (OutputableBndrId idR, Outputable body)
1424 => MatchGroup idR body -> SDoc
1425 pprFunBind matches = pprMatches matches
1426
1427 -- Exported to HsBinds, which can't see the defn of HsMatchContext
1428 pprPatBind :: forall bndr id body. (OutputableBndrId bndr,
1429 OutputableBndrId id, Outputable body)
1430 => LPat bndr -> GRHSs id body -> SDoc
1431 pprPatBind pat (grhss)
1432 = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext id) grhss)]
1433
1434 pprMatch :: (OutputableBndrId idR, Outputable body) => Match idR body -> SDoc
1435 pprMatch match
1436 = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats)
1437 , nest 2 ppr_maybe_ty
1438 , nest 2 (pprGRHSs ctxt (m_grhss match)) ]
1439 where
1440 ctxt = m_ctxt match
1441 (herald, other_pats)
1442 = case ctxt of
1443 FunRhs (L _ fun) fixity
1444 | fixity == Prefix -> (pprPrefixOcc fun, m_pats match)
1445 -- f x y z = e
1446 -- Not pprBndr; the AbsBinds will
1447 -- have printed the signature
1448
1449 | null pats2 -> (pp_infix, [])
1450 -- x &&& y = e
1451
1452 | otherwise -> (parens pp_infix, pats2)
1453 -- (x &&& y) z = e
1454 where
1455 pp_infix = pprParendLPat pat1 <+> pprInfixOcc fun <+> pprParendLPat pat2
1456
1457 LambdaExpr -> (char '\\', m_pats match)
1458
1459 _ -> ASSERT( null pats1 )
1460 (ppr pat1, []) -- No parens around the single pat
1461
1462 (pat1:pats1) = m_pats match
1463 (pat2:pats2) = pats1
1464 ppr_maybe_ty = case m_type match of
1465 Just ty -> dcolon <+> ppr ty
1466 Nothing -> empty
1467
1468
1469 pprGRHSs :: (OutputableBndrId idR, Outputable body)
1470 => HsMatchContext idL -> GRHSs idR body -> SDoc
1471 pprGRHSs ctxt (GRHSs grhss (L _ binds))
1472 = vcat (map (pprGRHS ctxt . unLoc) grhss)
1473 $$ ppUnless (isEmptyLocalBinds binds)
1474 (text "where" $$ nest 4 (pprBinds binds))
1475
1476 pprGRHS :: (OutputableBndrId idR, Outputable body)
1477 => HsMatchContext idL -> GRHS idR body -> SDoc
1478 pprGRHS ctxt (GRHS [] body)
1479 = pp_rhs ctxt body
1480
1481 pprGRHS ctxt (GRHS guards body)
1482 = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body]
1483
1484 pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc
1485 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
1486
1487 {-
1488 ************************************************************************
1489 * *
1490 \subsection{Do stmts and list comprehensions}
1491 * *
1492 ************************************************************************
1493 -}
1494
1495 type LStmt id body = Located (StmtLR id id body)
1496 type LStmtLR idL idR body = Located (StmtLR idL idR body)
1497
1498 type Stmt id body = StmtLR id id body
1499
1500 type CmdLStmt id = LStmt id (LHsCmd id)
1501 type CmdStmt id = Stmt id (LHsCmd id)
1502 type ExprLStmt id = LStmt id (LHsExpr id)
1503 type ExprStmt id = Stmt id (LHsExpr id)
1504
1505 type GuardLStmt id = LStmt id (LHsExpr id)
1506 type GuardStmt id = Stmt id (LHsExpr id)
1507 type GhciLStmt id = LStmt id (LHsExpr id)
1508 type GhciStmt id = Stmt id (LHsExpr id)
1509
1510 -- The SyntaxExprs in here are used *only* for do-notation and monad
1511 -- comprehensions, which have rebindable syntax. Otherwise they are unused.
1512 -- | API Annotations when in qualifier lists or guards
1513 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
1514 -- 'ApiAnnotation.AnnComma','ApiAnnotation.AnnThen',
1515 -- 'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',
1516 -- 'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'
1517
1518 -- For details on above see note [Api annotations] in ApiAnnotation
1519 data StmtLR idL idR body -- body should always be (LHs**** idR)
1520 = LastStmt -- Always the last Stmt in ListComp, MonadComp, PArrComp,
1521 -- and (after the renamer) DoExpr, MDoExpr
1522 -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff
1523 body
1524 Bool -- True <=> return was stripped by ApplicativeDo
1525 (SyntaxExpr idR) -- The return operator, used only for
1526 -- MonadComp For ListComp, PArrComp, we
1527 -- use the baked-in 'return' For DoExpr,
1528 -- MDoExpr, we don't apply a 'return' at
1529 -- all See Note [Monad Comprehensions] |
1530 -- - 'ApiAnnotation.AnnKeywordId' :
1531 -- 'ApiAnnotation.AnnLarrow'
1532
1533 -- For details on above see note [Api annotations] in ApiAnnotation
1534 | BindStmt (LPat idL)
1535 body
1536 (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts]
1537 (SyntaxExpr idR) -- The fail operator
1538 -- The fail operator is noSyntaxExpr
1539 -- if the pattern match can't fail
1540
1541 (PostTc idR Type) -- result type of the function passed to bind;
1542 -- that is, S in (>>=) :: Q -> (R -> S) -> T
1543
1544 -- | 'ApplicativeStmt' represents an applicative expression built with
1545 -- <$> and <*>. It is generated by the renamer, and is desugared into the
1546 -- appropriate applicative expression by the desugarer, but it is intended
1547 -- to be invisible in error messages.
1548 --
1549 -- For full details, see Note [ApplicativeDo] in RnExpr
1550 --
1551 | ApplicativeStmt
1552 [ ( SyntaxExpr idR
1553 , ApplicativeArg idL idR) ]
1554 -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]
1555 (Maybe (SyntaxExpr idR)) -- 'join', if necessary
1556 (PostTc idR Type) -- Type of the body
1557
1558 | BodyStmt body -- See Note [BodyStmt]
1559 (SyntaxExpr idR) -- The (>>) operator
1560 (SyntaxExpr idR) -- The `guard` operator; used only in MonadComp
1561 -- See notes [Monad Comprehensions]
1562 (PostTc idR Type) -- Element type of the RHS (used for arrows)
1563
1564 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'
1565 -- 'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,
1566
1567 -- For details on above see note [Api annotations] in ApiAnnotation
1568 | LetStmt (Located (HsLocalBindsLR idL idR))
1569
1570 -- ParStmts only occur in a list/monad comprehension
1571 | ParStmt [ParStmtBlock idL idR]
1572 (HsExpr idR) -- Polymorphic `mzip` for monad comprehensions
1573 (SyntaxExpr idR) -- The `>>=` operator
1574 -- See notes [Monad Comprehensions]
1575 (PostTc idR Type) -- S in (>>=) :: Q -> (R -> S) -> T
1576 -- After renaming, the ids are the binders
1577 -- bound by the stmts and used after themp
1578
1579 | TransStmt {
1580 trS_form :: TransForm,
1581 trS_stmts :: [ExprLStmt idL], -- Stmts to the *left* of the 'group'
1582 -- which generates the tuples to be grouped
1583
1584 trS_bndrs :: [(idR, idR)], -- See Note [TransStmt binder map]
1585
1586 trS_using :: LHsExpr idR,
1587 trS_by :: Maybe (LHsExpr idR), -- "by e" (optional)
1588 -- Invariant: if trS_form = GroupBy, then grp_by = Just e
1589
1590 trS_ret :: SyntaxExpr idR, -- The monomorphic 'return' function for
1591 -- the inner monad comprehensions
1592 trS_bind :: SyntaxExpr idR, -- The '(>>=)' operator
1593 trS_bind_arg_ty :: PostTc idR Type, -- R in (>>=) :: Q -> (R -> S) -> T
1594 trS_fmap :: HsExpr idR -- The polymorphic 'fmap' function for desugaring
1595 -- Only for 'group' forms
1596 -- Just a simple HsExpr, because it's
1597 -- too polymorphic for tcSyntaxOp
1598 } -- See Note [Monad Comprehensions]
1599
1600 -- Recursive statement (see Note [How RecStmt works] below)
1601 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'
1602
1603 -- For details on above see note [Api annotations] in ApiAnnotation
1604 | RecStmt
1605 { recS_stmts :: [LStmtLR idL idR body]
1606
1607 -- The next two fields are only valid after renaming
1608 , recS_later_ids :: [idR] -- The ids are a subset of the variables bound by the
1609 -- stmts that are used in stmts that follow the RecStmt
1610
1611 , recS_rec_ids :: [idR] -- Ditto, but these variables are the "recursive" ones,
1612 -- that are used before they are bound in the stmts of
1613 -- the RecStmt.
1614 -- An Id can be in both groups
1615 -- Both sets of Ids are (now) treated monomorphically
1616 -- See Note [How RecStmt works] for why they are separate
1617
1618 -- Rebindable syntax
1619 , recS_bind_fn :: SyntaxExpr idR -- The bind function
1620 , recS_ret_fn :: SyntaxExpr idR -- The return function
1621 , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
1622 , recS_bind_ty :: PostTc idR Type -- S in (>>=) :: Q -> (R -> S) -> T
1623
1624 -- These fields are only valid after typechecking
1625 , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)
1626 , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1
1627 -- with recS_later_ids and recS_rec_ids,
1628 -- and are the expressions that should be
1629 -- returned by the recursion.
1630 -- They may not quite be the Ids themselves,
1631 -- because the Id may be *polymorphic*, but
1632 -- the returned thing has to be *monomorphic*,
1633 -- so they may be type applications
1634
1635 , recS_ret_ty :: PostTc idR Type -- The type of
1636 -- do { stmts; return (a,b,c) }
1637 -- With rebindable syntax the type might not
1638 -- be quite as simple as (m (tya, tyb, tyc)).
1639 }
1640 deriving instance (Data body, DataId idL, DataId idR)
1641 => Data (StmtLR idL idR body)
1642
1643 data TransForm -- The 'f' below is the 'using' function, 'e' is the by function
1644 = ThenForm -- then f or then f by e (depending on trS_by)
1645 | GroupForm -- then group using f or then group by e using f (depending on trS_by)
1646 deriving Data
1647
1648 data ParStmtBlock idL idR
1649 = ParStmtBlock
1650 [ExprLStmt idL]
1651 [idR] -- The variables to be returned
1652 (SyntaxExpr idR) -- The return operator
1653 deriving instance (DataId idL, DataId idR) => Data (ParStmtBlock idL idR)
1654
1655 data ApplicativeArg idL idR
1656 = ApplicativeArgOne -- pat <- expr (pat must be irrefutable)
1657 (LPat idL)
1658 (LHsExpr idL)
1659 | ApplicativeArgMany -- do { stmts; return vars }
1660 [ExprLStmt idL] -- stmts
1661 (HsExpr idL) -- return (v1,..,vn), or just (v1,..,vn)
1662 (LPat idL) -- (v1,...,vn)
1663 deriving instance (DataId idL, DataId idR) => Data (ApplicativeArg idL idR)
1664
1665 {-
1666 Note [The type of bind in Stmts]
1667 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1668 Some Stmts, notably BindStmt, keep the (>>=) bind operator.
1669 We do NOT assume that it has type
1670 (>>=) :: m a -> (a -> m b) -> m b
1671 In some cases (see Trac #303, #1537) it might have a more
1672 exotic type, such as
1673 (>>=) :: m i j a -> (a -> m j k b) -> m i k b
1674 So we must be careful not to make assumptions about the type.
1675 In particular, the monad may not be uniform throughout.
1676
1677 Note [TransStmt binder map]
1678 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1679 The [(idR,idR)] in a TransStmt behaves as follows:
1680
1681 * Before renaming: []
1682
1683 * After renaming:
1684 [ (x27,x27), ..., (z35,z35) ]
1685 These are the variables
1686 bound by the stmts to the left of the 'group'
1687 and used either in the 'by' clause,
1688 or in the stmts following the 'group'
1689 Each item is a pair of identical variables.
1690
1691 * After typechecking:
1692 [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]
1693 Each pair has the same unique, but different *types*.
1694
1695 Note [BodyStmt]
1696 ~~~~~~~~~~~~~~~
1697 BodyStmts are a bit tricky, because what they mean
1698 depends on the context. Consider the following contexts:
1699
1700 A do expression of type (m res_ty)
1701 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1702 * BodyStmt E any_ty: do { ....; E; ... }
1703 E :: m any_ty
1704 Translation: E >> ...
1705
1706 A list comprehensions of type [elt_ty]
1707 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1708 * BodyStmt E Bool: [ .. | .... E ]
1709 [ .. | ..., E, ... ]
1710 [ .. | .... | ..., E | ... ]
1711 E :: Bool
1712 Translation: if E then fail else ...
1713
1714 A guard list, guarding a RHS of type rhs_ty
1715 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1716 * BodyStmt E BooParStmtBlockl: f x | ..., E, ... = ...rhs...
1717 E :: Bool
1718 Translation: if E then fail else ...
1719
1720 A monad comprehension of type (m res_ty)
1721 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1722 * BodyStmt E Bool: [ .. | .... E ]
1723 E :: Bool
1724 Translation: guard E >> ...
1725
1726 Array comprehensions are handled like list comprehensions.
1727
1728 Note [How RecStmt works]
1729 ~~~~~~~~~~~~~~~~~~~~~~~~
1730 Example:
1731 HsDo [ BindStmt x ex
1732
1733 , RecStmt { recS_rec_ids = [a, c]
1734 , recS_stmts = [ BindStmt b (return (a,c))
1735 , LetStmt a = ...b...
1736 , BindStmt c ec ]
1737 , recS_later_ids = [a, b]
1738
1739 , return (a b) ]
1740
1741 Here, the RecStmt binds a,b,c; but
1742 - Only a,b are used in the stmts *following* the RecStmt,
1743 - Only a,c are used in the stmts *inside* the RecStmt
1744 *before* their bindings
1745
1746 Why do we need *both* rec_ids and later_ids? For monads they could be
1747 combined into a single set of variables, but not for arrows. That
1748 follows from the types of the respective feedback operators:
1749
1750 mfix :: MonadFix m => (a -> m a) -> m a
1751 loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
1752
1753 * For mfix, the 'a' covers the union of the later_ids and the rec_ids
1754 * For 'loop', 'c' is the later_ids and 'd' is the rec_ids
1755
1756 Note [Typing a RecStmt]
1757 ~~~~~~~~~~~~~~~~~~~~~~~
1758 A (RecStmt stmts) types as if you had written
1759
1760 (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->
1761 do { stmts
1762 ; return (v1,..vn, r1, ..., rm) })
1763
1764 where v1..vn are the later_ids
1765 r1..rm are the rec_ids
1766
1767 Note [Monad Comprehensions]
1768 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1769 Monad comprehensions require separate functions like 'return' and
1770 '>>=' for desugaring. These functions are stored in the statements
1771 used in monad comprehensions. For example, the 'return' of the 'LastStmt'
1772 expression is used to lift the body of the monad comprehension:
1773
1774 [ body | stmts ]
1775 =>
1776 stmts >>= \bndrs -> return body
1777
1778 In transform and grouping statements ('then ..' and 'then group ..') the
1779 'return' function is required for nested monad comprehensions, for example:
1780
1781 [ body | stmts, then f, rest ]
1782 =>
1783 f [ env | stmts ] >>= \bndrs -> [ body | rest ]
1784
1785 BodyStmts require the 'Control.Monad.guard' function for boolean
1786 expressions:
1787
1788 [ body | exp, stmts ]
1789 =>
1790 guard exp >> [ body | stmts ]
1791
1792 Parallel statements require the 'Control.Monad.Zip.mzip' function:
1793
1794 [ body | stmts1 | stmts2 | .. ]
1795 =>
1796 mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body
1797
1798 In any other context than 'MonadComp', the fields for most of these
1799 'SyntaxExpr's stay bottom.
1800 -}
1801
1802 instance (OutputableBndrId idL) => Outputable (ParStmtBlock idL idR) where
1803 ppr (ParStmtBlock stmts _ _) = interpp'SP stmts
1804
1805 instance (OutputableBndrId idL, OutputableBndrId idR, Outputable body)
1806 => Outputable (StmtLR idL idR body) where
1807 ppr stmt = pprStmt stmt
1808
1809 pprStmt :: forall idL idR body . (OutputableBndrId idL, OutputableBndrId idR,
1810 Outputable body)
1811 => (StmtLR idL idR body) -> SDoc
1812 pprStmt (LastStmt expr ret_stripped _)
1813 = ifPprDebug (text "[last]") <+>
1814 (if ret_stripped then text "return" else empty) <+>
1815 ppr expr
1816 pprStmt (BindStmt pat expr _ _ _) = hsep [ppr pat, larrow, ppr expr]
1817 pprStmt (LetStmt (L _ binds)) = hsep [text "let", pprBinds binds]
1818 pprStmt (BodyStmt expr _ _ _) = ppr expr
1819 pprStmt (ParStmt stmtss _ _ _) = sep (punctuate (text " | ") (map ppr stmtss))
1820
1821 pprStmt (TransStmt { trS_stmts = stmts, trS_by = by, trS_using = using, trS_form = form })
1822 = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])
1823
1824 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
1825 , recS_later_ids = later_ids })
1826 = text "rec" <+>
1827 vcat [ ppr_do_stmts segment
1828 , ifPprDebug (vcat [ text "rec_ids=" <> ppr rec_ids
1829 , text "later_ids=" <> ppr later_ids])]
1830
1831 pprStmt (ApplicativeStmt args mb_join _)
1832 = getPprStyle $ \style ->
1833 if userStyle style
1834 then pp_for_user
1835 else pp_debug
1836 where
1837 -- make all the Applicative stuff invisible in error messages by
1838 -- flattening the whole ApplicativeStmt nest back to a sequence
1839 -- of statements.
1840 pp_for_user = vcat $ punctuate semi $ concatMap flattenArg args
1841
1842 -- ppr directly rather than transforming here, because we need to
1843 -- inject a "return" which is hard when we're polymorphic in the id
1844 -- type.
1845 flattenStmt :: ExprLStmt idL -> [SDoc]
1846 flattenStmt (L _ (ApplicativeStmt args _ _)) = concatMap flattenArg args
1847 flattenStmt stmt = [ppr stmt]
1848
1849 flattenArg (_, ApplicativeArgOne pat expr) =
1850 [ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
1851 :: ExprStmt idL)]
1852 flattenArg (_, ApplicativeArgMany stmts _ _) =
1853 concatMap flattenStmt stmts
1854
1855 pp_debug =
1856 let
1857 ap_expr = sep (punctuate (text " |") (map pp_arg args))
1858 in
1859 if isNothing mb_join
1860 then ap_expr
1861 else text "join" <+> parens ap_expr
1862
1863 pp_arg (_, ApplicativeArgOne pat expr) =
1864 ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
1865 :: ExprStmt idL)
1866 pp_arg (_, ApplicativeArgMany stmts return pat) =
1867 ppr pat <+>
1868 text "<-" <+>
1869 ppr (HsDo DoExpr (noLoc
1870 (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)]))
1871 (error "pprStmt"))
1872
1873 pprTransformStmt :: (OutputableBndrId id)
1874 => [id] -> LHsExpr id -> Maybe (LHsExpr id) -> SDoc
1875 pprTransformStmt bndrs using by
1876 = sep [ text "then" <+> ifPprDebug (braces (ppr bndrs))
1877 , nest 2 (ppr using)
1878 , nest 2 (pprBy by)]
1879
1880 pprTransStmt :: Outputable body => Maybe body -> body -> TransForm -> SDoc
1881 pprTransStmt by using ThenForm
1882 = sep [ text "then", nest 2 (ppr using), nest 2 (pprBy by)]
1883 pprTransStmt by using GroupForm
1884 = sep [ text "then group", nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]
1885
1886 pprBy :: Outputable body => Maybe body -> SDoc
1887 pprBy Nothing = empty
1888 pprBy (Just e) = text "by" <+> ppr e
1889
1890 pprDo :: (OutputableBndrId id, Outputable body)
1891 => HsStmtContext any -> [LStmt id body] -> SDoc
1892 pprDo DoExpr stmts = text "do" <+> ppr_do_stmts stmts
1893 pprDo GhciStmtCtxt stmts = text "do" <+> ppr_do_stmts stmts
1894 pprDo ArrowExpr stmts = text "do" <+> ppr_do_stmts stmts
1895 pprDo MDoExpr stmts = text "mdo" <+> ppr_do_stmts stmts
1896 pprDo ListComp stmts = brackets $ pprComp stmts
1897 pprDo PArrComp stmts = paBrackets $ pprComp stmts
1898 pprDo MonadComp stmts = brackets $ pprComp stmts
1899 pprDo _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
1900
1901 ppr_do_stmts :: (OutputableBndrId idL, OutputableBndrId idR, Outputable body)
1902 => [LStmtLR idL idR body] -> SDoc
1903 -- Print a bunch of do stmts, with explicit braces and semicolons,
1904 -- so that we are not vulnerable to layout bugs
1905 ppr_do_stmts stmts
1906 = lbrace <+> pprDeeperList vcat (punctuate semi (map ppr stmts))
1907 <+> rbrace
1908
1909 pprComp :: (OutputableBndrId id, Outputable body)
1910 => [LStmt id body] -> SDoc
1911 pprComp quals -- Prints: body | qual1, ..., qualn
1912 | not (null quals)
1913 , L _ (LastStmt body _ _) <- last quals
1914 = hang (ppr body <+> vbar) 2 (pprQuals (dropTail 1 quals))
1915 | otherwise
1916 = pprPanic "pprComp" (pprQuals quals)
1917
1918 pprQuals :: (OutputableBndrId id, Outputable body)
1919 => [LStmt id body] -> SDoc
1920 -- Show list comprehension qualifiers separated by commas
1921 pprQuals quals = interpp'SP quals
1922
1923 {-
1924 ************************************************************************
1925 * *
1926 Template Haskell quotation brackets
1927 * *
1928 ************************************************************************
1929 -}
1930
1931 data HsSplice id
1932 = HsTypedSplice -- $$z or $$(f 4)
1933 id -- A unique name to identify this splice point
1934 (LHsExpr id) -- See Note [Pending Splices]
1935
1936 | HsUntypedSplice -- $z or $(f 4)
1937 id -- A unique name to identify this splice point
1938 (LHsExpr id) -- See Note [Pending Splices]
1939
1940 | HsQuasiQuote -- See Note [Quasi-quote overview] in TcSplice
1941 id -- Splice point
1942 id -- Quoter
1943 SrcSpan -- The span of the enclosed string
1944 FastString -- The enclosed string
1945
1946 | HsSpliced -- See Note [Delaying modFinalizers in untyped splices] in
1947 -- RnSplice.
1948 -- This is the result of splicing a splice. It is produced by
1949 -- the renamer and consumed by the typechecker. It lives only
1950 -- between the two.
1951 ThModFinalizers -- TH finalizers produced by the splice.
1952 (HsSplicedThing id) -- The result of splicing
1953 deriving Typeable
1954
1955 deriving instance (DataId id) => Data (HsSplice id)
1956
1957 isTypedSplice :: HsSplice id -> Bool
1958 isTypedSplice (HsTypedSplice {}) = True
1959 isTypedSplice _ = False -- Quasi-quotes are untyped splices
1960
1961 -- | Finalizers produced by a splice with
1962 -- 'Language.Haskell.TH.Syntax.addModFinalizer'
1963 --
1964 -- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how
1965 -- this is used.
1966 --
1967 #ifdef GHCI
1968 newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())]
1969 #else
1970 data ThModFinalizers = ThModFinalizers
1971 #endif
1972
1973 -- A Data instance which ignores the argument of 'ThModFinalizers'.
1974 #ifdef GHCI
1975 instance Data ThModFinalizers where
1976 gunfold _ z _ = z $ ThModFinalizers []
1977 toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix
1978 dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a]
1979 #else
1980 instance Data ThModFinalizers where
1981 gunfold _ z _ = z ThModFinalizers
1982 toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix
1983 dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a]
1984 #endif
1985
1986 -- | Values that can result from running a splice.
1987 data HsSplicedThing id
1988 = HsSplicedExpr (HsExpr id)
1989 | HsSplicedTy (HsType id)
1990 | HsSplicedPat (Pat id)
1991 deriving Typeable
1992
1993 deriving instance (DataId id) => Data (HsSplicedThing id)
1994
1995 -- See Note [Pending Splices]
1996 type SplicePointName = Name
1997
1998 data PendingRnSplice
1999 = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr Name)
2000 deriving Data
2001
2002 data UntypedSpliceFlavour
2003 = UntypedExpSplice
2004 | UntypedPatSplice
2005 | UntypedTypeSplice
2006 | UntypedDeclSplice
2007 deriving Data
2008
2009 data PendingTcSplice
2010 = PendingTcSplice SplicePointName (LHsExpr Id)
2011 deriving Data
2012
2013
2014 {-
2015 Note [Pending Splices]
2016 ~~~~~~~~~~~~~~~~~~~~~~
2017 When we rename an untyped bracket, we name and lift out all the nested
2018 splices, so that when the typechecker hits the bracket, it can
2019 typecheck those nested splices without having to walk over the untyped
2020 bracket code. So for example
2021 [| f $(g x) |]
2022 looks like
2023
2024 HsBracket (HsApp (HsVar "f") (HsSpliceE _ (g x)))
2025
2026 which the renamer rewrites to
2027
2028 HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))
2029 [PendingRnSplice UntypedExpSplice sn (g x)]
2030
2031 * The 'sn' is the Name of the splice point, the SplicePointName
2032
2033 * The PendingRnExpSplice gives the splice that splice-point name maps to;
2034 and the typechecker can now conveniently find these sub-expressions
2035
2036 * The other copy of the splice, in the second argument of HsSpliceE
2037 in the renamed first arg of HsRnBracketOut
2038 is used only for pretty printing
2039
2040 There are four varieties of pending splices generated by the renamer,
2041 distinguished by their UntypedSpliceFlavour
2042
2043 * Pending expression splices (UntypedExpSplice), e.g.,
2044 [|$(f x) + 2|]
2045
2046 UntypedExpSplice is also used for
2047 * quasi-quotes, where the pending expression expands to
2048 $(quoter "...blah...")
2049 (see RnSplice.makePending, HsQuasiQuote case)
2050
2051 * cross-stage lifting, where the pending expression expands to
2052 $(lift x)
2053 (see RnSplice.checkCrossStageLifting)
2054
2055 * Pending pattern splices (UntypedPatSplice), e.g.,
2056 [| \$(f x) -> x |]
2057
2058 * Pending type splices (UntypedTypeSplice), e.g.,
2059 [| f :: $(g x) |]
2060
2061 * Pending declaration (UntypedDeclSplice), e.g.,
2062 [| let $(f x) in ... |]
2063
2064 There is a fifth variety of pending splice, which is generated by the type
2065 checker:
2066
2067 * Pending *typed* expression splices, (PendingTcSplice), e.g.,
2068 [||1 + $$(f 2)||]
2069
2070 It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
2071 output of the renamer. However, when pretty printing the output of the renamer,
2072 e.g., in a type error message, we *do not* want to print out the pending
2073 splices. In contrast, when pretty printing the output of the type checker, we
2074 *do* want to print the pending splices. So splitting them up seems to make
2075 sense, although I hate to add another constructor to HsExpr.
2076 -}
2077
2078 instance OutputableBndrId id => Outputable (HsSplicedThing id) where
2079 ppr (HsSplicedExpr e) = ppr_expr e
2080 ppr (HsSplicedTy t) = ppr t
2081 ppr (HsSplicedPat p) = ppr p
2082
2083 instance (OutputableBndrId id) => Outputable (HsSplice id) where
2084 ppr s = pprSplice s
2085
2086 pprPendingSplice :: (OutputableBndrId id)
2087 => SplicePointName -> LHsExpr id -> SDoc
2088 pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
2089
2090 pprSplice :: (OutputableBndrId id) => HsSplice id -> SDoc
2091 pprSplice (HsTypedSplice n e) = ppr_splice (text "$$") n e
2092 pprSplice (HsUntypedSplice n e) = ppr_splice (text "$") n e
2093 pprSplice (HsQuasiQuote n q _ s) = ppr_quasi n q s
2094 pprSplice (HsSpliced _ thing) = ppr thing
2095
2096 ppr_quasi :: OutputableBndr id => id -> id -> FastString -> SDoc
2097 ppr_quasi n quoter quote = ifPprDebug (brackets (ppr n)) <>
2098 char '[' <> ppr quoter <> vbar <>
2099 ppr quote <> text "|]"
2100
2101 ppr_splice :: (OutputableBndrId id) => SDoc -> id -> LHsExpr id -> SDoc
2102 ppr_splice herald n e
2103 = herald <> ifPprDebug (brackets (ppr n)) <> eDoc
2104 where
2105 -- We use pprLExpr to match pprParendLExpr:
2106 -- Using pprLExpr makes sure that we go 'deeper'
2107 -- I think that is usually (always?) right
2108 pp_as_was = pprLExpr e
2109 eDoc = case unLoc e of
2110 HsPar _ -> pp_as_was
2111 HsVar _ -> pp_as_was
2112 _ -> parens pp_as_was
2113
2114 data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
2115 | PatBr (LPat id) -- [p| pat |]
2116 | DecBrL [LHsDecl id] -- [d| decls |]; result of parser
2117 | DecBrG (HsGroup id) -- [d| decls |]; result of renamer
2118 | TypBr (LHsType id) -- [t| type |]
2119 | VarBr Bool id -- True: 'x, False: ''T
2120 -- (The Bool flag is used only in pprHsBracket)
2121 | TExpBr (LHsExpr id) -- [|| expr ||]
2122 deriving instance (DataId id) => Data (HsBracket id)
2123
2124 isTypedBracket :: HsBracket id -> Bool
2125 isTypedBracket (TExpBr {}) = True
2126 isTypedBracket _ = False
2127
2128 instance (OutputableBndrId id) => Outputable (HsBracket id) where
2129 ppr = pprHsBracket
2130
2131
2132 pprHsBracket :: (OutputableBndrId id) => HsBracket id -> SDoc
2133 pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
2134 pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
2135 pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
2136 pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
2137 pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
2138 pprHsBracket (VarBr True n) = char '\'' <> ppr n
2139 pprHsBracket (VarBr False n) = text "''" <> ppr n
2140 pprHsBracket (TExpBr e) = thTyBrackets (ppr e)
2141
2142 thBrackets :: SDoc -> SDoc -> SDoc
2143 thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>
2144 pp_body <+> text "|]"
2145
2146 thTyBrackets :: SDoc -> SDoc
2147 thTyBrackets pp_body = text "[||" <+> pp_body <+> ptext (sLit "||]")
2148
2149 instance Outputable PendingRnSplice where
2150 ppr (PendingRnSplice _ n e) = pprPendingSplice n e
2151
2152 instance Outputable PendingTcSplice where
2153 ppr (PendingTcSplice n e) = pprPendingSplice n e
2154
2155 {-
2156 ************************************************************************
2157 * *
2158 \subsection{Enumerations and list comprehensions}
2159 * *
2160 ************************************************************************
2161 -}
2162
2163 data ArithSeqInfo id
2164 = From (LHsExpr id)
2165 | FromThen (LHsExpr id)
2166 (LHsExpr id)
2167 | FromTo (LHsExpr id)
2168 (LHsExpr id)
2169 | FromThenTo (LHsExpr id)
2170 (LHsExpr id)
2171 (LHsExpr id)
2172 deriving instance (DataId id) => Data (ArithSeqInfo id)
2173
2174 instance (OutputableBndrId id) => Outputable (ArithSeqInfo id) where
2175 ppr (From e1) = hcat [ppr e1, pp_dotdot]
2176 ppr (FromThen e1 e2) = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
2177 ppr (FromTo e1 e3) = hcat [ppr e1, pp_dotdot, ppr e3]
2178 ppr (FromThenTo e1 e2 e3)
2179 = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
2180
2181 pp_dotdot :: SDoc
2182 pp_dotdot = text " .. "
2183
2184 {-
2185 ************************************************************************
2186 * *
2187 \subsection{HsMatchCtxt}
2188 * *
2189 ************************************************************************
2190 -}
2191
2192 data FunctionFixity = Prefix | Infix deriving (Typeable,Data,Eq)
2193
2194 instance Outputable FunctionFixity where
2195 ppr Prefix = text "Prefix"
2196 ppr Infix = text "Infix"
2197
2198 -- | Context of a Match
2199 data HsMatchContext id
2200 = FunRhs (Located id) FunctionFixity -- ^Function binding for f, fixity
2201 | LambdaExpr -- ^Patterns of a lambda
2202 | CaseAlt -- ^Patterns and guards on a case alternative
2203 | IfAlt -- ^Guards of a multi-way if alternative
2204 | ProcExpr -- ^Patterns of a proc
2205 | PatBindRhs -- ^A pattern binding eg [y] <- e = e
2206
2207 | RecUpd -- ^Record update [used only in DsExpr to
2208 -- tell matchWrapper what sort of
2209 -- runtime error message to generate]
2210
2211 | StmtCtxt (HsStmtContext id) -- ^Pattern of a do-stmt, list comprehension,
2212 -- pattern guard, etc
2213
2214 | ThPatSplice -- ^A Template Haskell pattern splice
2215 | ThPatQuote -- ^A Template Haskell pattern quotation [p| (a,b) |]
2216 | PatSyn -- ^A pattern synonym declaration
2217 deriving Functor
2218 deriving instance (DataIdPost id) => Data (HsMatchContext id)
2219
2220 data HsStmtContext id
2221 = ListComp
2222 | MonadComp
2223 | PArrComp -- ^Parallel array comprehension
2224
2225 | DoExpr -- ^do { ... }
2226 | MDoExpr -- ^mdo { ... } ie recursive do-expression
2227 | ArrowExpr -- ^do-notation in an arrow-command context
2228
2229 | GhciStmtCtxt -- ^A command-line Stmt in GHCi pat <- rhs
2230 | PatGuard (HsMatchContext id) -- ^Pattern guard for specified thing
2231 | ParStmtCtxt (HsStmtContext id) -- ^A branch of a parallel stmt
2232 | TransStmtCtxt (HsStmtContext id) -- ^A branch of a transform stmt
2233 deriving Functor
2234 deriving instance (DataIdPost id) => Data (HsStmtContext id)
2235
2236 isListCompExpr :: HsStmtContext id -> Bool
2237 -- Uses syntax [ e | quals ]
2238 isListCompExpr ListComp = True
2239 isListCompExpr PArrComp = True
2240 isListCompExpr MonadComp = True
2241 isListCompExpr (ParStmtCtxt c) = isListCompExpr c
2242 isListCompExpr (TransStmtCtxt c) = isListCompExpr c
2243 isListCompExpr _ = False
2244
2245 isMonadCompExpr :: HsStmtContext id -> Bool
2246 isMonadCompExpr MonadComp = True
2247 isMonadCompExpr (ParStmtCtxt ctxt) = isMonadCompExpr ctxt
2248 isMonadCompExpr (TransStmtCtxt ctxt) = isMonadCompExpr ctxt
2249 isMonadCompExpr _ = False
2250
2251 matchSeparator :: HsMatchContext id -> SDoc
2252 matchSeparator (FunRhs {}) = text "="
2253 matchSeparator CaseAlt = text "->"
2254 matchSeparator IfAlt = text "->"
2255 matchSeparator LambdaExpr = text "->"
2256 matchSeparator ProcExpr = text "->"
2257 matchSeparator PatBindRhs = text "="
2258 matchSeparator (StmtCtxt _) = text "<-"
2259 matchSeparator RecUpd = panic "unused"
2260 matchSeparator ThPatSplice = panic "unused"
2261 matchSeparator ThPatQuote = panic "unused"
2262 matchSeparator PatSyn = panic "unused"
2263
2264 pprMatchContext :: (Outputable (NameOrRdrName id),Outputable id)
2265 => HsMatchContext id -> SDoc
2266 pprMatchContext ctxt
2267 | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt
2268 | otherwise = text "a" <+> pprMatchContextNoun ctxt
2269 where
2270 want_an (FunRhs {}) = True -- Use "an" in front
2271 want_an ProcExpr = True
2272 want_an _ = False
2273
2274 pprMatchContextNoun :: (Outputable (NameOrRdrName id),Outputable id)
2275 => HsMatchContext id -> SDoc
2276 pprMatchContextNoun (FunRhs (L _ fun) _) = text "equation for"
2277 <+> quotes (ppr fun)
2278 pprMatchContextNoun CaseAlt = text "case alternative"
2279 pprMatchContextNoun IfAlt = text "multi-way if alternative"
2280 pprMatchContextNoun RecUpd = text "record-update construct"
2281 pprMatchContextNoun ThPatSplice = text "Template Haskell pattern splice"
2282 pprMatchContextNoun ThPatQuote = text "Template Haskell pattern quotation"
2283 pprMatchContextNoun PatBindRhs = text "pattern binding"
2284 pprMatchContextNoun LambdaExpr = text "lambda abstraction"
2285 pprMatchContextNoun ProcExpr = text "arrow abstraction"
2286 pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in"
2287 $$ pprStmtContext ctxt
2288 pprMatchContextNoun PatSyn = text "pattern synonym declaration"
2289
2290 -----------------
2291 pprAStmtContext, pprStmtContext :: (Outputable id,
2292 Outputable (NameOrRdrName id))
2293 => HsStmtContext id -> SDoc
2294 pprAStmtContext ctxt = article <+> pprStmtContext ctxt
2295 where
2296 pp_an = text "an"
2297 pp_a = text "a"
2298 article = case ctxt of
2299 MDoExpr -> pp_an
2300 PArrComp -> pp_an
2301 GhciStmtCtxt -> pp_an
2302 _ -> pp_a
2303
2304
2305 -----------------
2306 pprStmtContext GhciStmtCtxt = text "interactive GHCi command"
2307 pprStmtContext DoExpr = text "'do' block"
2308 pprStmtContext MDoExpr = text "'mdo' block"
2309 pprStmtContext ArrowExpr = text "'do' block in an arrow command"
2310 pprStmtContext ListComp = text "list comprehension"
2311 pprStmtContext MonadComp = text "monad comprehension"
2312 pprStmtContext PArrComp = text "array comprehension"
2313 pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt
2314
2315 -- Drop the inner contexts when reporting errors, else we get
2316 -- Unexpected transform statement
2317 -- in a transformed branch of
2318 -- transformed branch of
2319 -- transformed branch of monad comprehension
2320 pprStmtContext (ParStmtCtxt c)
2321 | opt_PprStyle_Debug = sep [text "parallel branch of", pprAStmtContext c]
2322 | otherwise = pprStmtContext c
2323 pprStmtContext (TransStmtCtxt c)
2324 | opt_PprStyle_Debug = sep [text "transformed branch of", pprAStmtContext c]
2325 | otherwise = pprStmtContext c
2326
2327
2328 -- Used to generate the string for a *runtime* error message
2329 matchContextErrString :: Outputable id
2330 => HsMatchContext id -> SDoc
2331 matchContextErrString (FunRhs (L _ fun) _) = text "function" <+> ppr fun
2332 matchContextErrString CaseAlt = text "case"
2333 matchContextErrString IfAlt = text "multi-way if"
2334 matchContextErrString PatBindRhs = text "pattern binding"
2335 matchContextErrString RecUpd = text "record update"
2336 matchContextErrString LambdaExpr = text "lambda"
2337 matchContextErrString ProcExpr = text "proc"
2338 matchContextErrString ThPatSplice = panic "matchContextErrString" -- Not used at runtime
2339 matchContextErrString ThPatQuote = panic "matchContextErrString" -- Not used at runtime
2340 matchContextErrString PatSyn = panic "matchContextErrString" -- Not used at runtime
2341 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
2342 matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)
2343 matchContextErrString (StmtCtxt (PatGuard _)) = text "pattern guard"
2344 matchContextErrString (StmtCtxt GhciStmtCtxt) = text "interactive GHCi command"
2345 matchContextErrString (StmtCtxt DoExpr) = text "'do' block"
2346 matchContextErrString (StmtCtxt ArrowExpr) = text "'do' block"
2347 matchContextErrString (StmtCtxt MDoExpr) = text "'mdo' block"
2348 matchContextErrString (StmtCtxt ListComp) = text "list comprehension"
2349 matchContextErrString (StmtCtxt MonadComp) = text "monad comprehension"
2350 matchContextErrString (StmtCtxt PArrComp) = text "array comprehension"
2351
2352 pprMatchInCtxt :: (OutputableBndrId idR,
2353 Outputable (NameOrRdrName (NameOrRdrName idR)),
2354 Outputable body)
2355 => Match idR body -> SDoc
2356 pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match)
2357 <> colon)
2358 4 (pprMatch match)
2359
2360 pprStmtInCtxt :: (OutputableBndrId idL, OutputableBndrId idR, Outputable body)
2361 => HsStmtContext idL -> StmtLR idL idR body -> SDoc
2362 pprStmtInCtxt ctxt (LastStmt e _ _)
2363 | isListCompExpr ctxt -- For [ e | .. ], do not mutter about "stmts"
2364 = hang (text "In the expression:") 2 (ppr e)
2365
2366 pprStmtInCtxt ctxt stmt
2367 = hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon)
2368 2 (ppr_stmt stmt)
2369 where
2370 -- For Group and Transform Stmts, don't print the nested stmts!
2371 ppr_stmt (TransStmt { trS_by = by, trS_using = using
2372 , trS_form = form }) = pprTransStmt by using form
2373 ppr_stmt stmt = pprStmt stmt