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