never executed always true always false
1 {-# LANGUAGE ConstraintKinds #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeApplications #-}
7 {-# LANGUAGE TypeFamilies #-}
8 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
9 -- in module Language.Haskell.Syntax.Extension
10 {-# LANGUAGE ViewPatterns #-}
11
12
13 {-
14 (c) The University of Glasgow 2006
15 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
16
17 \section[HsBinds]{Abstract syntax: top-level bindings and signatures}
18
19 Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
20 -}
21
22 -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
23 module Language.Haskell.Syntax.Binds where
24
25 import GHC.Prelude
26
27 import {-# SOURCE #-} Language.Haskell.Syntax.Expr
28 ( LHsExpr
29 , MatchGroup
30 , GRHSs )
31 import {-# SOURCE #-} Language.Haskell.Syntax.Pat
32 ( LPat )
33
34 import Language.Haskell.Syntax.Extension
35 import Language.Haskell.Syntax.Type
36 import GHC.Types.Name.Reader(RdrName)
37 import GHC.Tc.Types.Evidence
38 import GHC.Core.Type
39 import GHC.Types.Basic
40 import GHC.Types.SourceText
41 import GHC.Types.SrcLoc as SrcLoc
42 import GHC.Types.Tickish
43 import GHC.Types.Var
44 import GHC.Types.Fixity
45 import GHC.Data.Bag
46 import GHC.Data.BooleanFormula (LBooleanFormula)
47
48 import GHC.Utils.Outputable
49 import GHC.Utils.Panic (pprPanic)
50
51 import Data.Data hiding ( Fixity )
52 import Data.Void
53
54 {-
55 ************************************************************************
56 * *
57 \subsection{Bindings: @BindGroup@}
58 * *
59 ************************************************************************
60
61 Global bindings (where clauses)
62 -}
63
64 -- During renaming, we need bindings where the left-hand sides
65 -- have been renamed but the right-hand sides have not.
66 -- Other than during renaming, these will be the same.
67
68 -- | Haskell Local Bindings
69 type HsLocalBinds id = HsLocalBindsLR id id
70
71 -- | Located Haskell local bindings
72 type LHsLocalBinds id = XRec id (HsLocalBinds id)
73
74 -- | Haskell Local Bindings with separate Left and Right identifier types
75 --
76 -- Bindings in a 'let' expression
77 -- or a 'where' clause
78 data HsLocalBindsLR idL idR
79 = HsValBinds
80 (XHsValBinds idL idR)
81 (HsValBindsLR idL idR)
82 -- ^ Haskell Value Bindings
83
84 -- There should be no pattern synonyms in the HsValBindsLR
85 -- These are *local* (not top level) bindings
86 -- The parser accepts them, however, leaving the
87 -- renamer to report them
88
89 | HsIPBinds
90 (XHsIPBinds idL idR)
91 (HsIPBinds idR)
92 -- ^ Haskell Implicit Parameter Bindings
93
94 | EmptyLocalBinds (XEmptyLocalBinds idL idR)
95 -- ^ Empty Local Bindings
96
97 | XHsLocalBindsLR
98 !(XXHsLocalBindsLR idL idR)
99
100 type LHsLocalBindsLR idL idR = XRec idL (HsLocalBindsLR idL idR)
101
102
103 -- | Haskell Value Bindings
104 type HsValBinds id = HsValBindsLR id id
105
106 -- | Haskell Value bindings with separate Left and Right identifier types
107 -- (not implicit parameters)
108 -- Used for both top level and nested bindings
109 -- May contain pattern synonym bindings
110 data HsValBindsLR idL idR
111 = -- | Value Bindings In
112 --
113 -- Before renaming RHS; idR is always RdrName
114 -- Not dependency analysed
115 -- Recursive by default
116 ValBinds
117 (XValBinds idL idR)
118 (LHsBindsLR idL idR) [LSig idR]
119
120 -- | Value Bindings Out
121 --
122 -- After renaming RHS; idR can be Name or Id Dependency analysed,
123 -- later bindings in the list may depend on earlier ones.
124 | XValBindsLR
125 !(XXValBindsLR idL idR)
126
127 -- ---------------------------------------------------------------------
128
129 -- | Located Haskell Binding
130 type LHsBind id = LHsBindLR id id
131
132 -- | Located Haskell Bindings
133 type LHsBinds id = LHsBindsLR id id
134
135 -- | Haskell Binding
136 type HsBind id = HsBindLR id id
137
138 -- | Located Haskell Bindings with separate Left and Right identifier types
139 type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
140
141 -- | Located Haskell Binding with separate Left and Right identifier types
142 type LHsBindLR idL idR = XRec idL (HsBindLR idL idR)
143
144 {- Note [FunBind vs PatBind]
145 ~~~~~~~~~~~~~~~~~~~~~~~~~
146 The distinction between FunBind and PatBind is a bit subtle. FunBind covers
147 patterns which resemble function bindings and simple variable bindings.
148
149 f x = e
150 f !x = e
151 f = e
152 !x = e -- FunRhs has SrcStrict
153 x `f` y = e -- FunRhs has Infix
154
155 The actual patterns and RHSs of a FunBind are encoding in fun_matches.
156 The m_ctxt field of each Match in fun_matches will be FunRhs and carries
157 two bits of information about the match,
158
159 * The mc_fixity field on each Match describes the fixity of the
160 function binder in that match. E.g. this is legal:
161 f True False = e1
162 True `f` True = e2
163
164 * The mc_strictness field is used /only/ for nullary FunBinds: ones
165 with one Match, which has no pats. For these, it describes whether
166 the match is decorated with a bang (e.g. `!x = e`).
167
168 By contrast, PatBind represents data constructor patterns, as well as a few
169 other interesting cases. Namely,
170
171 Just x = e
172 (x) = e
173 x :: Ty = e
174 -}
175
176 -- | Haskell Binding with separate Left and Right id's
177 data HsBindLR idL idR
178 = -- | Function-like Binding
179 --
180 -- FunBind is used for both functions @f x = e@
181 -- and variables @f = \x -> e@
182 -- and strict variables @!x = x + 1@
183 --
184 -- Reason 1: Special case for type inference: see 'GHC.Tc.Gen.Bind.tcMonoBinds'.
185 --
186 -- Reason 2: Instance decls can only have FunBinds, which is convenient.
187 -- If you change this, you'll need to change e.g. rnMethodBinds
188 --
189 -- But note that the form @f :: a->a = ...@
190 -- parses as a pattern binding, just like
191 -- @(f :: a -> a) = ... @
192 --
193 -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their
194 -- 'MatchContext'. See Note [FunBind vs PatBind] for
195 -- details about the relationship between FunBind and PatBind.
196 --
197 -- 'GHC.Parser.Annotation.AnnKeywordId's
198 --
199 -- - 'GHC.Parser.Annotation.AnnFunId', attached to each element of fun_matches
200 --
201 -- - 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',
202 -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
203
204 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
205 FunBind {
206
207 fun_ext :: XFunBind idL idR,
208
209 -- ^ After the renamer (but before the type-checker), this contains the
210 -- locally-bound free variables of this defn. See Note [Bind free vars]
211 --
212 -- After the type-checker, this contains a coercion from the type of
213 -- the MatchGroup to the type of the Id. Example:
214 --
215 -- @
216 -- f :: Int -> forall a. a -> a
217 -- f x y = y
218 -- @
219 --
220 -- Then the MatchGroup will have type (Int -> a' -> a')
221 -- (with a free type variable a'). The coercion will take
222 -- a CoreExpr of this type and convert it to a CoreExpr of
223 -- type Int -> forall a'. a' -> a'
224 -- Notice that the coercion captures the free a'.
225
226 fun_id :: LIdP idL, -- Note [fun_id in Match] in GHC.Hs.Expr
227
228 fun_matches :: MatchGroup idR (LHsExpr idR), -- ^ The payload
229
230 fun_tick :: [CoreTickish] -- ^ Ticks to put on the rhs, if any
231 }
232
233 -- | Pattern Binding
234 --
235 -- The pattern is never a simple variable;
236 -- That case is done by FunBind.
237 -- See Note [FunBind vs PatBind] for details about the
238 -- relationship between FunBind and PatBind.
239
240 --
241 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang',
242 -- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',
243 -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
244
245 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
246 | PatBind {
247 pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars]
248 pat_lhs :: LPat idL,
249 pat_rhs :: GRHSs idR (LHsExpr idR),
250 pat_ticks :: ([CoreTickish], [[CoreTickish]])
251 -- ^ Ticks to put on the rhs, if any, and ticks to put on
252 -- the bound variables.
253 }
254
255 -- | Variable Binding
256 --
257 -- Dictionary binding and suchlike.
258 -- All VarBinds are introduced by the type checker
259 | VarBind {
260 var_ext :: XVarBind idL idR,
261 var_id :: IdP idL,
262 var_rhs :: LHsExpr idR -- ^ Located only for consistency
263 }
264
265 -- | Abstraction Bindings
266 | AbsBinds { -- Binds abstraction; TRANSLATION
267 abs_ext :: XAbsBinds idL idR,
268 abs_tvs :: [TyVar],
269 abs_ev_vars :: [EvVar], -- ^ Includes equality constraints
270
271 -- | AbsBinds only gets used when idL = idR after renaming,
272 -- but these need to be idL's for the collect... code in HsUtil
273 -- to have the right type
274 abs_exports :: [ABExport idL],
275
276 -- | Evidence bindings
277 -- Why a list? See "GHC.Tc.TyCl.Instance"
278 -- Note [Typechecking plan for instance declarations]
279 abs_ev_binds :: [TcEvBinds],
280
281 -- | Typechecked user bindings
282 abs_binds :: LHsBinds idL,
283
284 abs_sig :: Bool -- See Note [The abs_sig field of AbsBinds]
285 }
286
287 -- | Patterns Synonym Binding
288 | PatSynBind
289 (XPatSynBind idL idR)
290 (PatSynBind idL idR)
291 -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',
292 -- 'GHC.Parser.Annotation.AnnLarrow','GHC.Parser.Annotation.AnnEqual',
293 -- 'GHC.Parser.Annotation.AnnWhere'
294 -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@
295
296 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
297
298 | XHsBindsLR !(XXHsBindsLR idL idR)
299
300
301 -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
302 --
303 -- Creates bindings for (polymorphic, overloaded) poly_f
304 -- in terms of monomorphic, non-overloaded mono_f
305 --
306 -- Invariants:
307 -- 1. 'binds' binds mono_f
308 -- 2. ftvs is a subset of tvs
309 -- 3. ftvs includes all tyvars free in ds
310 --
311 -- See Note [AbsBinds]
312
313 -- | Abstraction Bindings Export
314 data ABExport p
315 = ABE { abe_ext :: XABE p
316 , abe_poly :: IdP p -- ^ Any INLINE pragma is attached to this Id
317 , abe_mono :: IdP p
318 , abe_wrap :: HsWrapper -- ^ See Note [ABExport wrapper]
319 -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
320 , abe_prags :: TcSpecPrags -- ^ SPECIALISE pragmas
321 }
322 | XABExport !(XXABExport p)
323
324
325 -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',
326 -- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnLarrow',
327 -- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen' @'{'@,
328 -- 'GHC.Parser.Annotation.AnnClose' @'}'@,
329
330 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
331
332 -- | Pattern Synonym binding
333 data PatSynBind idL idR
334 = PSB { psb_ext :: XPSB idL idR, -- ^ Post renaming, FVs.
335 -- See Note [Bind free vars]
336 psb_id :: LIdP idL, -- ^ Name of the pattern synonym
337 psb_args :: HsPatSynDetails idR, -- ^ Formal parameter names
338 psb_def :: LPat idR, -- ^ Right-hand side
339 psb_dir :: HsPatSynDir idR -- ^ Directionality
340 }
341 | XPatSynBind !(XXPatSynBind idL idR)
342
343 {-
344 Note [AbsBinds]
345 ~~~~~~~~~~~~~~~
346 The AbsBinds constructor is used in the output of the type checker, to
347 record *typechecked* and *generalised* bindings. Specifically
348
349 AbsBinds { abs_tvs = tvs
350 , abs_ev_vars = [d1,d2]
351 , abs_exports = [ABE { abe_poly = fp, abe_mono = fm
352 , abe_wrap = fwrap }
353 ABE { slly for g } ]
354 , abs_ev_binds = DBINDS
355 , abs_binds = BIND[fm,gm] }
356
357 where 'BIND' binds the monomorphic Ids 'fm' and 'gm', means
358
359 fp = fwrap [/\ tvs. \d1 d2. letrec { DBINDS ]
360 [ ; BIND[fm,gm] } ]
361 [ in fm ]
362
363 gp = ...same again, with gm instead of fm
364
365 The 'fwrap' is an impedance-matcher that typically does nothing; see
366 Note [ABExport wrapper].
367
368 This is a pretty bad translation, because it duplicates all the bindings.
369 So the desugarer tries to do a better job:
370
371 fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
372 (fm,gm) -> fm
373 ..ditto for gp..
374
375 tp = /\ [a,b] -> \ [d1,d2] -> letrec { DBINDS; BIND }
376 in (fm,gm)
377
378 In general:
379
380 * abs_tvs are the type variables over which the binding group is
381 generalised
382 * abs_ev_var are the evidence variables (usually dictionaries)
383 over which the binding group is generalised
384 * abs_binds are the monomorphic bindings
385 * abs_ex_binds are the evidence bindings that wrap the abs_binds
386 * abs_exports connects the monomorphic Ids bound by abs_binds
387 with the polymorphic Ids bound by the AbsBinds itself.
388
389 For example, consider a module M, with this top-level binding, where
390 there is no type signature for M.reverse,
391 M.reverse [] = []
392 M.reverse (x:xs) = M.reverse xs ++ [x]
393
394 In Hindley-Milner, a recursive binding is typechecked with the
395 *recursive* uses being *monomorphic*. So after typechecking *and*
396 desugaring we will get something like this
397
398 M.reverse :: forall a. [a] -> [a]
399 = /\a. letrec
400 reverse :: [a] -> [a] = \xs -> case xs of
401 [] -> []
402 (x:xs) -> reverse xs ++ [x]
403 in reverse
404
405 Notice that 'M.reverse' is polymorphic as expected, but there is a local
406 definition for plain 'reverse' which is *monomorphic*. The type variable
407 'a' scopes over the entire letrec.
408
409 That's after desugaring. What about after type checking but before
410 desugaring? That's where AbsBinds comes in. It looks like this:
411
412 AbsBinds { abs_tvs = [a]
413 , abs_ev_vars = []
414 , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],
415 , abe_mono = reverse :: [a] -> [a]}]
416 , abs_ev_binds = {}
417 , abs_binds = { reverse :: [a] -> [a]
418 = \xs -> case xs of
419 [] -> []
420 (x:xs) -> reverse xs ++ [x] } }
421
422 Here,
423
424 * abs_tvs says what type variables are abstracted over the binding
425 group, just 'a' in this case.
426 * abs_binds is the *monomorphic* bindings of the group
427 * abs_exports describes how to get the polymorphic Id 'M.reverse'
428 from the monomorphic one 'reverse'
429
430 Notice that the *original* function (the polymorphic one you thought
431 you were defining) appears in the abe_poly field of the
432 abs_exports. The bindings in abs_binds are for fresh, local, Ids with
433 a *monomorphic* Id.
434
435 If there is a group of mutually recursive (see Note [Polymorphic
436 recursion]) functions without type signatures, we get one AbsBinds
437 with the monomorphic versions of the bindings in abs_binds, and one
438 element of abe_exports for each variable bound in the mutually
439 recursive group. This is true even for pattern bindings. Example:
440 (f,g) = (\x -> x, f)
441 After type checking we get
442 AbsBinds { abs_tvs = [a]
443 , abs_exports = [ ABE { abe_poly = M.f :: forall a. a -> a
444 , abe_mono = f :: a -> a }
445 , ABE { abe_poly = M.g :: forall a. a -> a
446 , abe_mono = g :: a -> a }]
447 , abs_binds = { (f,g) = (\x -> x, f) }
448
449 Note [Polymorphic recursion]
450 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
451 Consider
452 Rec { f x = ...(g ef)...
453
454 ; g :: forall a. [a] -> [a]
455 ; g y = ...(f eg)... }
456
457 These bindings /are/ mutually recursive (f calls g, and g calls f).
458 But we can use the type signature for g to break the recursion,
459 like this:
460
461 1. Add g :: forall a. [a] -> [a] to the type environment
462
463 2. Typecheck the definition of f, all by itself,
464 including generalising it to find its most general
465 type, say f :: forall b. b -> b -> [b]
466
467 3. Extend the type environment with that type for f
468
469 4. Typecheck the definition of g, all by itself,
470 checking that it has the type claimed by its signature
471
472 Steps 2 and 4 each generate a separate AbsBinds, so we end
473 up with
474 Rec { AbsBinds { ...for f ... }
475 ; AbsBinds { ...for g ... } }
476
477 This approach allows both f and to call each other
478 polymorphically, even though only g has a signature.
479
480 We get an AbsBinds that encompasses multiple source-program
481 bindings only when
482 * Each binding in the group has at least one binder that
483 lacks a user type signature
484 * The group forms a strongly connected component
485
486
487 Note [The abs_sig field of AbsBinds]
488 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
489 The abs_sig field supports a couple of special cases for bindings.
490 Consider
491
492 x :: Num a => (# a, a #)
493 x = (# 3, 4 #)
494
495 The general desugaring for AbsBinds would give
496
497 x = /\a. \ ($dNum :: Num a) ->
498 letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in
499 xm
500
501 But that has an illegal let-binding for an unboxed tuple. In this
502 case we'd prefer to generate the (more direct)
503
504 x = /\ a. \ ($dNum :: Num a) ->
505 (# fromInteger $dNum 3, fromInteger $dNum 4 #)
506
507 A similar thing happens with representation-polymorphic defns
508 (#11405):
509
510 undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
511 undef = error "undef"
512
513 Again, the vanilla desugaring gives a local let-binding for a
514 representation-polymorphic (undefm :: a), which is illegal. But
515 again we can desugar without a let:
516
517 undef = /\ a. \ (d:HasCallStack) -> error a d "undef"
518
519 The abs_sig field supports this direct desugaring, with no local
520 let-binding. When abs_sig = True
521
522 * the abs_binds is single FunBind
523
524 * the abs_exports is a singleton
525
526 * we have a complete type sig for binder
527 and hence the abs_binds is non-recursive
528 (it binds the mono_id but refers to the poly_id
529
530 These properties are exploited in GHC.HsToCore.Binds.dsAbsBinds to
531 generate code without a let-binding.
532
533 Note [ABExport wrapper]
534 ~~~~~~~~~~~~~~~~~~~~~~~
535 Consider
536 (f,g) = (\x.x, \y.y)
537 This ultimately desugars to something like this:
538 tup :: forall a b. (a->a, b->b)
539 tup = /\a b. (\x:a.x, \y:b.y)
540 f :: forall a. a -> a
541 f = /\a. case tup a Any of
542 (fm::a->a,gm:Any->Any) -> fm
543 ...similarly for g...
544
545 The abe_wrap field deals with impedance-matching between
546 (/\a b. case tup a b of { (f,g) -> f })
547 and the thing we really want, which may have fewer type
548 variables. The action happens in GHC.Tc.Gen.Bind.mkExport.
549
550 Note [Bind free vars]
551 ~~~~~~~~~~~~~~~~~~~~~
552 The bind_fvs field of FunBind and PatBind records the free variables
553 of the definition. It is used for the following purposes
554
555 a) Dependency analysis prior to type checking
556 (see GHC.Tc.Gen.Bind.tc_group)
557
558 b) Deciding whether we can do generalisation of the binding
559 (see GHC.Tc.Gen.Bind.decideGeneralisationPlan)
560
561 c) Deciding whether the binding can be used in static forms
562 (see GHC.Tc.Gen.Expr.checkClosedInStaticForm for the HsStatic case and
563 GHC.Tc.Gen.Bind.isClosedBndrGroup).
564
565 Specifically,
566
567 * bind_fvs includes all free vars that are defined in this module
568 (including top-level things and lexically scoped type variables)
569
570 * bind_fvs excludes imported vars; this is just to keep the set smaller
571
572 * Before renaming, and after typechecking, the field is unused;
573 it's just an error thunk
574 -}
575
576
577 {-
578 ************************************************************************
579 * *
580 Implicit parameter bindings
581 * *
582 ************************************************************************
583 -}
584
585 -- | Haskell Implicit Parameter Bindings
586 data HsIPBinds id
587 = IPBinds
588 (XIPBinds id)
589 [LIPBind id]
590 -- TcEvBinds -- Only in typechecker output; binds
591 -- -- uses of the implicit parameters
592 | XHsIPBinds !(XXHsIPBinds id)
593
594
595 -- | Located Implicit Parameter Binding
596 type LIPBind id = XRec id (IPBind id)
597 -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a
598 -- list
599
600 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
601
602 -- | Implicit parameter bindings.
603 --
604 -- These bindings start off as (Left "x") in the parser and stay
605 -- that way until after type-checking when they are replaced with
606 -- (Right d), where "d" is the name of the dictionary holding the
607 -- evidence for the implicit parameter.
608 --
609 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'
610
611 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
612 data IPBind id
613 = IPBind
614 (XCIPBind id)
615 (Either (XRec id HsIPName) (IdP id))
616 (LHsExpr id)
617 | XIPBind !(XXIPBind id)
618
619 {-
620 ************************************************************************
621 * *
622 \subsection{@Sig@: type signatures and value-modifying user pragmas}
623 * *
624 ************************************************************************
625
626 It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
627 ``specialise this function to these four types...'') in with type
628 signatures. Then all the machinery to move them into place, etc.,
629 serves for both.
630 -}
631
632 -- | Located Signature
633 type LSig pass = XRec pass (Sig pass)
634
635 -- | Signatures and pragmas
636 data Sig pass
637 = -- | An ordinary type signature
638 --
639 -- > f :: Num a => a -> a
640 --
641 -- After renaming, this list of Names contains the named
642 -- wildcards brought into scope by this signature. For a signature
643 -- @_ -> _a -> Bool@, the renamer will leave the unnamed wildcard @_@
644 -- untouched, and the named wildcard @_a@ is then replaced with
645 -- fresh meta vars in the type. Their names are stored in the type
646 -- signature that brought them into scope, in this third field to be
647 -- more specific.
648 --
649 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon',
650 -- 'GHC.Parser.Annotation.AnnComma'
651
652 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
653 TypeSig
654 (XTypeSig pass)
655 [LIdP pass] -- LHS of the signature; e.g. f,g,h :: blah
656 (LHsSigWcType pass) -- RHS of the signature; can have wildcards
657
658 -- | A pattern synonym type signature
659 --
660 -- > pattern Single :: () => (Show a) => a -> [a]
661 --
662 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',
663 -- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnForall'
664 -- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow'
665
666 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
667 | PatSynSig (XPatSynSig pass) [LIdP pass] (LHsSigType pass)
668 -- P :: forall a b. Req => Prov => ty
669
670 -- | A signature for a class method
671 -- False: ordinary class-method signature
672 -- True: generic-default class method signature
673 -- e.g. class C a where
674 -- op :: a -> a -- Ordinary
675 -- default op :: Eq a => a -> a -- Generic default
676 -- No wildcards allowed here
677 --
678 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDefault',
679 -- 'GHC.Parser.Annotation.AnnDcolon'
680 | ClassOpSig (XClassOpSig pass) Bool [LIdP pass] (LHsSigType pass)
681
682 -- | A type signature in generated code, notably the code
683 -- generated for record selectors. We simply record
684 -- the desired Id itself, replete with its name, type
685 -- and IdDetails. Otherwise it's just like a type
686 -- signature: there should be an accompanying binding
687 | IdSig (XIdSig pass) Id
688
689 -- | An ordinary fixity declaration
690 --
691 -- > infixl 8 ***
692 --
693 --
694 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnInfix',
695 -- 'GHC.Parser.Annotation.AnnVal'
696
697 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
698 | FixSig (XFixSig pass) (FixitySig pass)
699
700 -- | An inline pragma
701 --
702 -- > {#- INLINE f #-}
703 --
704 -- - 'GHC.Parser.Annotation.AnnKeywordId' :
705 -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# INLINE'@ and @'['@,
706 -- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnOpen',
707 -- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnTilde',
708 -- 'GHC.Parser.Annotation.AnnClose'
709
710 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
711 | InlineSig (XInlineSig pass)
712 (LIdP pass) -- Function name
713 InlinePragma -- Never defaultInlinePragma
714
715 -- | A specialisation pragma
716 --
717 -- > {-# SPECIALISE f :: Int -> Int #-}
718 --
719 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
720 -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,
721 -- 'GHC.Parser.Annotation.AnnTilde',
722 -- 'GHC.Parser.Annotation.AnnVal',
723 -- 'GHC.Parser.Annotation.AnnClose' @']'@ and @'\#-}'@,
724 -- 'GHC.Parser.Annotation.AnnDcolon'
725
726 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
727 | SpecSig (XSpecSig pass)
728 (LIdP pass) -- Specialise a function or datatype ...
729 [LHsSigType pass] -- ... to these types
730 InlinePragma -- The pragma on SPECIALISE_INLINE form.
731 -- If it's just defaultInlinePragma, then we said
732 -- SPECIALISE, not SPECIALISE_INLINE
733
734 -- | A specialisation pragma for instance declarations only
735 --
736 -- > {-# SPECIALISE instance Eq [Int] #-}
737 --
738 -- (Class tys); should be a specialisation of the
739 -- current instance declaration
740 --
741 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
742 -- 'GHC.Parser.Annotation.AnnInstance','GHC.Parser.Annotation.AnnClose'
743
744 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
745 | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
746 -- Note [Pragma source text] in GHC.Types.SourceText
747
748 -- | A minimal complete definition pragma
749 --
750 -- > {-# MINIMAL a | (b, c | (d | e)) #-}
751 --
752 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
753 -- 'GHC.Parser.Annotation.AnnVbar','GHC.Parser.Annotation.AnnComma',
754 -- 'GHC.Parser.Annotation.AnnClose'
755
756 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
757 | MinimalSig (XMinimalSig pass)
758 SourceText (LBooleanFormula (LIdP pass))
759 -- Note [Pragma source text] in GHC.Types.SourceText
760
761 -- | A "set cost centre" pragma for declarations
762 --
763 -- > {-# SCC funName #-}
764 --
765 -- or
766 --
767 -- > {-# SCC funName "cost_centre_name" #-}
768
769 | SCCFunSig (XSCCFunSig pass)
770 SourceText -- Note [Pragma source text] in GHC.Types.SourceText
771 (LIdP pass) -- Function name
772 (Maybe (XRec pass StringLiteral))
773 -- | A complete match pragma
774 --
775 -- > {-# COMPLETE C, D [:: T] #-}
776 --
777 -- Used to inform the pattern match checker about additional
778 -- complete matchings which, for example, arise from pattern
779 -- synonym definitions.
780 | CompleteMatchSig (XCompleteMatchSig pass)
781 SourceText
782 (XRec pass [LIdP pass])
783 (Maybe (LIdP pass))
784 | XSig !(XXSig pass)
785
786 -- | Located Fixity Signature
787 type LFixitySig pass = XRec pass (FixitySig pass)
788
789 -- | Fixity Signature
790 data FixitySig pass = FixitySig (XFixitySig pass) [LIdP pass] Fixity
791 | XFixitySig !(XXFixitySig pass)
792
793 -- | Type checker Specialisation Pragmas
794 --
795 -- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer
796 data TcSpecPrags
797 = IsDefaultMethod -- ^ Super-specialised: a default method should
798 -- be macro-expanded at every call site
799 | SpecPrags [LTcSpecPrag]
800 deriving Data
801
802 -- | Located Type checker Specification Pragmas
803 type LTcSpecPrag = Located TcSpecPrag
804
805 -- | Type checker Specification Pragma
806 data TcSpecPrag
807 = SpecPrag
808 Id
809 HsWrapper
810 InlinePragma
811 -- ^ The Id to be specialised, a wrapper that specialises the
812 -- polymorphic function, and inlining spec for the specialised function
813 deriving Data
814
815 noSpecPrags :: TcSpecPrags
816 noSpecPrags = SpecPrags []
817
818 hasSpecPrags :: TcSpecPrags -> Bool
819 hasSpecPrags (SpecPrags ps) = not (null ps)
820 hasSpecPrags IsDefaultMethod = False
821
822 isDefaultMethod :: TcSpecPrags -> Bool
823 isDefaultMethod IsDefaultMethod = True
824 isDefaultMethod (SpecPrags {}) = False
825
826 isFixityLSig :: forall p. UnXRec p => LSig p -> Bool
827 isFixityLSig (unXRec @p -> FixSig {}) = True
828 isFixityLSig _ = False
829
830 isTypeLSig :: forall p. UnXRec p => LSig p -> Bool -- Type signatures
831 isTypeLSig (unXRec @p -> TypeSig {}) = True
832 isTypeLSig (unXRec @p -> ClassOpSig {}) = True
833 isTypeLSig (unXRec @p -> IdSig {}) = True
834 isTypeLSig _ = False
835
836 isSpecLSig :: forall p. UnXRec p => LSig p -> Bool
837 isSpecLSig (unXRec @p -> SpecSig {}) = True
838 isSpecLSig _ = False
839
840 isSpecInstLSig :: forall p. UnXRec p => LSig p -> Bool
841 isSpecInstLSig (unXRec @p -> SpecInstSig {}) = True
842 isSpecInstLSig _ = False
843
844 isPragLSig :: forall p. UnXRec p => LSig p -> Bool
845 -- Identifies pragmas
846 isPragLSig (unXRec @p -> SpecSig {}) = True
847 isPragLSig (unXRec @p -> InlineSig {}) = True
848 isPragLSig (unXRec @p -> SCCFunSig {}) = True
849 isPragLSig (unXRec @p -> CompleteMatchSig {}) = True
850 isPragLSig _ = False
851
852 isInlineLSig :: forall p. UnXRec p => LSig p -> Bool
853 -- Identifies inline pragmas
854 isInlineLSig (unXRec @p -> InlineSig {}) = True
855 isInlineLSig _ = False
856
857 isMinimalLSig :: forall p. UnXRec p => LSig p -> Bool
858 isMinimalLSig (unXRec @p -> MinimalSig {}) = True
859 isMinimalLSig _ = False
860
861 isSCCFunSig :: forall p. UnXRec p => LSig p -> Bool
862 isSCCFunSig (unXRec @p -> SCCFunSig {}) = True
863 isSCCFunSig _ = False
864
865 isCompleteMatchSig :: forall p. UnXRec p => LSig p -> Bool
866 isCompleteMatchSig (unXRec @p -> CompleteMatchSig {} ) = True
867 isCompleteMatchSig _ = False
868
869 hsSigDoc :: Sig name -> SDoc
870 hsSigDoc (TypeSig {}) = text "type signature"
871 hsSigDoc (PatSynSig {}) = text "pattern synonym signature"
872 hsSigDoc (ClassOpSig _ is_deflt _ _)
873 | is_deflt = text "default type signature"
874 | otherwise = text "class method signature"
875 hsSigDoc (IdSig {}) = text "id signature"
876 hsSigDoc (SpecSig _ _ _ inl) = (inlinePragmaName . inl_inline $ inl) <+> text "pragma"
877 hsSigDoc (InlineSig _ _ prag) = (inlinePragmaName . inl_inline $ prag) <+> text "pragma"
878 -- Using the 'inlinePragmaName' function ensures that the pragma name for any
879 -- one of the INLINE/INLINABLE/NOINLINE pragmas are printed after being extracted
880 -- from the InlineSpec field of the pragma.
881 hsSigDoc (SpecInstSig _ src _) = text (extractSpecPragName src) <+> text "instance pragma"
882 hsSigDoc (FixSig {}) = text "fixity declaration"
883 hsSigDoc (MinimalSig {}) = text "MINIMAL pragma"
884 hsSigDoc (SCCFunSig {}) = text "SCC pragma"
885 hsSigDoc (CompleteMatchSig {}) = text "COMPLETE pragma"
886 hsSigDoc (XSig {}) = text "XSIG TTG extension"
887
888 -- | Extracts the name for a SPECIALIZE instance pragma. In 'hsSigDoc', the src
889 -- field of 'SpecInstSig' signature contains the SourceText for a SPECIALIZE
890 -- instance pragma of the form: "SourceText {-# SPECIALIZE"
891 --
892 -- Extraction ensures that all variants of the pragma name (with a 'Z' or an
893 -- 'S') are output exactly as used in the pragma.
894 extractSpecPragName :: SourceText -> String
895 extractSpecPragName srcTxt = case (words $ show srcTxt) of
896 (_:_:pragName:_) -> filter (/= '\"') pragName
897 _ -> pprPanic "hsSigDoc: Misformed SPECIALISE instance pragma:" (ppr srcTxt)
898
899 {-
900 ************************************************************************
901 * *
902 \subsection[PatSynBind]{A pattern synonym definition}
903 * *
904 ************************************************************************
905 -}
906
907 -- | Haskell Pattern Synonym Details
908 type HsPatSynDetails pass = HsConDetails Void (LIdP pass) [RecordPatSynField pass]
909
910 -- See Note [Record PatSyn Fields]
911 -- | Record Pattern Synonym Field
912 data RecordPatSynField pass
913 = RecordPatSynField
914 { recordPatSynField :: FieldOcc pass
915 -- ^ Field label visible in rest of the file
916 , recordPatSynPatVar :: LIdP pass
917 -- ^ Filled in by renamer, the name used internally by the pattern
918 }
919
920
921 {-
922 Note [Record PatSyn Fields]
923 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
924
925 Consider the following two pattern synonyms.
926
927 pattern P x y = ([x,True], [y,'v'])
928 pattern Q{ x, y } =([x,True], [y,'v'])
929
930 In P, we just have two local binders, x and y.
931
932 In Q, we have local binders but also top-level record selectors
933 x :: ([Bool], [Char]) -> Bool
934 y :: ([Bool], [Char]) -> Char
935
936 Both are recorded in the `RecordPatSynField`s for `x` and `y`:
937 * recordPatSynField: the top-level record selector
938 * recordPatSynPatVar: the local `x`, bound only in the RHS of the pattern synonym.
939
940 It would make sense to support record-like syntax
941
942 pattern Q{ x=x1, y=y1 } = ([x1,True], [y1,'v'])
943
944 when we have a different name for the local and top-level binder,
945 making the distinction between the two names clear.
946
947 -}
948 instance Outputable (XRec a RdrName) => Outputable (RecordPatSynField a) where
949 ppr (RecordPatSynField { recordPatSynField = v }) = ppr v
950
951
952 -- | Haskell Pattern Synonym Direction
953 data HsPatSynDir id
954 = Unidirectional
955 | ImplicitBidirectional
956 | ExplicitBidirectional (MatchGroup id (LHsExpr id))