b86f4a147d78805769dd830cdb89a6e992b63689
[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 -- These constructors only appear temporarily in the parser.
629 -- The renamer translates them into the Right Thing.
630
631 | EWildPat (XEWildPat p) -- wildcard
632
633 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
634
635 -- For details on above see note [Api annotations] in ApiAnnotation
636 | EAsPat (XEAsPat p)
637 (Located (IdP p)) -- as pattern
638 (LHsExpr p)
639
640 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
641
642 -- For details on above see note [Api annotations] in ApiAnnotation
643 | EViewPat (XEViewPat p)
644 (LHsExpr p) -- view pattern
645 (LHsExpr p)
646
647 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
648
649 -- For details on above see note [Api annotations] in ApiAnnotation
650 | ELazyPat (XELazyPat p) (LHsExpr p) -- ~ pattern
651
652
653 ---------------------------------------
654 -- Finally, HsWrap appears only in typechecker output
655 -- The contained Expr is *NOT* itself an HsWrap.
656 -- See Note [Detecting forced eta expansion] in DsExpr. This invariant
657 -- is maintained by HsUtils.mkHsWrap.
658
659 | HsWrap (XWrap p)
660 HsWrapper -- TRANSLATION
661 (HsExpr p)
662
663 | XExpr (XXExpr p) -- Note [Trees that Grow] extension constructor
664
665
666 -- | Extra data fields for a 'RecordCon', added by the type checker
667 data RecordConTc = RecordConTc
668 { rcon_con_like :: ConLike -- The data constructor or pattern synonym
669 , rcon_con_expr :: PostTcExpr -- Instantiated constructor function
670 }
671
672 -- | Extra data fields for a 'RecordUpd', added by the type checker
673 data RecordUpdTc = RecordUpdTc
674 { rupd_cons :: [ConLike]
675 -- Filled in by the type checker to the
676 -- _non-empty_ list of DataCons that have
677 -- all the upd'd fields
678
679 , rupd_in_tys :: [Type] -- Argument types of *input* record type
680 , rupd_out_tys :: [Type] -- and *output* record type
681 -- The original type can be reconstructed
682 -- with conLikeResTy
683 , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]
684 } deriving Data
685
686 -- ---------------------------------------------------------------------
687
688 type instance XVar (GhcPass _) = NoExt
689 type instance XUnboundVar (GhcPass _) = NoExt
690 type instance XConLikeOut (GhcPass _) = NoExt
691 type instance XRecFld (GhcPass _) = NoExt
692 type instance XOverLabel (GhcPass _) = NoExt
693 type instance XIPVar (GhcPass _) = NoExt
694 type instance XOverLitE (GhcPass _) = NoExt
695 type instance XLitE (GhcPass _) = NoExt
696 type instance XLam (GhcPass _) = NoExt
697 type instance XLamCase (GhcPass _) = NoExt
698 type instance XApp (GhcPass _) = NoExt
699
700 type instance XAppTypeE (GhcPass _) = NoExt
701
702 type instance XOpApp GhcPs = NoExt
703 type instance XOpApp GhcRn = Fixity
704 type instance XOpApp GhcTc = Fixity
705
706 type instance XNegApp (GhcPass _) = NoExt
707 type instance XPar (GhcPass _) = NoExt
708 type instance XSectionL (GhcPass _) = NoExt
709 type instance XSectionR (GhcPass _) = NoExt
710 type instance XExplicitTuple (GhcPass _) = NoExt
711
712 type instance XExplicitSum GhcPs = NoExt
713 type instance XExplicitSum GhcRn = NoExt
714 type instance XExplicitSum GhcTc = [Type]
715
716 type instance XCase (GhcPass _) = NoExt
717 type instance XIf (GhcPass _) = NoExt
718
719 type instance XMultiIf GhcPs = NoExt
720 type instance XMultiIf GhcRn = NoExt
721 type instance XMultiIf GhcTc = Type
722
723 type instance XLet (GhcPass _) = NoExt
724
725 type instance XDo GhcPs = NoExt
726 type instance XDo GhcRn = NoExt
727 type instance XDo GhcTc = Type
728
729 type instance XExplicitList GhcPs = NoExt
730 type instance XExplicitList GhcRn = NoExt
731 type instance XExplicitList GhcTc = Type
732
733 type instance XRecordCon GhcPs = NoExt
734 type instance XRecordCon GhcRn = NoExt
735 type instance XRecordCon GhcTc = RecordConTc
736
737 type instance XRecordUpd GhcPs = NoExt
738 type instance XRecordUpd GhcRn = NoExt
739 type instance XRecordUpd GhcTc = RecordUpdTc
740
741 type instance XExprWithTySig (GhcPass _) = NoExt
742
743 type instance XArithSeq GhcPs = NoExt
744 type instance XArithSeq GhcRn = NoExt
745 type instance XArithSeq GhcTc = PostTcExpr
746
747 type instance XSCC (GhcPass _) = NoExt
748 type instance XCoreAnn (GhcPass _) = NoExt
749 type instance XBracket (GhcPass _) = NoExt
750
751 type instance XRnBracketOut (GhcPass _) = NoExt
752 type instance XTcBracketOut (GhcPass _) = NoExt
753
754 type instance XSpliceE (GhcPass _) = NoExt
755 type instance XProc (GhcPass _) = NoExt
756
757 type instance XStatic GhcPs = NoExt
758 type instance XStatic GhcRn = NameSet
759 type instance XStatic GhcTc = NameSet
760
761 type instance XTick (GhcPass _) = NoExt
762 type instance XBinTick (GhcPass _) = NoExt
763 type instance XTickPragma (GhcPass _) = NoExt
764 type instance XEWildPat (GhcPass _) = NoExt
765 type instance XEAsPat (GhcPass _) = NoExt
766 type instance XEViewPat (GhcPass _) = NoExt
767 type instance XELazyPat (GhcPass _) = NoExt
768 type instance XWrap (GhcPass _) = NoExt
769 type instance XXExpr (GhcPass _) = NoExt
770
771 -- ---------------------------------------------------------------------
772
773 -- | Located Haskell Tuple Argument
774 --
775 -- 'HsTupArg' is used for tuple sections
776 -- @(,a,)@ is represented by
777 -- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@
778 -- Which in turn stands for @(\x:ty1 \y:ty2. (x,a,y))@
779 type LHsTupArg id = Located (HsTupArg id)
780 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
781
782 -- For details on above see note [Api annotations] in ApiAnnotation
783
784 -- | Haskell Tuple Argument
785 data HsTupArg id
786 = Present (XPresent id) (LHsExpr id) -- ^ The argument
787 | Missing (XMissing id) -- ^ The argument is missing, but this is its type
788 | XTupArg (XXTupArg id) -- ^ Note [Trees that Grow] extension point
789
790 type instance XPresent (GhcPass _) = NoExt
791
792 type instance XMissing GhcPs = NoExt
793 type instance XMissing GhcRn = NoExt
794 type instance XMissing GhcTc = Type
795
796 type instance XXTupArg (GhcPass _) = NoExt
797
798 tupArgPresent :: LHsTupArg id -> Bool
799 tupArgPresent (L _ (Present {})) = True
800 tupArgPresent (L _ (Missing {})) = False
801 tupArgPresent (L _ (XTupArg {})) = False
802
803 {-
804 Note [Parens in HsSyn]
805 ~~~~~~~~~~~~~~~~~~~~~~
806 HsPar (and ParPat in patterns, HsParTy in types) is used as follows
807
808 * HsPar is required; the pretty printer does not add parens.
809
810 * HsPars are respected when rearranging operator fixities.
811 So a * (b + c) means what it says (where the parens are an HsPar)
812
813 * For ParPat and HsParTy the pretty printer does add parens but this should be
814 a no-op for ParsedSource, based on the pretty printer round trip feature
815 introduced in
816 https://phabricator.haskell.org/rGHC499e43824bda967546ebf95ee33ec1f84a114a7c
817
818 * ParPat and HsParTy are pretty printed as '( .. )' regardless of whether or
819 not they are strictly necessary. This should be addressed when #13238 is
820 completed, to be treated the same as HsPar.
821
822
823 Note [Sections in HsSyn]
824 ~~~~~~~~~~~~~~~~~~~~~~~~
825 Sections should always appear wrapped in an HsPar, thus
826 HsPar (SectionR ...)
827 The parser parses sections in a wider variety of situations
828 (See Note [Parsing sections]), but the renamer checks for those
829 parens. This invariant makes pretty-printing easier; we don't need
830 a special case for adding the parens round sections.
831
832 Note [Rebindable if]
833 ~~~~~~~~~~~~~~~~~~~~
834 The rebindable syntax for 'if' is a bit special, because when
835 rebindable syntax is *off* we do not want to treat
836 (if c then t else e)
837 as if it was an application (ifThenElse c t e). Why not?
838 Because we allow an 'if' to return *unboxed* results, thus
839 if blah then 3# else 4#
840 whereas that would not be possible using a all to a polymorphic function
841 (because you can't call a polymorphic function at an unboxed type).
842
843 So we use Nothing to mean "use the old built-in typing rule".
844
845 Note [Record Update HsWrapper]
846 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
847 There is a wrapper in RecordUpd which is used for the *required*
848 constraints for pattern synonyms. This wrapper is created in the
849 typechecking and is then directly used in the desugaring without
850 modification.
851
852 For example, if we have the record pattern synonym P,
853 pattern P :: (Show a) => a -> Maybe a
854 pattern P{x} = Just x
855
856 foo = (Just True) { x = False }
857 then `foo` desugars to something like
858 foo = case Just True of
859 P x -> P False
860 hence we need to provide the correct dictionaries to P's matcher on
861 the RHS so that we can build the expression.
862
863 Note [Located RdrNames]
864 ~~~~~~~~~~~~~~~~~~~~~~~
865 A number of syntax elements have seemingly redundant locations attached to them.
866 This is deliberate, to allow transformations making use of the API Annotations
867 to easily correlate a Located Name in the RenamedSource with a Located RdrName
868 in the ParsedSource.
869
870 There are unfortunately enough differences between the ParsedSource and the
871 RenamedSource that the API Annotations cannot be used directly with
872 RenamedSource, so this allows a simple mapping to be used based on the location.
873 -}
874
875 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) where
876 ppr expr = pprExpr expr
877
878 -----------------------
879 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
880 -- the underscore versions do not
881 pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
882 pprLExpr (L _ e) = pprExpr e
883
884 pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc
885 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e = ppr_expr e
886 | otherwise = pprDeeper (ppr_expr e)
887
888 isQuietHsExpr :: HsExpr id -> Bool
889 -- Parentheses do display something, but it gives little info and
890 -- if we go deeper when we go inside them then we get ugly things
891 -- like (...)
892 isQuietHsExpr (HsPar {}) = True
893 -- applications don't display anything themselves
894 isQuietHsExpr (HsApp {}) = True
895 isQuietHsExpr (HsAppType {}) = True
896 isQuietHsExpr (OpApp {}) = True
897 isQuietHsExpr _ = False
898
899 pprBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
900 => HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
901 pprBinds b = pprDeeper (ppr b)
902
903 -----------------------
904 ppr_lexpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
905 ppr_lexpr e = ppr_expr (unLoc e)
906
907 ppr_expr :: forall p. (OutputableBndrId (GhcPass p))
908 => HsExpr (GhcPass p) -> SDoc
909 ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v
910 ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)
911 ppr_expr (HsConLikeOut _ c) = pprPrefixOcc c
912 ppr_expr (HsIPVar _ v) = ppr v
913 ppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l
914 ppr_expr (HsLit _ lit) = ppr lit
915 ppr_expr (HsOverLit _ lit) = ppr lit
916 ppr_expr (HsPar _ e) = parens (ppr_lexpr e)
917
918 ppr_expr (HsCoreAnn _ stc (StringLiteral sta s) e)
919 = vcat [pprWithSourceText stc (text "{-# CORE")
920 <+> pprWithSourceText sta (doubleQuotes $ ftext s) <+> text "#-}"
921 , ppr_lexpr e]
922
923 ppr_expr e@(HsApp {}) = ppr_apps e []
924 ppr_expr e@(HsAppType {}) = ppr_apps e []
925
926 ppr_expr (OpApp _ e1 op e2)
927 | Just pp_op <- should_print_infix (unLoc op)
928 = pp_infixly pp_op
929 | otherwise
930 = pp_prefixly
931
932 where
933 should_print_infix (HsVar _ (L _ v)) = Just (pprInfixOcc v)
934 should_print_infix (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))
935 should_print_infix (HsRecFld _ f) = Just (pprInfixOcc f)
936 should_print_infix (HsUnboundVar _ h@TrueExprHole{})
937 = Just (pprInfixOcc (unboundVarOcc h))
938 should_print_infix (EWildPat _) = Just (text "`_`")
939 should_print_infix (HsWrap _ _ e) = should_print_infix e
940 should_print_infix _ = Nothing
941
942 pp_e1 = pprDebugParendExpr opPrec e1 -- In debug mode, add parens
943 pp_e2 = pprDebugParendExpr opPrec e2 -- to make precedence clear
944
945 pp_prefixly
946 = hang (ppr op) 2 (sep [pp_e1, pp_e2])
947
948 pp_infixly pp_op
949 = hang pp_e1 2 (sep [pp_op, nest 2 pp_e2])
950
951 ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e
952
953 ppr_expr (SectionL _ expr op)
954 = case unLoc op of
955 HsVar _ (L _ v) -> pp_infixly v
956 HsConLikeOut _ c -> pp_infixly (conLikeName c)
957 HsUnboundVar _ h@TrueExprHole{}
958 -> pp_infixly (unboundVarOcc h)
959 _ -> pp_prefixly
960 where
961 pp_expr = pprDebugParendExpr opPrec expr
962
963 pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
964 4 (hsep [pp_expr, text "x_ )"])
965
966 pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc
967 pp_infixly v = (sep [pp_expr, pprInfixOcc v])
968
969 ppr_expr (SectionR _ op expr)
970 = case unLoc op of
971 HsVar _ (L _ v) -> pp_infixly v
972 HsConLikeOut _ c -> pp_infixly (conLikeName c)
973 HsUnboundVar _ h@TrueExprHole{}
974 -> pp_infixly (unboundVarOcc h)
975 _ -> pp_prefixly
976 where
977 pp_expr = pprDebugParendExpr opPrec expr
978
979 pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
980 4 (pp_expr <> rparen)
981
982 pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc
983 pp_infixly v = sep [pprInfixOcc v, pp_expr]
984
985 ppr_expr (ExplicitTuple _ exprs boxity)
986 = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
987 where
988 ppr_tup_args [] = []
989 ppr_tup_args (Present _ e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
990 ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
991 ppr_tup_args (XTupArg x : es) = (ppr x <> punc es) : ppr_tup_args es
992
993 punc (Present {} : _) = comma <> space
994 punc (Missing {} : _) = comma
995 punc (XTupArg {} : _) = comma <> space
996 punc [] = empty
997
998 ppr_expr (ExplicitSum _ alt arity expr)
999 = text "(#" <+> ppr_bars (alt - 1) <+> ppr expr <+> ppr_bars (arity - alt) <+> text "#)"
1000 where
1001 ppr_bars n = hsep (replicate n (char '|'))
1002
1003 ppr_expr (HsLam _ matches)
1004 = pprMatches matches
1005
1006 ppr_expr (HsLamCase _ matches)
1007 = sep [ sep [text "\\case"],
1008 nest 2 (pprMatches matches) ]
1009
1010 ppr_expr (HsCase _ expr matches@(MG { mg_alts = L _ [_] }))
1011 = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
1012 nest 2 (pprMatches matches) <+> char '}']
1013 ppr_expr (HsCase _ expr matches)
1014 = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],
1015 nest 2 (pprMatches matches) ]
1016
1017 ppr_expr (HsIf _ _ e1 e2 e3)
1018 = sep [hsep [text "if", nest 2 (ppr e1), ptext (sLit "then")],
1019 nest 4 (ppr e2),
1020 text "else",
1021 nest 4 (ppr e3)]
1022
1023 ppr_expr (HsMultiIf _ alts)
1024 = hang (text "if") 3 (vcat (map ppr_alt alts))
1025 where ppr_alt (L _ (GRHS _ guards expr)) =
1026 hang vbar 2 (ppr_one one_alt)
1027 where
1028 ppr_one [] = panic "ppr_exp HsMultiIf"
1029 ppr_one (h:t) = hang h 2 (sep t)
1030 one_alt = [ interpp'SP guards
1031 , text "->" <+> pprDeeper (ppr expr) ]
1032 ppr_alt (L _ (XGRHS x)) = ppr x
1033
1034 -- special case: let ... in let ...
1035 ppr_expr (HsLet _ (L _ binds) expr@(L _ (HsLet _ _ _)))
1036 = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
1037 ppr_lexpr expr]
1038
1039 ppr_expr (HsLet _ (L _ binds) expr)
1040 = sep [hang (text "let") 2 (pprBinds binds),
1041 hang (text "in") 2 (ppr expr)]
1042
1043 ppr_expr (HsDo _ do_or_list_comp (L _ stmts)) = pprDo do_or_list_comp stmts
1044
1045 ppr_expr (ExplicitList _ _ exprs)
1046 = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
1047
1048 ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })
1049 = hang (ppr con_id) 2 (ppr rbinds)
1050
1051 ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
1052 = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
1053
1054 ppr_expr (ExprWithTySig _ expr sig)
1055 = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
1056 4 (ppr sig)
1057
1058 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
1059
1060 ppr_expr (EWildPat _) = char '_'
1061 ppr_expr (ELazyPat _ e) = char '~' <> ppr e
1062 ppr_expr (EAsPat _ (L _ v) e) = pprPrefixOcc v <> char '@' <> ppr e
1063 ppr_expr (EViewPat _ p e) = ppr p <+> text "->" <+> ppr e
1064
1065 ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr)
1066 = sep [ pprWithSourceText st (text "{-# SCC")
1067 -- no doublequotes if stl empty, for the case where the SCC was written
1068 -- without quotes.
1069 <+> pprWithSourceText stl (ftext lbl) <+> text "#-}",
1070 ppr expr ]
1071
1072 ppr_expr (HsWrap _ co_fn e)
1073 = pprHsWrapper co_fn (\parens -> if parens then pprExpr e
1074 else pprExpr e)
1075
1076 ppr_expr (HsSpliceE _ s) = pprSplice s
1077 ppr_expr (HsBracket _ b) = pprHsBracket b
1078 ppr_expr (HsRnBracketOut _ e []) = ppr e
1079 ppr_expr (HsRnBracketOut _ e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
1080 ppr_expr (HsTcBracketOut _ e []) = ppr e
1081 ppr_expr (HsTcBracketOut _ e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
1082
1083 ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))
1084 = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]
1085 ppr_expr (HsProc _ pat (L _ (XCmdTop x)))
1086 = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr x]
1087
1088 ppr_expr (HsStatic _ e)
1089 = hsep [text "static", ppr e]
1090
1091 ppr_expr (HsTick _ tickish exp)
1092 = pprTicks (ppr exp) $
1093 ppr tickish <+> ppr_lexpr exp
1094 ppr_expr (HsBinTick _ tickIdTrue tickIdFalse exp)
1095 = pprTicks (ppr exp) $
1096 hcat [text "bintick<",
1097 ppr tickIdTrue,
1098 text ",",
1099 ppr tickIdFalse,
1100 text ">(",
1101 ppr exp, text ")"]
1102 ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)
1103 = pprTicks (ppr exp) $
1104 hcat [text "tickpragma<",
1105 pprExternalSrcLoc externalSrcLoc,
1106 text ">(",
1107 ppr exp,
1108 text ")"]
1109
1110 ppr_expr (HsRecFld _ f) = ppr f
1111 ppr_expr (XExpr x) = ppr x
1112
1113 ppr_apps :: (OutputableBndrId (GhcPass p))
1114 => HsExpr (GhcPass p)
1115 -> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]
1116 -> SDoc
1117 ppr_apps (HsApp _ (L _ fun) arg) args
1118 = ppr_apps fun (Left arg : args)
1119 ppr_apps (HsAppType _ (L _ fun) arg) args
1120 = ppr_apps fun (Right arg : args)
1121 ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))
1122 where
1123 pp (Left arg) = ppr arg
1124 -- pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
1125 -- = char '@' <> pprHsType arg
1126 pp (Right arg)
1127 = char '@' <> ppr arg
1128
1129 pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
1130 pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))
1131 = ppr (src,(n1,n2),(n3,n4))
1132
1133 {-
1134 HsSyn records exactly where the user put parens, with HsPar.
1135 So generally speaking we print without adding any parens.
1136 However, some code is internally generated, and in some places
1137 parens are absolutely required; so for these places we use
1138 pprParendLExpr (but don't print double parens of course).
1139
1140 For operator applications we don't add parens, because the operator
1141 fixities should do the job, except in debug mode (-dppr-debug) so we
1142 can see the structure of the parse tree.
1143 -}
1144
1145 pprDebugParendExpr :: (OutputableBndrId (GhcPass p))
1146 => PprPrec -> LHsExpr (GhcPass p) -> SDoc
1147 pprDebugParendExpr p expr
1148 = getPprStyle (\sty ->
1149 if debugStyle sty then pprParendLExpr p expr
1150 else pprLExpr expr)
1151
1152 pprParendLExpr :: (OutputableBndrId (GhcPass p))
1153 => PprPrec -> LHsExpr (GhcPass p) -> SDoc
1154 pprParendLExpr p (L _ e) = pprParendExpr p e
1155
1156 pprParendExpr :: (OutputableBndrId (GhcPass p))
1157 => PprPrec -> HsExpr (GhcPass p) -> SDoc
1158 pprParendExpr p expr
1159 | hsExprNeedsParens p expr = parens (pprExpr expr)
1160 | otherwise = pprExpr expr
1161 -- Using pprLExpr makes sure that we go 'deeper'
1162 -- I think that is usually (always?) right
1163
1164 -- | @'hsExprNeedsParens' p e@ returns 'True' if the expression @e@ needs
1165 -- parentheses under precedence @p@.
1166 hsExprNeedsParens :: PprPrec -> HsExpr p -> Bool
1167 hsExprNeedsParens p = go
1168 where
1169 go (HsVar{}) = False
1170 go (HsUnboundVar{}) = False
1171 go (HsConLikeOut{}) = False
1172 go (HsIPVar{}) = False
1173 go (HsOverLabel{}) = False
1174 go (HsLit _ l) = hsLitNeedsParens p l
1175 go (HsOverLit _ ol) = hsOverLitNeedsParens p ol
1176 go (HsPar{}) = False
1177 go (HsCoreAnn _ _ _ (L _ e)) = go e
1178 go (HsApp{}) = p >= appPrec
1179 go (HsAppType {}) = p >= appPrec
1180 go (OpApp{}) = p >= opPrec
1181 go (NegApp{}) = p > topPrec
1182 go (SectionL{}) = True
1183 go (SectionR{}) = True
1184 go (ExplicitTuple{}) = False
1185 go (ExplicitSum{}) = False
1186 go (HsLam{}) = p > topPrec
1187 go (HsLamCase{}) = p > topPrec
1188 go (HsCase{}) = p > topPrec
1189 go (HsIf{}) = p > topPrec
1190 go (HsMultiIf{}) = p > topPrec
1191 go (HsLet{}) = p > topPrec
1192 go (HsDo _ sc _)
1193 | isComprehensionContext sc = False
1194 | otherwise = p > topPrec
1195 go (ExplicitList{}) = False
1196 go (RecordUpd{}) = False
1197 go (ExprWithTySig{}) = p >= sigPrec
1198 go (ArithSeq{}) = False
1199 go (EWildPat{}) = False
1200 go (ELazyPat{}) = False
1201 go (EAsPat{}) = False
1202 go (EViewPat{}) = True
1203 go (HsSCC{}) = p >= appPrec
1204 go (HsWrap _ _ e) = go e
1205 go (HsSpliceE{}) = False
1206 go (HsBracket{}) = False
1207 go (HsRnBracketOut{}) = False
1208 go (HsTcBracketOut{}) = False
1209 go (HsProc{}) = p > topPrec
1210 go (HsStatic{}) = p >= appPrec
1211 go (HsTick _ _ (L _ e)) = go e
1212 go (HsBinTick _ _ _ (L _ e)) = go e
1213 go (HsTickPragma _ _ _ _ (L _ e)) = go e
1214 go (RecordCon{}) = False
1215 go (HsRecFld{}) = False
1216 go (XExpr{}) = True
1217
1218 -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true,
1219 -- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.
1220 parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
1221 parenthesizeHsExpr p le@(L loc e)
1222 | hsExprNeedsParens p e = L loc (HsPar NoExt le)
1223 | otherwise = le
1224
1225 isAtomicHsExpr :: HsExpr id -> Bool
1226 -- True of a single token
1227 isAtomicHsExpr (HsVar {}) = True
1228 isAtomicHsExpr (HsConLikeOut {}) = True
1229 isAtomicHsExpr (HsLit {}) = True
1230 isAtomicHsExpr (HsOverLit {}) = True
1231 isAtomicHsExpr (HsIPVar {}) = True
1232 isAtomicHsExpr (HsOverLabel {}) = True
1233 isAtomicHsExpr (HsUnboundVar {}) = True
1234 isAtomicHsExpr (HsWrap _ _ e) = isAtomicHsExpr e
1235 isAtomicHsExpr (HsPar _ e) = isAtomicHsExpr (unLoc e)
1236 isAtomicHsExpr (HsRecFld{}) = True
1237 isAtomicHsExpr _ = False
1238
1239 {-
1240 ************************************************************************
1241 * *
1242 \subsection{Commands (in arrow abstractions)}
1243 * *
1244 ************************************************************************
1245
1246 We re-use HsExpr to represent these.
1247 -}
1248
1249 -- | Located Haskell Command (for arrow syntax)
1250 type LHsCmd id = Located (HsCmd id)
1251
1252 -- | Haskell Command (e.g. a "statement" in an Arrow proc block)
1253 data HsCmd id
1254 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
1255 -- 'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
1256 -- 'ApiAnnotation.AnnRarrowtail'
1257
1258 -- For details on above see note [Api annotations] in ApiAnnotation
1259 = HsCmdArrApp -- Arrow tail, or arrow application (f -< arg)
1260 (XCmdArrApp id) -- type of the arrow expressions f,
1261 -- of the form a t t', where arg :: t
1262 (LHsExpr id) -- arrow expression, f
1263 (LHsExpr id) -- input expression, arg
1264 HsArrAppType -- higher-order (-<<) or first-order (-<)
1265 Bool -- True => right-to-left (f -< arg)
1266 -- False => left-to-right (arg >- f)
1267
1268 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,
1269 -- 'ApiAnnotation.AnnCloseB' @'|)'@
1270
1271 -- For details on above see note [Api annotations] in ApiAnnotation
1272 | HsCmdArrForm -- Command formation, (| e cmd1 .. cmdn |)
1273 (XCmdArrForm id)
1274 (LHsExpr id) -- The operator.
1275 -- After type-checking, a type abstraction to be
1276 -- applied to the type of the local environment tuple
1277 LexicalFixity -- Whether the operator appeared prefix or infix when
1278 -- parsed.
1279 (Maybe Fixity) -- fixity (filled in by the renamer), for forms that
1280 -- were converted from OpApp's by the renamer
1281 [LHsCmdTop id] -- argument commands
1282
1283 | HsCmdApp (XCmdApp id)
1284 (LHsCmd id)
1285 (LHsExpr id)
1286
1287 | HsCmdLam (XCmdLam id)
1288 (MatchGroup id (LHsCmd id)) -- kappa
1289 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
1290 -- 'ApiAnnotation.AnnRarrow',
1291
1292 -- For details on above see note [Api annotations] in ApiAnnotation
1293
1294 | HsCmdPar (XCmdPar id)
1295 (LHsCmd id) -- parenthesised command
1296 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
1297 -- 'ApiAnnotation.AnnClose' @')'@
1298
1299 -- For details on above see note [Api annotations] in ApiAnnotation
1300
1301 | HsCmdCase (XCmdCase id)
1302 (LHsExpr id)
1303 (MatchGroup id (LHsCmd id)) -- bodies are HsCmd's
1304 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
1305 -- 'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
1306 -- 'ApiAnnotation.AnnClose' @'}'@
1307
1308 -- For details on above see note [Api annotations] in ApiAnnotation
1309
1310 | HsCmdIf (XCmdIf id)
1311 (Maybe (SyntaxExpr id)) -- cond function
1312 (LHsExpr id) -- predicate
1313 (LHsCmd id) -- then part
1314 (LHsCmd id) -- else part
1315 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
1316 -- 'ApiAnnotation.AnnSemi',
1317 -- 'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
1318 -- 'ApiAnnotation.AnnElse',
1319
1320 -- For details on above see note [Api annotations] in ApiAnnotation
1321
1322 | HsCmdLet (XCmdLet id)
1323 (LHsLocalBinds id) -- let(rec)
1324 (LHsCmd id)
1325 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
1326 -- 'ApiAnnotation.AnnOpen' @'{'@,
1327 -- 'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
1328
1329 -- For details on above see note [Api annotations] in ApiAnnotation
1330
1331 | HsCmdDo (XCmdDo id) -- Type of the whole expression
1332 (Located [CmdLStmt id])
1333 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
1334 -- 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
1335 -- 'ApiAnnotation.AnnVbar',
1336 -- 'ApiAnnotation.AnnClose'
1337
1338 -- For details on above see note [Api annotations] in ApiAnnotation
1339
1340 | HsCmdWrap (XCmdWrap id)
1341 HsWrapper
1342 (HsCmd id) -- If cmd :: arg1 --> res
1343 -- wrap :: arg1 "->" arg2
1344 -- Then (HsCmdWrap wrap cmd) :: arg2 --> res
1345 | XCmd (XXCmd id) -- Note [Trees that Grow] extension point
1346
1347 type instance XCmdArrApp GhcPs = NoExt
1348 type instance XCmdArrApp GhcRn = NoExt
1349 type instance XCmdArrApp GhcTc = Type
1350
1351 type instance XCmdArrForm (GhcPass _) = NoExt
1352 type instance XCmdApp (GhcPass _) = NoExt
1353 type instance XCmdLam (GhcPass _) = NoExt
1354 type instance XCmdPar (GhcPass _) = NoExt
1355 type instance XCmdCase (GhcPass _) = NoExt
1356 type instance XCmdIf (GhcPass _) = NoExt
1357 type instance XCmdLet (GhcPass _) = NoExt
1358
1359 type instance XCmdDo GhcPs = NoExt
1360 type instance XCmdDo GhcRn = NoExt
1361 type instance XCmdDo GhcTc = Type
1362
1363 type instance XCmdWrap (GhcPass _) = NoExt
1364 type instance XXCmd (GhcPass _) = NoExt
1365
1366 -- | Haskell Array Application Type
1367 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
1368 deriving Data
1369
1370
1371 {- | Top-level command, introducing a new arrow.
1372 This may occur inside a proc (where the stack is empty) or as an
1373 argument of a command-forming operator.
1374 -}
1375
1376 -- | Located Haskell Top-level Command
1377 type LHsCmdTop p = Located (HsCmdTop p)
1378
1379 -- | Haskell Top-level Command
1380 data HsCmdTop p
1381 = HsCmdTop (XCmdTop p)
1382 (LHsCmd p)
1383 | XCmdTop (XXCmdTop p) -- Note [Trees that Grow] extension point
1384
1385 data CmdTopTc
1386 = CmdTopTc Type -- Nested tuple of inputs on the command's stack
1387 Type -- return type of the command
1388 (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]
1389
1390 type instance XCmdTop GhcPs = NoExt
1391 type instance XCmdTop GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]
1392 type instance XCmdTop GhcTc = CmdTopTc
1393
1394 type instance XXCmdTop (GhcPass _) = NoExt
1395
1396 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where
1397 ppr cmd = pprCmd cmd
1398
1399 -----------------------
1400 -- pprCmd and pprLCmd call pprDeeper;
1401 -- the underscore versions do not
1402 pprLCmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc
1403 pprLCmd (L _ c) = pprCmd c
1404
1405 pprCmd :: (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc
1406 pprCmd c | isQuietHsCmd c = ppr_cmd c
1407 | otherwise = pprDeeper (ppr_cmd c)
1408
1409 isQuietHsCmd :: HsCmd id -> Bool
1410 -- Parentheses do display something, but it gives little info and
1411 -- if we go deeper when we go inside them then we get ugly things
1412 -- like (...)
1413 isQuietHsCmd (HsCmdPar {}) = True
1414 -- applications don't display anything themselves
1415 isQuietHsCmd (HsCmdApp {}) = True
1416 isQuietHsCmd _ = False
1417
1418 -----------------------
1419 ppr_lcmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc
1420 ppr_lcmd c = ppr_cmd (unLoc c)
1421
1422 ppr_cmd :: forall p. (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc
1423 ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)
1424
1425 ppr_cmd (HsCmdApp _ c e)
1426 = let (fun, args) = collect_args c [e] in
1427 hang (ppr_lcmd fun) 2 (sep (map ppr args))
1428 where
1429 collect_args (L _ (HsCmdApp _ fun arg)) args = collect_args fun (arg:args)
1430 collect_args fun args = (fun, args)
1431
1432 ppr_cmd (HsCmdLam _ matches)
1433 = pprMatches matches
1434
1435 ppr_cmd (HsCmdCase _ expr matches)
1436 = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],
1437 nest 2 (pprMatches matches) ]
1438
1439 ppr_cmd (HsCmdIf _ _ e ct ce)
1440 = sep [hsep [text "if", nest 2 (ppr e), ptext (sLit "then")],
1441 nest 4 (ppr ct),
1442 text "else",
1443 nest 4 (ppr ce)]
1444
1445 -- special case: let ... in let ...
1446 ppr_cmd (HsCmdLet _ (L _ binds) cmd@(L _ (HsCmdLet {})))
1447 = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
1448 ppr_lcmd cmd]
1449
1450 ppr_cmd (HsCmdLet _ (L _ binds) cmd)
1451 = sep [hang (text "let") 2 (pprBinds binds),
1452 hang (text "in") 2 (ppr cmd)]
1453
1454 ppr_cmd (HsCmdDo _ (L _ stmts)) = pprDo ArrowExpr stmts
1455
1456 ppr_cmd (HsCmdWrap _ w cmd)
1457 = pprHsWrapper w (\_ -> parens (ppr_cmd cmd))
1458 ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp True)
1459 = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
1460 ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp False)
1461 = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
1462 ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp True)
1463 = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
1464 ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp False)
1465 = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
1466
1467 ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) _ (Just _) [arg1, arg2])
1468 = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v
1469 , pprCmdArg (unLoc arg2)])
1470 ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) Infix _ [arg1, arg2])
1471 = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v
1472 , pprCmdArg (unLoc arg2)])
1473 ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) _ (Just _) [arg1, arg2])
1474 = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)
1475 , pprCmdArg (unLoc arg2)])
1476 ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) Infix _ [arg1, arg2])
1477 = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)
1478 , pprCmdArg (unLoc arg2)])
1479 ppr_cmd (HsCmdArrForm _ op _ _ args)
1480 = hang (text "(|" <+> ppr_lexpr op)
1481 4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")
1482 ppr_cmd (XCmd x) = ppr x
1483
1484 pprCmdArg :: (OutputableBndrId (GhcPass p)) => HsCmdTop (GhcPass p) -> SDoc
1485 pprCmdArg (HsCmdTop _ cmd)
1486 = ppr_lcmd cmd
1487 pprCmdArg (XCmdTop x) = ppr x
1488
1489 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmdTop p) where
1490 ppr = pprCmdArg
1491
1492 {-
1493 ************************************************************************
1494 * *
1495 \subsection{Record binds}
1496 * *
1497 ************************************************************************
1498 -}
1499
1500 -- | Haskell Record Bindings
1501 type HsRecordBinds p = HsRecFields p (LHsExpr p)
1502
1503 {-
1504 ************************************************************************
1505 * *
1506 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
1507 * *
1508 ************************************************************************
1509
1510 @Match@es are sets of pattern bindings and right hand sides for
1511 functions, patterns or case branches. For example, if a function @g@
1512 is defined as:
1513 \begin{verbatim}
1514 g (x,y) = y
1515 g ((x:ys),y) = y+1,
1516 \end{verbatim}
1517 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
1518
1519 It is always the case that each element of an @[Match]@ list has the
1520 same number of @pats@s inside it. This corresponds to saying that
1521 a function defined by pattern matching must have the same number of
1522 patterns in each equation.
1523 -}
1524
1525 data MatchGroup p body
1526 = MG { mg_ext :: XMG p body -- Posr typechecker, types of args and result
1527 , mg_alts :: Located [LMatch p body] -- The alternatives
1528 , mg_origin :: Origin }
1529 -- The type is the type of the entire group
1530 -- t1 -> ... -> tn -> tr
1531 -- where there are n patterns
1532 | XMatchGroup (XXMatchGroup p body)
1533
1534 data MatchGroupTc
1535 = MatchGroupTc
1536 { mg_arg_tys :: [Type] -- Types of the arguments, t1..tn
1537 , mg_res_ty :: Type -- Type of the result, tr
1538 } deriving Data
1539
1540 type instance XMG GhcPs b = NoExt
1541 type instance XMG GhcRn b = NoExt
1542 type instance XMG GhcTc b = MatchGroupTc
1543
1544 type instance XXMatchGroup (GhcPass _) b = NoExt
1545
1546 -- | Located Match
1547 type LMatch id body = Located (Match id body)
1548 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
1549 -- list
1550
1551 -- For details on above see note [Api annotations] in ApiAnnotation
1552 data Match p body
1553 = Match {
1554 m_ext :: XCMatch p body,
1555 m_ctxt :: HsMatchContext (NameOrRdrName (IdP p)),
1556 -- See note [m_ctxt in Match]
1557 m_pats :: [LPat p], -- The patterns
1558 m_grhss :: (GRHSs p body)
1559 }
1560 | XMatch (XXMatch p body)
1561
1562 type instance XCMatch (GhcPass _) b = NoExt
1563 type instance XXMatch (GhcPass _) b = NoExt
1564
1565 instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)
1566 => Outputable (Match idR body) where
1567 ppr = pprMatch
1568
1569 {-
1570 Note [m_ctxt in Match]
1571 ~~~~~~~~~~~~~~~~~~~~~~
1572
1573 A Match can occur in a number of contexts, such as a FunBind, HsCase, HsLam and
1574 so on.
1575
1576 In order to simplify tooling processing and pretty print output, the provenance
1577 is captured in an HsMatchContext.
1578
1579 This is particularly important for the API Annotations for a multi-equation
1580 FunBind.
1581
1582 The parser initially creates a FunBind with a single Match in it for
1583 every function definition it sees.
1584
1585 These are then grouped together by getMonoBind into a single FunBind,
1586 where all the Matches are combined.
1587
1588 In the process, all the original FunBind fun_id's bar one are
1589 discarded, including the locations.
1590
1591 This causes a problem for source to source conversions via API
1592 Annotations, so the original fun_ids and infix flags are preserved in
1593 the Match, when it originates from a FunBind.
1594
1595 Example infix function definition requiring individual API Annotations
1596
1597 (&&& ) [] [] = []
1598 xs &&& [] = xs
1599 ( &&& ) [] ys = ys
1600
1601
1602
1603 -}
1604
1605
1606 isInfixMatch :: Match id body -> Bool
1607 isInfixMatch match = case m_ctxt match of
1608 FunRhs {mc_fixity = Infix} -> True
1609 _ -> False
1610
1611 isEmptyMatchGroup :: MatchGroup id body -> Bool
1612 isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
1613 isEmptyMatchGroup (XMatchGroup{}) = panic "isEmptyMatchGroup"
1614
1615 -- | Is there only one RHS in this list of matches?
1616 isSingletonMatchGroup :: [LMatch id body] -> Bool
1617 isSingletonMatchGroup matches
1618 | [L _ match] <- matches
1619 , Match { m_grhss = GRHSs { grhssGRHSs = [_] } } <- match
1620 = True
1621 | otherwise
1622 = False
1623
1624 matchGroupArity :: MatchGroup id body -> Arity
1625 -- Precondition: MatchGroup is non-empty
1626 -- This is called before type checking, when mg_arg_tys is not set
1627 matchGroupArity (MG { mg_alts = alts })
1628 | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
1629 | otherwise = panic "matchGroupArity"
1630 matchGroupArity (XMatchGroup{}) = panic "matchGroupArity"
1631
1632 hsLMatchPats :: LMatch id body -> [LPat id]
1633 hsLMatchPats (L _ (Match { m_pats = pats })) = pats
1634 hsLMatchPats (L _ (XMatch _)) = panic "hsLMatchPats"
1635
1636 -- | Guarded Right-Hand Sides
1637 --
1638 -- GRHSs are used both for pattern bindings and for Matches
1639 --
1640 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
1641 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
1642 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1643 -- 'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
1644
1645 -- For details on above see note [Api annotations] in ApiAnnotation
1646 data GRHSs p body
1647 = GRHSs {
1648 grhssExt :: XCGRHSs p body,
1649 grhssGRHSs :: [LGRHS p body], -- ^ Guarded RHSs
1650 grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause
1651 }
1652 | XGRHSs (XXGRHSs p body)
1653
1654 type instance XCGRHSs (GhcPass _) b = NoExt
1655 type instance XXGRHSs (GhcPass _) b = NoExt
1656
1657 -- | Located Guarded Right-Hand Side
1658 type LGRHS id body = Located (GRHS id body)
1659
1660 -- | Guarded Right Hand Side.
1661 data GRHS p body = GRHS (XCGRHS p body)
1662 [GuardLStmt p] -- Guards
1663 body -- Right hand side
1664 | XGRHS (XXGRHS p body)
1665
1666 type instance XCGRHS (GhcPass _) b = NoExt
1667 type instance XXGRHS (GhcPass _) b = NoExt
1668
1669 -- We know the list must have at least one @Match@ in it.
1670
1671 pprMatches :: (OutputableBndrId (GhcPass idR), Outputable body)
1672 => MatchGroup (GhcPass idR) body -> SDoc
1673 pprMatches MG { mg_alts = matches }
1674 = vcat (map pprMatch (map unLoc (unLoc matches)))
1675 -- Don't print the type; it's only a place-holder before typechecking
1676 pprMatches (XMatchGroup x) = ppr x
1677
1678 -- Exported to HsBinds, which can't see the defn of HsMatchContext
1679 pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)
1680 => MatchGroup (GhcPass idR) body -> SDoc
1681 pprFunBind matches = pprMatches matches
1682
1683 -- Exported to HsBinds, which can't see the defn of HsMatchContext
1684 pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),
1685 OutputableBndrId (GhcPass p),
1686 Outputable body)
1687 => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
1688 pprPatBind pat (grhss)
1689 = sep [ppr pat,
1690 nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP (GhcPass p))) grhss)]
1691
1692 pprMatch :: (OutputableBndrId (GhcPass idR), Outputable body)
1693 => Match (GhcPass idR) body -> SDoc
1694 pprMatch match
1695 = sep [ sep (herald : map (nest 2 . pprParendLPat appPrec) other_pats)
1696 , nest 2 (pprGRHSs ctxt (m_grhss match)) ]
1697 where
1698 ctxt = m_ctxt match
1699 (herald, other_pats)
1700 = case ctxt of
1701 FunRhs {mc_fun=L _ fun, mc_fixity=fixity, mc_strictness=strictness}
1702 | strictness == SrcStrict -> ASSERT(null $ m_pats match)
1703 (char '!'<>pprPrefixOcc fun, m_pats match)
1704 -- a strict variable binding
1705 | fixity == Prefix -> (pprPrefixOcc fun, m_pats match)
1706 -- f x y z = e
1707 -- Not pprBndr; the AbsBinds will
1708 -- have printed the signature
1709
1710 | null pats2 -> (pp_infix, [])
1711 -- x &&& y = e
1712
1713 | otherwise -> (parens pp_infix, pats2)
1714 -- (x &&& y) z = e
1715 where
1716 pp_infix = pprParendLPat opPrec pat1
1717 <+> pprInfixOcc fun
1718 <+> pprParendLPat opPrec pat2
1719
1720 LambdaExpr -> (char '\\', m_pats match)
1721
1722 _ -> if null (m_pats match)
1723 then (empty, [])
1724 else ASSERT2( null pats1, ppr ctxt $$ ppr pat1 $$ ppr pats1 )
1725 (ppr pat1, []) -- No parens around the single pat
1726
1727 (pat1:pats1) = m_pats match
1728 (pat2:pats2) = pats1
1729
1730 pprGRHSs :: (OutputableBndrId (GhcPass idR), Outputable body)
1731 => HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc
1732 pprGRHSs ctxt (GRHSs _ grhss (L _ binds))
1733 = vcat (map (pprGRHS ctxt . unLoc) grhss)
1734 -- Print the "where" even if the contents of the binds is empty. Only
1735 -- EmptyLocalBinds means no "where" keyword
1736 $$ ppUnless (eqEmptyLocalBinds binds)
1737 (text "where" $$ nest 4 (pprBinds binds))
1738 pprGRHSs _ (XGRHSs x) = ppr x
1739
1740 pprGRHS :: (OutputableBndrId (GhcPass idR), Outputable body)
1741 => HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc
1742 pprGRHS ctxt (GRHS _ [] body)
1743 = pp_rhs ctxt body
1744
1745 pprGRHS ctxt (GRHS _ guards body)
1746 = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body]
1747
1748 pprGRHS _ (XGRHS x) = ppr x
1749
1750 pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc
1751 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
1752
1753 {-
1754 ************************************************************************
1755 * *
1756 \subsection{Do stmts and list comprehensions}
1757 * *
1758 ************************************************************************
1759 -}
1760
1761 -- | Located @do@ block Statement
1762 type LStmt id body = Located (StmtLR id id body)
1763
1764 -- | Located Statement with separate Left and Right id's
1765 type LStmtLR idL idR body = Located (StmtLR idL idR body)
1766
1767 -- | @do@ block Statement
1768 type Stmt id body = StmtLR id id body
1769
1770 -- | Command Located Statement
1771 type CmdLStmt id = LStmt id (LHsCmd id)
1772
1773 -- | Command Statement
1774 type CmdStmt id = Stmt id (LHsCmd id)
1775
1776 -- | Expression Located Statement
1777 type ExprLStmt id = LStmt id (LHsExpr id)
1778
1779 -- | Expression Statement
1780 type ExprStmt id = Stmt id (LHsExpr id)
1781
1782 -- | Guard Located Statement
1783 type GuardLStmt id = LStmt id (LHsExpr id)
1784
1785 -- | Guard Statement
1786 type GuardStmt id = Stmt id (LHsExpr id)
1787
1788 -- | Ghci Located Statement
1789 type GhciLStmt id = LStmt id (LHsExpr id)
1790
1791 -- | Ghci Statement
1792 type GhciStmt id = Stmt id (LHsExpr id)
1793
1794 -- The SyntaxExprs in here are used *only* for do-notation and monad
1795 -- comprehensions, which have rebindable syntax. Otherwise they are unused.
1796 -- | API Annotations when in qualifier lists or guards
1797 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
1798 -- 'ApiAnnotation.AnnComma','ApiAnnotation.AnnThen',
1799 -- 'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',
1800 -- 'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'
1801
1802 -- For details on above see note [Api annotations] in ApiAnnotation
1803 data StmtLR idL idR body -- body should always be (LHs**** idR)
1804 = LastStmt -- Always the last Stmt in ListComp, MonadComp,
1805 -- and (after the renamer, see RnExpr.checkLastStmt) DoExpr, MDoExpr
1806 -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff
1807 (XLastStmt idL idR body)
1808 body
1809 Bool -- True <=> return was stripped by ApplicativeDo
1810 (SyntaxExpr idR) -- The return operator
1811 -- The return operator is used only for MonadComp
1812 -- For ListComp we use the baked-in 'return'
1813 -- For DoExpr, MDoExpr, we don't apply a 'return' at all
1814 -- See Note [Monad Comprehensions]
1815 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'
1816
1817 -- For details on above see note [Api annotations] in ApiAnnotation
1818 | BindStmt (XBindStmt idL idR body) -- Post typechecking,
1819 -- result type of the function passed to bind;
1820 -- that is, S in (>>=) :: Q -> (R -> S) -> T
1821 (LPat idL)
1822 body
1823 (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts]
1824 (SyntaxExpr idR) -- The fail operator
1825 -- The fail operator is noSyntaxExpr
1826 -- if the pattern match can't fail
1827
1828 -- | 'ApplicativeStmt' represents an applicative expression built with
1829 -- '<$>' and '<*>'. It is generated by the renamer, and is desugared into the
1830 -- appropriate applicative expression by the desugarer, but it is intended
1831 -- to be invisible in error messages.
1832 --
1833 -- For full details, see Note [ApplicativeDo] in RnExpr
1834 --
1835 | ApplicativeStmt
1836 (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body
1837 [ ( SyntaxExpr idR
1838 , ApplicativeArg idL) ]
1839 -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]
1840 (Maybe (SyntaxExpr idR)) -- 'join', if necessary
1841
1842 | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type
1843 -- of the RHS (used for arrows)
1844 body -- See Note [BodyStmt]
1845 (SyntaxExpr idR) -- The (>>) operator
1846 (SyntaxExpr idR) -- The `guard` operator; used only in MonadComp
1847 -- See notes [Monad Comprehensions]
1848
1849 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'
1850 -- 'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,
1851
1852 -- For details on above see note [Api annotations] in ApiAnnotation
1853 | LetStmt (XLetStmt idL idR body) (LHsLocalBindsLR idL idR)
1854
1855 -- ParStmts only occur in a list/monad comprehension
1856 | ParStmt (XParStmt idL idR body) -- Post typecheck,
1857 -- S in (>>=) :: Q -> (R -> S) -> T
1858 [ParStmtBlock idL idR]
1859 (HsExpr idR) -- Polymorphic `mzip` for monad comprehensions
1860 (SyntaxExpr idR) -- The `>>=` operator
1861 -- See notes [Monad Comprehensions]
1862 -- After renaming, the ids are the binders
1863 -- bound by the stmts and used after themp
1864
1865 | TransStmt {
1866 trS_ext :: XTransStmt idL idR body, -- Post typecheck,
1867 -- R in (>>=) :: Q -> (R -> S) -> T
1868 trS_form :: TransForm,
1869 trS_stmts :: [ExprLStmt idL], -- Stmts to the *left* of the 'group'
1870 -- which generates the tuples to be grouped
1871
1872 trS_bndrs :: [(IdP idR, IdP idR)], -- See Note [TransStmt binder map]
1873
1874 trS_using :: LHsExpr idR,
1875 trS_by :: Maybe (LHsExpr idR), -- "by e" (optional)
1876 -- Invariant: if trS_form = GroupBy, then grp_by = Just e
1877
1878 trS_ret :: SyntaxExpr idR, -- The monomorphic 'return' function for
1879 -- the inner monad comprehensions
1880 trS_bind :: SyntaxExpr idR, -- The '(>>=)' operator
1881 trS_fmap :: HsExpr idR -- The polymorphic 'fmap' function for desugaring
1882 -- Only for 'group' forms
1883 -- Just a simple HsExpr, because it's
1884 -- too polymorphic for tcSyntaxOp
1885 } -- See Note [Monad Comprehensions]
1886
1887 -- Recursive statement (see Note [How RecStmt works] below)
1888 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'
1889
1890 -- For details on above see note [Api annotations] in ApiAnnotation
1891 | RecStmt
1892 { recS_ext :: XRecStmt idL idR body
1893 , recS_stmts :: [LStmtLR idL idR body]
1894
1895 -- The next two fields are only valid after renaming
1896 , recS_later_ids :: [IdP idR]
1897 -- The ids are a subset of the variables bound by the
1898 -- stmts that are used in stmts that follow the RecStmt
1899
1900 , recS_rec_ids :: [IdP idR]
1901 -- Ditto, but these variables are the "recursive" ones,
1902 -- that are used before they are bound in the stmts of
1903 -- the RecStmt.
1904 -- An Id can be in both groups
1905 -- Both sets of Ids are (now) treated monomorphically
1906 -- See Note [How RecStmt works] for why they are separate
1907
1908 -- Rebindable syntax
1909 , recS_bind_fn :: SyntaxExpr idR -- The bind function
1910 , recS_ret_fn :: SyntaxExpr idR -- The return function
1911 , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
1912 }
1913 | XStmtLR (XXStmtLR idL idR body)
1914
1915 -- Extra fields available post typechecking for RecStmt.
1916 data RecStmtTc =
1917 RecStmtTc
1918 { recS_bind_ty :: Type -- S in (>>=) :: Q -> (R -> S) -> T
1919 , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)
1920 , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1
1921 -- with recS_later_ids and recS_rec_ids,
1922 -- and are the expressions that should be
1923 -- returned by the recursion.
1924 -- They may not quite be the Ids themselves,
1925 -- because the Id may be *polymorphic*, but
1926 -- the returned thing has to be *monomorphic*,
1927 -- so they may be type applications
1928
1929 , recS_ret_ty :: Type -- The type of
1930 -- do { stmts; return (a,b,c) }
1931 -- With rebindable syntax the type might not
1932 -- be quite as simple as (m (tya, tyb, tyc)).
1933 }
1934
1935
1936 type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExt
1937
1938 type instance XBindStmt (GhcPass _) GhcPs b = NoExt
1939 type instance XBindStmt (GhcPass _) GhcRn b = NoExt
1940 type instance XBindStmt (GhcPass _) GhcTc b = Type
1941
1942 type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt
1943 type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt
1944 type instance XApplicativeStmt (GhcPass _) GhcTc b = Type
1945
1946 type instance XBodyStmt (GhcPass _) GhcPs b = NoExt
1947 type instance XBodyStmt (GhcPass _) GhcRn b = NoExt
1948 type instance XBodyStmt (GhcPass _) GhcTc b = Type
1949
1950 type instance XLetStmt (GhcPass _) (GhcPass _) b = NoExt
1951
1952 type instance XParStmt (GhcPass _) GhcPs b = NoExt
1953 type instance XParStmt (GhcPass _) GhcRn b = NoExt
1954 type instance XParStmt (GhcPass _) GhcTc b = Type
1955
1956 type instance XTransStmt (GhcPass _) GhcPs b = NoExt
1957 type instance XTransStmt (GhcPass _) GhcRn b = NoExt
1958 type instance XTransStmt (GhcPass _) GhcTc b = Type
1959
1960 type instance XRecStmt (GhcPass _) GhcPs b = NoExt
1961 type instance XRecStmt (GhcPass _) GhcRn b = NoExt
1962 type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc
1963
1964 type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExt
1965
1966 data TransForm -- The 'f' below is the 'using' function, 'e' is the by function
1967 = ThenForm -- then f or then f by e (depending on trS_by)
1968 | GroupForm -- then group using f or then group by e using f (depending on trS_by)
1969 deriving Data
1970
1971 -- | Parenthesised Statement Block
1972 data ParStmtBlock idL idR
1973 = ParStmtBlock
1974 (XParStmtBlock idL idR)
1975 [ExprLStmt idL]
1976 [IdP idR] -- The variables to be returned
1977 (SyntaxExpr idR) -- The return operator
1978 | XParStmtBlock (XXParStmtBlock idL idR)
1979
1980 type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
1981 type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
1982
1983 -- | Applicative Argument
1984 data ApplicativeArg idL
1985 = ApplicativeArgOne -- A single statement (BindStmt or BodyStmt)
1986 (XApplicativeArgOne idL)
1987 (LPat idL) -- WildPat if it was a BodyStmt (see below)
1988 (LHsExpr idL)
1989 Bool -- True <=> was a BodyStmt
1990 -- False <=> was a BindStmt
1991 -- See Note [Applicative BodyStmt]
1992
1993 | ApplicativeArgMany -- do { stmts; return vars }
1994 (XApplicativeArgMany idL)
1995 [ExprLStmt idL] -- stmts
1996 (HsExpr idL) -- return (v1,..,vn), or just (v1,..,vn)
1997 (LPat idL) -- (v1,...,vn)
1998 | XApplicativeArg (XXApplicativeArg idL)
1999
2000 type instance XApplicativeArgOne (GhcPass _) = NoExt
2001 type instance XApplicativeArgMany (GhcPass _) = NoExt
2002 type instance XXApplicativeArg (GhcPass _) = NoExt
2003
2004 {-
2005 Note [The type of bind in Stmts]
2006 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2007 Some Stmts, notably BindStmt, keep the (>>=) bind operator.
2008 We do NOT assume that it has type
2009 (>>=) :: m a -> (a -> m b) -> m b
2010 In some cases (see #303, #1537) it might have a more
2011 exotic type, such as
2012 (>>=) :: m i j a -> (a -> m j k b) -> m i k b
2013 So we must be careful not to make assumptions about the type.
2014 In particular, the monad may not be uniform throughout.
2015
2016 Note [TransStmt binder map]
2017 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
2018 The [(idR,idR)] in a TransStmt behaves as follows:
2019
2020 * Before renaming: []
2021
2022 * After renaming:
2023 [ (x27,x27), ..., (z35,z35) ]
2024 These are the variables
2025 bound by the stmts to the left of the 'group'
2026 and used either in the 'by' clause,
2027 or in the stmts following the 'group'
2028 Each item is a pair of identical variables.
2029
2030 * After typechecking:
2031 [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]
2032 Each pair has the same unique, but different *types*.
2033
2034 Note [BodyStmt]
2035 ~~~~~~~~~~~~~~~
2036 BodyStmts are a bit tricky, because what they mean
2037 depends on the context. Consider the following contexts:
2038
2039 A do expression of type (m res_ty)
2040 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2041 * BodyStmt E any_ty: do { ....; E; ... }
2042 E :: m any_ty
2043 Translation: E >> ...
2044
2045 A list comprehensions of type [elt_ty]
2046 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2047 * BodyStmt E Bool: [ .. | .... E ]
2048 [ .. | ..., E, ... ]
2049 [ .. | .... | ..., E | ... ]
2050 E :: Bool
2051 Translation: if E then fail else ...
2052
2053 A guard list, guarding a RHS of type rhs_ty
2054 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2055 * BodyStmt E BooParStmtBlockl: f x | ..., E, ... = ...rhs...
2056 E :: Bool
2057 Translation: if E then fail else ...
2058
2059 A monad comprehension of type (m res_ty)
2060 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2061 * BodyStmt E Bool: [ .. | .... E ]
2062 E :: Bool
2063 Translation: guard E >> ...
2064
2065 Array comprehensions are handled like list comprehensions.
2066
2067 Note [How RecStmt works]
2068 ~~~~~~~~~~~~~~~~~~~~~~~~
2069 Example:
2070 HsDo [ BindStmt x ex
2071
2072 , RecStmt { recS_rec_ids = [a, c]
2073 , recS_stmts = [ BindStmt b (return (a,c))
2074 , LetStmt a = ...b...
2075 , BindStmt c ec ]
2076 , recS_later_ids = [a, b]
2077
2078 , return (a b) ]
2079
2080 Here, the RecStmt binds a,b,c; but
2081 - Only a,b are used in the stmts *following* the RecStmt,
2082 - Only a,c are used in the stmts *inside* the RecStmt
2083 *before* their bindings
2084
2085 Why do we need *both* rec_ids and later_ids? For monads they could be
2086 combined into a single set of variables, but not for arrows. That
2087 follows from the types of the respective feedback operators:
2088
2089 mfix :: MonadFix m => (a -> m a) -> m a
2090 loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
2091
2092 * For mfix, the 'a' covers the union of the later_ids and the rec_ids
2093 * For 'loop', 'c' is the later_ids and 'd' is the rec_ids
2094
2095 Note [Typing a RecStmt]
2096 ~~~~~~~~~~~~~~~~~~~~~~~
2097 A (RecStmt stmts) types as if you had written
2098
2099 (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->
2100 do { stmts
2101 ; return (v1,..vn, r1, ..., rm) })
2102
2103 where v1..vn are the later_ids
2104 r1..rm are the rec_ids
2105
2106 Note [Monad Comprehensions]
2107 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
2108 Monad comprehensions require separate functions like 'return' and
2109 '>>=' for desugaring. These functions are stored in the statements
2110 used in monad comprehensions. For example, the 'return' of the 'LastStmt'
2111 expression is used to lift the body of the monad comprehension:
2112
2113 [ body | stmts ]
2114 =>
2115 stmts >>= \bndrs -> return body
2116
2117 In transform and grouping statements ('then ..' and 'then group ..') the
2118 'return' function is required for nested monad comprehensions, for example:
2119
2120 [ body | stmts, then f, rest ]
2121 =>
2122 f [ env | stmts ] >>= \bndrs -> [ body | rest ]
2123
2124 BodyStmts require the 'Control.Monad.guard' function for boolean
2125 expressions:
2126
2127 [ body | exp, stmts ]
2128 =>
2129 guard exp >> [ body | stmts ]
2130
2131 Parallel statements require the 'Control.Monad.Zip.mzip' function:
2132
2133 [ body | stmts1 | stmts2 | .. ]
2134 =>
2135 mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body
2136
2137 In any other context than 'MonadComp', the fields for most of these
2138 'SyntaxExpr's stay bottom.
2139
2140
2141 Note [Applicative BodyStmt]
2142
2143 (#12143) For the purposes of ApplicativeDo, we treat any BodyStmt
2144 as if it was a BindStmt with a wildcard pattern. For example,
2145
2146 do
2147 x <- A
2148 B
2149 return x
2150
2151 is transformed as if it were
2152
2153 do
2154 x <- A
2155 _ <- B
2156 return x
2157
2158 so it transforms to
2159
2160 (\(x,_) -> x) <$> A <*> B
2161
2162 But we have to remember when we treat a BodyStmt like a BindStmt,
2163 because in error messages we want to emit the original syntax the user
2164 wrote, not our internal representation. So ApplicativeArgOne has a
2165 Bool flag that is True when the original statement was a BodyStmt, so
2166 that we can pretty-print it correctly.
2167 -}
2168
2169 instance (Outputable (StmtLR idL idL (LHsExpr idL)),
2170 Outputable (XXParStmtBlock idL idR))
2171 => Outputable (ParStmtBlock idL idR) where
2172 ppr (ParStmtBlock _ stmts _ _) = interpp'SP stmts
2173 ppr (XParStmtBlock x) = ppr x
2174
2175 instance (idL ~ GhcPass pl,idR ~ GhcPass pr,
2176 OutputableBndrId idL, OutputableBndrId idR,
2177 Outputable body)
2178 => Outputable (StmtLR idL idR body) where
2179 ppr stmt = pprStmt stmt
2180
2181 pprStmt :: forall idL idR body . (OutputableBndrId (GhcPass idL),
2182 OutputableBndrId (GhcPass idR),
2183 Outputable body)
2184 => (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc
2185 pprStmt (LastStmt _ expr ret_stripped _)
2186 = whenPprDebug (text "[last]") <+>
2187 (if ret_stripped then text "return" else empty) <+>
2188 ppr expr
2189 pprStmt (BindStmt _ pat expr _ _) = hsep [ppr pat, larrow, ppr expr]
2190 pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds]
2191 pprStmt (BodyStmt _ expr _ _) = ppr expr
2192 pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss))
2193
2194 pprStmt (TransStmt { trS_stmts = stmts, trS_by = by
2195 , trS_using = using, trS_form = form })
2196 = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])
2197
2198 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
2199 , recS_later_ids = later_ids })
2200 = text "rec" <+>
2201 vcat [ ppr_do_stmts segment
2202 , whenPprDebug (vcat [ text "rec_ids=" <> ppr rec_ids
2203 , text "later_ids=" <> ppr later_ids])]
2204
2205 pprStmt (ApplicativeStmt _ args mb_join)
2206 = getPprStyle $ \style ->
2207 if userStyle style
2208 then pp_for_user
2209 else pp_debug
2210 where
2211 -- make all the Applicative stuff invisible in error messages by
2212 -- flattening the whole ApplicativeStmt nest back to a sequence
2213 -- of statements.
2214 pp_for_user = vcat $ concatMap flattenArg args
2215
2216 -- ppr directly rather than transforming here, because we need to
2217 -- inject a "return" which is hard when we're polymorphic in the id
2218 -- type.
2219 flattenStmt :: ExprLStmt (GhcPass idL) -> [SDoc]
2220 flattenStmt (L _ (ApplicativeStmt _ args _)) = concatMap flattenArg args
2221 flattenStmt stmt = [ppr stmt]
2222
2223 flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc]
2224 flattenArg (_, ApplicativeArgOne _ pat expr isBody)
2225 | isBody = -- See Note [Applicative BodyStmt]
2226 [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
2227 :: ExprStmt (GhcPass idL))]
2228 | otherwise =
2229 [ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
2230 :: ExprStmt (GhcPass idL))]
2231 flattenArg (_, ApplicativeArgMany _ stmts _ _) =
2232 concatMap flattenStmt stmts
2233 flattenArg (_, XApplicativeArg _) = panic "flattenArg"
2234
2235 pp_debug =
2236 let
2237 ap_expr = sep (punctuate (text " |") (map pp_arg args))
2238 in
2239 if isNothing mb_join
2240 then ap_expr
2241 else text "join" <+> parens ap_expr
2242
2243 pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc
2244 pp_arg (_, ApplicativeArgOne _ pat expr isBody)
2245 | isBody = -- See Note [Applicative BodyStmt]
2246 ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
2247 :: ExprStmt (GhcPass idL))
2248 | otherwise =
2249 ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
2250 :: ExprStmt (GhcPass idL))
2251 pp_arg (_, ApplicativeArgMany _ stmts return pat) =
2252 ppr pat <+>
2253 text "<-" <+>
2254 ppr (HsDo (panic "pprStmt") DoExpr (noLoc
2255 (stmts ++
2256 [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)])))
2257 pp_arg (_, XApplicativeArg x) = ppr x
2258
2259 pprStmt (XStmtLR x) = ppr x
2260
2261 pprTransformStmt :: (OutputableBndrId (GhcPass p))
2262 => [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
2263 -> Maybe (LHsExpr (GhcPass p)) -> SDoc
2264 pprTransformStmt bndrs using by
2265 = sep [ text "then" <+> whenPprDebug (braces (ppr bndrs))
2266 , nest 2 (ppr using)
2267 , nest 2 (pprBy by)]
2268
2269 pprTransStmt :: Outputable body => Maybe body -> body -> TransForm -> SDoc
2270 pprTransStmt by using ThenForm
2271 = sep [ text "then", nest 2 (ppr using), nest 2 (pprBy by)]
2272 pprTransStmt by using GroupForm
2273 = sep [ text "then group", nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]
2274
2275 pprBy :: Outputable body => Maybe body -> SDoc
2276 pprBy Nothing = empty
2277 pprBy (Just e) = text "by" <+> ppr e
2278
2279 pprDo :: (OutputableBndrId (GhcPass p), Outputable body)
2280 => HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc
2281 pprDo DoExpr stmts = text "do" <+> ppr_do_stmts stmts
2282 pprDo GhciStmtCtxt stmts = text "do" <+> ppr_do_stmts stmts
2283 pprDo ArrowExpr stmts = text "do" <+> ppr_do_stmts stmts
2284 pprDo MDoExpr stmts = text "mdo" <+> ppr_do_stmts stmts
2285 pprDo ListComp stmts = brackets $ pprComp stmts
2286 pprDo MonadComp stmts = brackets $ pprComp stmts
2287 pprDo _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
2288
2289 ppr_do_stmts :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR),
2290 Outputable body)
2291 => [LStmtLR (GhcPass idL) (GhcPass idR) body] -> SDoc
2292 -- Print a bunch of do stmts
2293 ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)
2294
2295 pprComp :: (OutputableBndrId (GhcPass p), Outputable body)
2296 => [LStmt (GhcPass p) body] -> SDoc
2297 pprComp quals -- Prints: body | qual1, ..., qualn
2298 | Just (initStmts, L _ (LastStmt _ body _ _)) <- snocView quals
2299 = if null initStmts
2300 -- If there are no statements in a list comprehension besides the last
2301 -- one, we simply treat it like a normal list. This does arise
2302 -- occasionally in code that GHC generates, e.g., in implementations of
2303 -- 'range' for derived 'Ix' instances for product datatypes with exactly
2304 -- one constructor (e.g., see #12583).
2305 then ppr body
2306 else hang (ppr body <+> vbar) 2 (pprQuals initStmts)
2307 | otherwise
2308 = pprPanic "pprComp" (pprQuals quals)
2309
2310 pprQuals :: (OutputableBndrId (GhcPass p), Outputable body)
2311 => [LStmt (GhcPass p) body] -> SDoc
2312 -- Show list comprehension qualifiers separated by commas
2313 pprQuals quals = interpp'SP quals
2314
2315 {-
2316 ************************************************************************
2317 * *
2318 Template Haskell quotation brackets
2319 * *
2320 ************************************************************************
2321 -}
2322
2323 -- | Haskell Splice
2324 data HsSplice id
2325 = HsTypedSplice -- $$z or $$(f 4)
2326 (XTypedSplice id)
2327 SpliceDecoration -- Whether $$( ) variant found, for pretty printing
2328 (IdP id) -- A unique name to identify this splice point
2329 (LHsExpr id) -- See Note [Pending Splices]
2330
2331 | HsUntypedSplice -- $z or $(f 4)
2332 (XUntypedSplice id)
2333 SpliceDecoration -- Whether $( ) variant found, for pretty printing
2334 (IdP id) -- A unique name to identify this splice point
2335 (LHsExpr id) -- See Note [Pending Splices]
2336
2337 | HsQuasiQuote -- See Note [Quasi-quote overview] in TcSplice
2338 (XQuasiQuote id)
2339 (IdP id) -- Splice point
2340 (IdP id) -- Quoter
2341 SrcSpan -- The span of the enclosed string
2342 FastString -- The enclosed string
2343
2344 -- AZ:TODO: use XSplice instead of HsSpliced
2345 | HsSpliced -- See Note [Delaying modFinalizers in untyped splices] in
2346 -- RnSplice.
2347 -- This is the result of splicing a splice. It is produced by
2348 -- the renamer and consumed by the typechecker. It lives only
2349 -- between the two.
2350 (XSpliced id)
2351 ThModFinalizers -- TH finalizers produced by the splice.
2352 (HsSplicedThing id) -- The result of splicing
2353 | HsSplicedT
2354 DelayedSplice
2355 | XSplice (XXSplice id) -- Note [Trees that Grow] extension point
2356
2357 type instance XTypedSplice (GhcPass _) = NoExt
2358 type instance XUntypedSplice (GhcPass _) = NoExt
2359 type instance XQuasiQuote (GhcPass _) = NoExt
2360 type instance XSpliced (GhcPass _) = NoExt
2361 type instance XXSplice (GhcPass _) = NoExt
2362
2363 -- | A splice can appear with various decorations wrapped around it. This data
2364 -- type captures explicitly how it was originally written, for use in the pretty
2365 -- printer.
2366 data SpliceDecoration
2367 = HasParens -- ^ $( splice ) or $$( splice )
2368 | HasDollar -- ^ $splice or $$splice
2369 | NoParens -- ^ bare splice
2370 deriving (Data, Eq, Show)
2371
2372 instance Outputable SpliceDecoration where
2373 ppr x = text $ show x
2374
2375
2376 isTypedSplice :: HsSplice id -> Bool
2377 isTypedSplice (HsTypedSplice {}) = True
2378 isTypedSplice _ = False -- Quasi-quotes are untyped splices
2379
2380 -- | Finalizers produced by a splice with
2381 -- 'Language.Haskell.TH.Syntax.addModFinalizer'
2382 --
2383 -- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how
2384 -- this is used.
2385 --
2386 newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())]
2387
2388 -- A Data instance which ignores the argument of 'ThModFinalizers'.
2389 instance Data ThModFinalizers where
2390 gunfold _ z _ = z $ ThModFinalizers []
2391 toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix
2392 dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a]
2393
2394 -- See Note [Running typed splices in the zonker]
2395 -- These are the arguments that are passed to `TcSplice.runTopSplice`
2396 data DelayedSplice =
2397 DelayedSplice
2398 TcLclEnv -- The local environment to run the splice in
2399 (LHsExpr GhcRn) -- The original renamed expression
2400 TcType -- The result type of running the splice, unzonked
2401 (LHsExpr GhcTcId) -- The typechecked expression to run and splice in the result
2402
2403 -- A Data instance which ignores the argument of 'DelayedSplice'.
2404 instance Data DelayedSplice where
2405 gunfold _ _ _ = panic "DelayedSplice"
2406 toConstr a = mkConstr (dataTypeOf a) "DelayedSplice" [] Data.Prefix
2407 dataTypeOf a = mkDataType "HsExpr.DelayedSplice" [toConstr a]
2408
2409 -- | Haskell Spliced Thing
2410 --
2411 -- Values that can result from running a splice.
2412 data HsSplicedThing id
2413 = HsSplicedExpr (HsExpr id) -- ^ Haskell Spliced Expression
2414 | HsSplicedTy (HsType id) -- ^ Haskell Spliced Type
2415 | HsSplicedPat (Pat id) -- ^ Haskell Spliced Pattern
2416
2417
2418 -- See Note [Pending Splices]
2419 type SplicePointName = Name
2420
2421 -- | Pending Renamer Splice
2422 data PendingRnSplice
2423 = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn)
2424
2425 data UntypedSpliceFlavour
2426 = UntypedExpSplice
2427 | UntypedPatSplice
2428 | UntypedTypeSplice
2429 | UntypedDeclSplice
2430 deriving Data
2431
2432 -- | Pending Type-checker Splice
2433 data PendingTcSplice
2434 = PendingTcSplice SplicePointName (LHsExpr GhcTc)
2435
2436 {-
2437 Note [Pending Splices]
2438 ~~~~~~~~~~~~~~~~~~~~~~
2439 When we rename an untyped bracket, we name and lift out all the nested
2440 splices, so that when the typechecker hits the bracket, it can
2441 typecheck those nested splices without having to walk over the untyped
2442 bracket code. So for example
2443 [| f $(g x) |]
2444 looks like
2445
2446 HsBracket (HsApp (HsVar "f") (HsSpliceE _ (g x)))
2447
2448 which the renamer rewrites to
2449
2450 HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))
2451 [PendingRnSplice UntypedExpSplice sn (g x)]
2452
2453 * The 'sn' is the Name of the splice point, the SplicePointName
2454
2455 * The PendingRnExpSplice gives the splice that splice-point name maps to;
2456 and the typechecker can now conveniently find these sub-expressions
2457
2458 * The other copy of the splice, in the second argument of HsSpliceE
2459 in the renamed first arg of HsRnBracketOut
2460 is used only for pretty printing
2461
2462 There are four varieties of pending splices generated by the renamer,
2463 distinguished by their UntypedSpliceFlavour
2464
2465 * Pending expression splices (UntypedExpSplice), e.g.,
2466 [|$(f x) + 2|]
2467
2468 UntypedExpSplice is also used for
2469 * quasi-quotes, where the pending expression expands to
2470 $(quoter "...blah...")
2471 (see RnSplice.makePending, HsQuasiQuote case)
2472
2473 * cross-stage lifting, where the pending expression expands to
2474 $(lift x)
2475 (see RnSplice.checkCrossStageLifting)
2476
2477 * Pending pattern splices (UntypedPatSplice), e.g.,
2478 [| \$(f x) -> x |]
2479
2480 * Pending type splices (UntypedTypeSplice), e.g.,
2481 [| f :: $(g x) |]
2482
2483 * Pending declaration (UntypedDeclSplice), e.g.,
2484 [| let $(f x) in ... |]
2485
2486 There is a fifth variety of pending splice, which is generated by the type
2487 checker:
2488
2489 * Pending *typed* expression splices, (PendingTcSplice), e.g.,
2490 [||1 + $$(f 2)||]
2491
2492 It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
2493 output of the renamer. However, when pretty printing the output of the renamer,
2494 e.g., in a type error message, we *do not* want to print out the pending
2495 splices. In contrast, when pretty printing the output of the type checker, we
2496 *do* want to print the pending splices. So splitting them up seems to make
2497 sense, although I hate to add another constructor to HsExpr.
2498 -}
2499
2500 instance (p ~ GhcPass pass, OutputableBndrId p)
2501 => Outputable (HsSplicedThing p) where
2502 ppr (HsSplicedExpr e) = ppr_expr e
2503 ppr (HsSplicedTy t) = ppr t
2504 ppr (HsSplicedPat p) = ppr p
2505
2506 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsSplice p) where
2507 ppr s = pprSplice s
2508
2509 pprPendingSplice :: (OutputableBndrId (GhcPass p))
2510 => SplicePointName -> LHsExpr (GhcPass p) -> SDoc
2511 pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
2512
2513 pprSpliceDecl :: (OutputableBndrId (GhcPass p))
2514 => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
2515 pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e
2516 pprSpliceDecl e ExplicitSplice = text "$(" <> ppr_splice_decl e <> text ")"
2517 pprSpliceDecl e ImplicitSplice = ppr_splice_decl e
2518
2519 ppr_splice_decl :: (OutputableBndrId (GhcPass p))
2520 => HsSplice (GhcPass p) -> SDoc
2521 ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty
2522 ppr_splice_decl e = pprSplice e
2523
2524 pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc
2525 pprSplice (HsTypedSplice _ HasParens n e)
2526 = ppr_splice (text "$$(") n e (text ")")
2527 pprSplice (HsTypedSplice _ HasDollar n e)
2528 = ppr_splice (text "$$") n e empty
2529 pprSplice (HsTypedSplice _ NoParens n e)
2530 = ppr_splice empty n e empty
2531 pprSplice (HsUntypedSplice _ HasParens n e)
2532 = ppr_splice (text "$(") n e (text ")")
2533 pprSplice (HsUntypedSplice _ HasDollar n e)
2534 = ppr_splice (text "$") n e empty
2535 pprSplice (HsUntypedSplice _ NoParens n e)
2536 = ppr_splice empty n e empty
2537 pprSplice (HsQuasiQuote _ n q _ s) = ppr_quasi n q s
2538 pprSplice (HsSpliced _ _ thing) = ppr thing
2539 pprSplice (HsSplicedT {}) = text "Unevaluated typed splice"
2540 pprSplice (XSplice x) = ppr x
2541
2542 ppr_quasi :: OutputableBndr p => p -> p -> FastString -> SDoc
2543 ppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <>
2544 char '[' <> ppr quoter <> vbar <>
2545 ppr quote <> text "|]"
2546
2547 ppr_splice :: (OutputableBndrId (GhcPass p))
2548 => SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc
2549 ppr_splice herald n e trail
2550 = herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail
2551
2552 -- | Haskell Bracket
2553 data HsBracket p
2554 = ExpBr (XExpBr p) (LHsExpr p) -- [| expr |]
2555 | PatBr (XPatBr p) (LPat p) -- [p| pat |]
2556 | DecBrL (XDecBrL p) [LHsDecl p] -- [d| decls |]; result of parser
2557 | DecBrG (XDecBrG p) (HsGroup p) -- [d| decls |]; result of renamer
2558 | TypBr (XTypBr p) (LHsType p) -- [t| type |]
2559 | VarBr (XVarBr p) Bool (IdP p) -- True: 'x, False: ''T
2560 -- (The Bool flag is used only in pprHsBracket)
2561 | TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||]
2562 | XBracket (XXBracket p) -- Note [Trees that Grow] extension point
2563
2564 type instance XExpBr (GhcPass _) = NoExt
2565 type instance XPatBr (GhcPass _) = NoExt
2566 type instance XDecBrL (GhcPass _) = NoExt
2567 type instance XDecBrG (GhcPass _) = NoExt
2568 type instance XTypBr (GhcPass _) = NoExt
2569 type instance XVarBr (GhcPass _) = NoExt
2570 type instance XTExpBr (GhcPass _) = NoExt
2571 type instance XXBracket (GhcPass _) = NoExt
2572
2573 isTypedBracket :: HsBracket id -> Bool
2574 isTypedBracket (TExpBr {}) = True
2575 isTypedBracket _ = False
2576
2577 instance (p ~ GhcPass pass, OutputableBndrId p)
2578 => Outputable (HsBracket p) where
2579 ppr = pprHsBracket
2580
2581
2582 pprHsBracket :: (OutputableBndrId (GhcPass p)) => HsBracket (GhcPass p) -> SDoc
2583 pprHsBracket (ExpBr _ e) = thBrackets empty (ppr e)
2584 pprHsBracket (PatBr _ p) = thBrackets (char 'p') (ppr p)
2585 pprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)
2586 pprHsBracket (DecBrL _ ds) = thBrackets (char 'd') (vcat (map ppr ds))
2587 pprHsBracket (TypBr _ t) = thBrackets (char 't') (ppr t)
2588 pprHsBracket (VarBr _ True n)
2589 = char '\'' <> pprPrefixOcc n
2590 pprHsBracket (VarBr _ False n)
2591 = text "''" <> pprPrefixOcc n
2592 pprHsBracket (TExpBr _ e) = thTyBrackets (ppr e)
2593 pprHsBracket (XBracket e) = ppr e
2594
2595 thBrackets :: SDoc -> SDoc -> SDoc
2596 thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>
2597 pp_body <+> text "|]"
2598
2599 thTyBrackets :: SDoc -> SDoc
2600 thTyBrackets pp_body = text "[||" <+> pp_body <+> ptext (sLit "||]")
2601
2602 instance Outputable PendingRnSplice where
2603 ppr (PendingRnSplice _ n e) = pprPendingSplice n e
2604
2605 instance Outputable PendingTcSplice where
2606 ppr (PendingTcSplice n e) = pprPendingSplice n e
2607
2608 {-
2609 ************************************************************************
2610 * *
2611 \subsection{Enumerations and list comprehensions}
2612 * *
2613 ************************************************************************
2614 -}
2615
2616 -- | Arithmetic Sequence Information
2617 data ArithSeqInfo id
2618 = From (LHsExpr id)
2619 | FromThen (LHsExpr id)
2620 (LHsExpr id)
2621 | FromTo (LHsExpr id)
2622 (LHsExpr id)
2623 | FromThenTo (LHsExpr id)
2624 (LHsExpr id)
2625 (LHsExpr id)
2626 -- AZ: Sould ArithSeqInfo have a TTG extension?
2627
2628 instance (p ~ GhcPass pass, OutputableBndrId p)
2629 => Outputable (ArithSeqInfo p) where
2630 ppr (From e1) = hcat [ppr e1, pp_dotdot]
2631 ppr (FromThen e1 e2) = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
2632 ppr (FromTo e1 e3) = hcat [ppr e1, pp_dotdot, ppr e3]
2633 ppr (FromThenTo e1 e2 e3)
2634 = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
2635
2636 pp_dotdot :: SDoc
2637 pp_dotdot = text " .. "
2638
2639 {-
2640 ************************************************************************
2641 * *
2642 \subsection{HsMatchCtxt}
2643 * *
2644 ************************************************************************
2645 -}
2646
2647 -- | Haskell Match Context
2648 --
2649 -- Context of a pattern match. This is more subtle than it would seem. See Note
2650 -- [Varieties of pattern matches].
2651 data HsMatchContext id -- Not an extensible tag
2652 = FunRhs { mc_fun :: Located id -- ^ function binder of @f@
2653 , mc_fixity :: LexicalFixity -- ^ fixing of @f@
2654 , mc_strictness :: SrcStrictness -- ^ was @f@ banged?
2655 -- See Note [FunBind vs PatBind]
2656 }
2657 -- ^A pattern matching on an argument of a
2658 -- function binding
2659 | LambdaExpr -- ^Patterns of a lambda
2660 | CaseAlt -- ^Patterns and guards on a case alternative
2661 | IfAlt -- ^Guards of a multi-way if alternative
2662 | ProcExpr -- ^Patterns of a proc
2663 | PatBindRhs -- ^A pattern binding eg [y] <- e = e
2664 | PatBindGuards -- ^Guards of pattern bindings, e.g.,
2665 -- (Just b) | Just _ <- x = e
2666 -- | otherwise = e'
2667
2668 | RecUpd -- ^Record update [used only in DsExpr to
2669 -- tell matchWrapper what sort of
2670 -- runtime error message to generate]
2671
2672 | StmtCtxt (HsStmtContext id) -- ^Pattern of a do-stmt, list comprehension,
2673 -- pattern guard, etc
2674
2675 | ThPatSplice -- ^A Template Haskell pattern splice
2676 | ThPatQuote -- ^A Template Haskell pattern quotation [p| (a,b) |]
2677 | PatSyn -- ^A pattern synonym declaration
2678 deriving Functor
2679 deriving instance (Data id) => Data (HsMatchContext id)
2680
2681 instance OutputableBndr id => Outputable (HsMatchContext id) where
2682 ppr m@(FunRhs{}) = text "FunRhs" <+> ppr (mc_fun m) <+> ppr (mc_fixity m)
2683 ppr LambdaExpr = text "LambdaExpr"
2684 ppr CaseAlt = text "CaseAlt"
2685 ppr IfAlt = text "IfAlt"
2686 ppr ProcExpr = text "ProcExpr"
2687 ppr PatBindRhs = text "PatBindRhs"
2688 ppr PatBindGuards = text "PatBindGuards"
2689 ppr RecUpd = text "RecUpd"
2690 ppr (StmtCtxt _) = text "StmtCtxt _"
2691 ppr ThPatSplice = text "ThPatSplice"
2692 ppr ThPatQuote = text "ThPatQuote"
2693 ppr PatSyn = text "PatSyn"
2694
2695 isPatSynCtxt :: HsMatchContext id -> Bool
2696 isPatSynCtxt ctxt =
2697 case ctxt of
2698 PatSyn -> True
2699 _ -> False
2700
2701 -- | Haskell Statement Context. It expects to be parameterised with one of
2702 -- 'RdrName', 'Name' or 'Id'
2703 data HsStmtContext id
2704 = ListComp
2705 | MonadComp
2706
2707 | DoExpr -- ^do { ... }
2708 | MDoExpr -- ^mdo { ... } ie recursive do-expression
2709 | ArrowExpr -- ^do-notation in an arrow-command context
2710
2711 | GhciStmtCtxt -- ^A command-line Stmt in GHCi pat <- rhs
2712 | PatGuard (HsMatchContext id) -- ^Pattern guard for specified thing
2713 | ParStmtCtxt (HsStmtContext id) -- ^A branch of a parallel stmt
2714 | TransStmtCtxt (HsStmtContext id) -- ^A branch of a transform stmt
2715 deriving Functor
2716 deriving instance (Data id) => Data (HsStmtContext id)
2717
2718 isComprehensionContext :: HsStmtContext id -> Bool
2719 -- Uses comprehension syntax [ e | quals ]
2720 isComprehensionContext ListComp = True
2721 isComprehensionContext MonadComp = True
2722 isComprehensionContext (ParStmtCtxt c) = isComprehensionContext c
2723 isComprehensionContext (TransStmtCtxt c) = isComprehensionContext c
2724 isComprehensionContext _ = False
2725
2726 -- | Should pattern match failure in a 'HsStmtContext' be desugared using
2727 -- 'MonadFail'?
2728 isMonadFailStmtContext :: HsStmtContext id -> Bool
2729 isMonadFailStmtContext MonadComp = True
2730 isMonadFailStmtContext DoExpr = True
2731 isMonadFailStmtContext MDoExpr = True
2732 isMonadFailStmtContext GhciStmtCtxt = True
2733 isMonadFailStmtContext (ParStmtCtxt ctxt) = isMonadFailStmtContext ctxt
2734 isMonadFailStmtContext (TransStmtCtxt ctxt) = isMonadFailStmtContext ctxt
2735 isMonadFailStmtContext _ = False -- ListComp, PatGuard, ArrowExpr
2736
2737 isMonadCompContext :: HsStmtContext id -> Bool
2738 isMonadCompContext MonadComp = True
2739 isMonadCompContext _ = False
2740
2741 matchSeparator :: HsMatchContext id -> SDoc
2742 matchSeparator (FunRhs {}) = text "="
2743 matchSeparator CaseAlt = text "->"
2744 matchSeparator IfAlt = text "->"
2745 matchSeparator LambdaExpr = text "->"
2746 matchSeparator ProcExpr = text "->"
2747 matchSeparator PatBindRhs = text "="
2748 matchSeparator PatBindGuards = text "="
2749 matchSeparator (StmtCtxt _) = text "<-"
2750 matchSeparator RecUpd = text "=" -- This can be printed by the pattern
2751 -- match checker trace
2752 matchSeparator ThPatSplice = panic "unused"
2753 matchSeparator ThPatQuote = panic "unused"
2754 matchSeparator PatSyn = panic "unused"
2755
2756 pprMatchContext :: (Outputable (NameOrRdrName id),Outputable id)
2757 => HsMatchContext id -> SDoc
2758 pprMatchContext ctxt
2759 | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt
2760 | otherwise = text "a" <+> pprMatchContextNoun ctxt
2761 where
2762 want_an (FunRhs {}) = True -- Use "an" in front
2763 want_an ProcExpr = True
2764 want_an _ = False
2765
2766 pprMatchContextNoun :: (Outputable (NameOrRdrName id),Outputable id)
2767 => HsMatchContext id -> SDoc
2768 pprMatchContextNoun (FunRhs {mc_fun=L _ fun})
2769 = text "equation for"
2770 <+> quotes (ppr fun)
2771 pprMatchContextNoun CaseAlt = text "case alternative"
2772 pprMatchContextNoun IfAlt = text "multi-way if alternative"
2773 pprMatchContextNoun RecUpd = text "record-update construct"
2774 pprMatchContextNoun ThPatSplice = text "Template Haskell pattern splice"
2775 pprMatchContextNoun ThPatQuote = text "Template Haskell pattern quotation"
2776 pprMatchContextNoun PatBindRhs = text "pattern binding"
2777 pprMatchContextNoun PatBindGuards = text "pattern binding guards"
2778 pprMatchContextNoun LambdaExpr = text "lambda abstraction"
2779 pprMatchContextNoun ProcExpr = text "arrow abstraction"
2780 pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in"
2781 $$ pprAStmtContext ctxt
2782 pprMatchContextNoun PatSyn = text "pattern synonym declaration"
2783
2784 -----------------
2785 pprAStmtContext, pprStmtContext :: (Outputable id,
2786 Outputable (NameOrRdrName id))
2787 => HsStmtContext id -> SDoc
2788 pprAStmtContext ctxt = article <+> pprStmtContext ctxt
2789 where
2790 pp_an = text "an"
2791 pp_a = text "a"
2792 article = case ctxt of
2793 MDoExpr -> pp_an
2794 GhciStmtCtxt -> pp_an
2795 _ -> pp_a
2796
2797
2798 -----------------
2799 pprStmtContext GhciStmtCtxt = text "interactive GHCi command"
2800 pprStmtContext DoExpr = text "'do' block"
2801 pprStmtContext MDoExpr = text "'mdo' block"
2802 pprStmtContext ArrowExpr = text "'do' block in an arrow command"
2803 pprStmtContext ListComp = text "list comprehension"
2804 pprStmtContext MonadComp = text "monad comprehension"
2805 pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt
2806
2807 -- Drop the inner contexts when reporting errors, else we get
2808 -- Unexpected transform statement
2809 -- in a transformed branch of
2810 -- transformed branch of
2811 -- transformed branch of monad comprehension
2812 pprStmtContext (ParStmtCtxt c) =
2813 ifPprDebug (sep [text "parallel branch of", pprAStmtContext c])
2814 (pprStmtContext c)
2815 pprStmtContext (TransStmtCtxt c) =
2816 ifPprDebug (sep [text "transformed branch of", pprAStmtContext c])
2817 (pprStmtContext c)
2818
2819 instance (Outputable p, Outputable (NameOrRdrName p))
2820 => Outputable (HsStmtContext p) where
2821 ppr = pprStmtContext
2822
2823 -- Used to generate the string for a *runtime* error message
2824 matchContextErrString :: Outputable id
2825 => HsMatchContext id -> SDoc
2826 matchContextErrString (FunRhs{mc_fun=L _ fun}) = text "function" <+> ppr fun
2827 matchContextErrString CaseAlt = text "case"
2828 matchContextErrString IfAlt = text "multi-way if"
2829 matchContextErrString PatBindRhs = text "pattern binding"
2830 matchContextErrString PatBindGuards = text "pattern binding guards"
2831 matchContextErrString RecUpd = text "record update"
2832 matchContextErrString LambdaExpr = text "lambda"
2833 matchContextErrString ProcExpr = text "proc"
2834 matchContextErrString ThPatSplice = panic "matchContextErrString" -- Not used at runtime
2835 matchContextErrString ThPatQuote = panic "matchContextErrString" -- Not used at runtime
2836 matchContextErrString PatSyn = panic "matchContextErrString" -- Not used at runtime
2837 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
2838 matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)
2839 matchContextErrString (StmtCtxt (PatGuard _)) = text "pattern guard"
2840 matchContextErrString (StmtCtxt GhciStmtCtxt) = text "interactive GHCi command"
2841 matchContextErrString (StmtCtxt DoExpr) = text "'do' block"
2842 matchContextErrString (StmtCtxt ArrowExpr) = text "'do' block"
2843 matchContextErrString (StmtCtxt MDoExpr) = text "'mdo' block"
2844 matchContextErrString (StmtCtxt ListComp) = text "list comprehension"
2845 matchContextErrString (StmtCtxt MonadComp) = text "monad comprehension"
2846
2847 pprMatchInCtxt :: (OutputableBndrId (GhcPass idR),
2848 -- TODO:AZ these constraints do not make sense
2849 Outputable (NameOrRdrName (NameOrRdrName (IdP (GhcPass idR)))),
2850 Outputable body)
2851 => Match (GhcPass idR) body -> SDoc
2852 pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match)
2853 <> colon)
2854 4 (pprMatch match)
2855
2856 pprStmtInCtxt :: (OutputableBndrId (GhcPass idL),
2857 OutputableBndrId (GhcPass idR),
2858 Outputable body)
2859 => HsStmtContext (IdP (GhcPass idL))
2860 -> StmtLR (GhcPass idL) (GhcPass idR) body
2861 -> SDoc
2862 pprStmtInCtxt ctxt (LastStmt _ e _ _)
2863 | isComprehensionContext ctxt -- For [ e | .. ], do not mutter about "stmts"
2864 = hang (text "In the expression:") 2 (ppr e)
2865
2866 pprStmtInCtxt ctxt stmt
2867 = hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon)
2868 2 (ppr_stmt stmt)
2869 where
2870 -- For Group and Transform Stmts, don't print the nested stmts!
2871 ppr_stmt (TransStmt { trS_by = by, trS_using = using
2872 , trS_form = form }) = pprTransStmt by using form
2873 ppr_stmt stmt = pprStmt stmt