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