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