Fix CONLIKE typo
[ghc.git] / compiler / hsSyn / HsBinds.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[HsBinds]{Abstract syntax: top-level bindings and signatures}
6
7 Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
8 -}
9
10 {-# LANGUAGE DeriveDataTypeable #-}
11 {-# LANGUAGE DeriveFunctor #-}
12 {-# LANGUAGE StandaloneDeriving #-}
13 {-# LANGUAGE FlexibleContexts #-}
14 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
15 -- in module PlaceHolder
16 {-# LANGUAGE ConstraintKinds #-}
17 {-# LANGUAGE BangPatterns #-}
18 {-# LANGUAGE TypeFamilies #-}
19
20 module HsBinds where
21
22 import GhcPrelude
23
24 import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,
25 MatchGroup, pprFunBind,
26 GRHSs, pprPatBind )
27 import {-# SOURCE #-} HsPat ( LPat )
28
29 import HsExtension
30 import HsTypes
31 import CoreSyn
32 import TcEvidence
33 import Type
34 import NameSet
35 import BasicTypes
36 import Outputable
37 import SrcLoc
38 import Var
39 import Bag
40 import FastString
41 import BooleanFormula (LBooleanFormula)
42 import DynFlags
43
44 import Data.Data hiding ( Fixity )
45 import Data.List hiding ( foldr )
46 import Data.Ord
47
48 {-
49 ************************************************************************
50 * *
51 \subsection{Bindings: @BindGroup@}
52 * *
53 ************************************************************************
54
55 Global bindings (where clauses)
56 -}
57
58 -- During renaming, we need bindings where the left-hand sides
59 -- have been renamed but the right-hand sides have not.
60 -- the ...LR datatypes are parametrized by two id types,
61 -- one for the left and one for the right.
62 -- Other than during renaming, these will be the same.
63
64 -- | Haskell Local Bindings
65 type HsLocalBinds id = HsLocalBindsLR id id
66
67 -- | Located Haskell local bindings
68 type LHsLocalBinds id = Located (HsLocalBinds id)
69
70 -- | Haskell Local Bindings with separate Left and Right identifier types
71 --
72 -- Bindings in a 'let' expression
73 -- or a 'where' clause
74 data HsLocalBindsLR idL idR
75 = HsValBinds
76 (XHsValBinds idL idR)
77 (HsValBindsLR idL idR)
78 -- ^ Haskell Value Bindings
79
80 -- There should be no pattern synonyms in the HsValBindsLR
81 -- These are *local* (not top level) bindings
82 -- The parser accepts them, however, leaving the
83 -- renamer to report them
84
85 | HsIPBinds
86 (XHsIPBinds idL idR)
87 (HsIPBinds idR)
88 -- ^ Haskell Implicit Parameter Bindings
89
90 | EmptyLocalBinds (XEmptyLocalBinds idL idR)
91 -- ^ Empty Local Bindings
92
93 | XHsLocalBindsLR
94 (XXHsLocalBindsLR idL idR)
95
96 type instance XHsValBinds (GhcPass pL) (GhcPass pR) = NoExtField
97 type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = NoExtField
98 type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField
99 type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
100
101 type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
102
103
104 -- | Haskell Value Bindings
105 type HsValBinds id = HsValBindsLR id id
106
107 -- | Haskell Value bindings with separate Left and Right identifier types
108 -- (not implicit parameters)
109 -- Used for both top level and nested bindings
110 -- May contain pattern synonym bindings
111 data HsValBindsLR idL idR
112 = -- | Value Bindings In
113 --
114 -- Before renaming RHS; idR is always RdrName
115 -- Not dependency analysed
116 -- Recursive by default
117 ValBinds
118 (XValBinds idL idR)
119 (LHsBindsLR idL idR) [LSig idR]
120
121 -- | Value Bindings Out
122 --
123 -- After renaming RHS; idR can be Name or Id Dependency analysed,
124 -- later bindings in the list may depend on earlier ones.
125 | XValBindsLR
126 (XXValBindsLR idL idR)
127
128 -- ---------------------------------------------------------------------
129 -- Deal with ValBindsOut
130
131 -- TODO: make this the only type for ValBinds
132 data NHsValBindsLR idL
133 = NValBinds
134 [(RecFlag, LHsBinds idL)]
135 [LSig GhcRn]
136
137 type instance XValBinds (GhcPass pL) (GhcPass pR) = NoExtField
138 type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
139 = NHsValBindsLR (GhcPass pL)
140
141 -- ---------------------------------------------------------------------
142
143 -- | Located Haskell Binding
144 type LHsBind id = LHsBindLR id id
145
146 -- | Located Haskell Bindings
147 type LHsBinds id = LHsBindsLR id id
148
149 -- | Haskell Binding
150 type HsBind id = HsBindLR id id
151
152 -- | Located Haskell Bindings with separate Left and Right identifier types
153 type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
154
155 -- | Located Haskell Binding with separate Left and Right identifier types
156 type LHsBindLR idL idR = Located (HsBindLR idL idR)
157
158 {- Note [FunBind vs PatBind]
159 ~~~~~~~~~~~~~~~~~~~~~~~~~
160 The distinction between FunBind and PatBind is a bit subtle. FunBind covers
161 patterns which resemble function bindings and simple variable bindings.
162
163 f x = e
164 f !x = e
165 f = e
166 !x = e -- FunRhs has SrcStrict
167 x `f` y = e -- FunRhs has Infix
168
169 The actual patterns and RHSs of a FunBind are encoding in fun_matches.
170 The m_ctxt field of each Match in fun_matches will be FunRhs and carries
171 two bits of information about the match,
172
173 * The mc_fixity field on each Match describes the fixity of the
174 function binder in that match. E.g. this is legal:
175 f True False = e1
176 True `f` True = e2
177
178 * The mc_strictness field is used /only/ for nullary FunBinds: ones
179 with one Match, which has no pats. For these, it describes whether
180 the match is decorated with a bang (e.g. `!x = e`).
181
182 By contrast, PatBind represents data constructor patterns, as well as a few
183 other interesting cases. Namely,
184
185 Just x = e
186 (x) = e
187 x :: Ty = e
188 -}
189
190 -- | Haskell Binding with separate Left and Right id's
191 data HsBindLR idL idR
192 = -- | Function-like Binding
193 --
194 -- FunBind is used for both functions @f x = e@
195 -- and variables @f = \x -> e@
196 -- and strict variables @!x = x + 1@
197 --
198 -- Reason 1: Special case for type inference: see 'TcBinds.tcMonoBinds'.
199 --
200 -- Reason 2: Instance decls can only have FunBinds, which is convenient.
201 -- If you change this, you'll need to change e.g. rnMethodBinds
202 --
203 -- But note that the form @f :: a->a = ...@
204 -- parses as a pattern binding, just like
205 -- @(f :: a -> a) = ... @
206 --
207 -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their
208 -- 'MatchContext'. See Note [FunBind vs PatBind] for
209 -- details about the relationship between FunBind and PatBind.
210 --
211 -- 'ApiAnnotation.AnnKeywordId's
212 --
213 -- - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches
214 --
215 -- - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
216 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
217
218 -- For details on above see note [Api annotations] in ApiAnnotation
219 FunBind {
220
221 fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains
222 -- the locally-bound
223 -- free variables of this defn.
224 -- See Note [Bind free vars]
225
226 fun_id :: Located (IdP idL), -- Note [fun_id in Match] in HsExpr
227
228 fun_matches :: MatchGroup idR (LHsExpr idR), -- ^ The payload
229
230 fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of
231 -- the Id. Example:
232 --
233 -- @
234 -- f :: Int -> forall a. a -> a
235 -- f x y = y
236 -- @
237 --
238 -- Then the MatchGroup will have type (Int -> a' -> a')
239 -- (with a free type variable a'). The coercion will take
240 -- a CoreExpr of this type and convert it to a CoreExpr of
241 -- type Int -> forall a'. a' -> a'
242 -- Notice that the coercion captures the free a'.
243
244 fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any
245 }
246
247 -- | Pattern Binding
248 --
249 -- The pattern is never a simple variable;
250 -- That case is done by FunBind.
251 -- See Note [FunBind vs PatBind] for details about the
252 -- relationship between FunBind and PatBind.
253
254 --
255 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',
256 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
257 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
258
259 -- For details on above see note [Api annotations] in ApiAnnotation
260 | PatBind {
261 pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars]
262 pat_lhs :: LPat idL,
263 pat_rhs :: GRHSs idR (LHsExpr idR),
264 pat_ticks :: ([Tickish Id], [[Tickish Id]])
265 -- ^ Ticks to put on the rhs, if any, and ticks to put on
266 -- the bound variables.
267 }
268
269 -- | Variable Binding
270 --
271 -- Dictionary binding and suchlike.
272 -- All VarBinds are introduced by the type checker
273 | VarBind {
274 var_ext :: XVarBind idL idR,
275 var_id :: IdP idL,
276 var_rhs :: LHsExpr idR, -- ^ Located only for consistency
277 var_inline :: Bool -- ^ True <=> inline this binding regardless
278 -- (used for implication constraints only)
279 }
280
281 -- | Abstraction Bindings
282 | AbsBinds { -- Binds abstraction; TRANSLATION
283 abs_ext :: XAbsBinds idL idR,
284 abs_tvs :: [TyVar],
285 abs_ev_vars :: [EvVar], -- ^ Includes equality constraints
286
287 -- | AbsBinds only gets used when idL = idR after renaming,
288 -- but these need to be idL's for the collect... code in HsUtil
289 -- to have the right type
290 abs_exports :: [ABExport idL],
291
292 -- | Evidence bindings
293 -- Why a list? See TcInstDcls
294 -- Note [Typechecking plan for instance declarations]
295 abs_ev_binds :: [TcEvBinds],
296
297 -- | Typechecked user bindings
298 abs_binds :: LHsBinds idL,
299
300 abs_sig :: Bool -- See Note [The abs_sig field of AbsBinds]
301 }
302
303 -- | Patterns Synonym Binding
304 | PatSynBind
305 (XPatSynBind idL idR)
306 (PatSynBind idL idR)
307 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
308 -- 'ApiAnnotation.AnnLarrow','ApiAnnotation.AnnEqual',
309 -- 'ApiAnnotation.AnnWhere'
310 -- 'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@
311
312 -- For details on above see note [Api annotations] in ApiAnnotation
313
314 | XHsBindsLR (XXHsBindsLR idL idR)
315
316 data NPatBindTc = NPatBindTc {
317 pat_fvs :: NameSet, -- ^ Free variables
318 pat_rhs_ty :: Type -- ^ Type of the GRHSs
319 } deriving Data
320
321 type instance XFunBind (GhcPass pL) GhcPs = NoExtField
322 type instance XFunBind (GhcPass pL) GhcRn = NameSet -- Free variables
323 type instance XFunBind (GhcPass pL) GhcTc = NameSet -- Free variables
324
325 type instance XPatBind GhcPs (GhcPass pR) = NoExtField
326 type instance XPatBind GhcRn (GhcPass pR) = NameSet -- Free variables
327 type instance XPatBind GhcTc (GhcPass pR) = NPatBindTc
328
329 type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExtField
330 type instance XAbsBinds (GhcPass pL) (GhcPass pR) = NoExtField
331 type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField
332 type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
333
334
335 -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
336 --
337 -- Creates bindings for (polymorphic, overloaded) poly_f
338 -- in terms of monomorphic, non-overloaded mono_f
339 --
340 -- Invariants:
341 -- 1. 'binds' binds mono_f
342 -- 2. ftvs is a subset of tvs
343 -- 3. ftvs includes all tyvars free in ds
344 --
345 -- See Note [AbsBinds]
346
347 -- | Abtraction Bindings Export
348 data ABExport p
349 = ABE { abe_ext :: XABE p
350 , abe_poly :: IdP p -- ^ Any INLINE pragma is attached to this Id
351 , abe_mono :: IdP p
352 , abe_wrap :: HsWrapper -- ^ See Note [ABExport wrapper]
353 -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
354 , abe_prags :: TcSpecPrags -- ^ SPECIALISE pragmas
355 }
356 | XABExport (XXABExport p)
357
358 type instance XABE (GhcPass p) = NoExtField
359 type instance XXABExport (GhcPass p) = NoExtCon
360
361
362 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
363 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'
364 -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,
365 -- 'ApiAnnotation.AnnClose' @'}'@,
366
367 -- For details on above see note [Api annotations] in ApiAnnotation
368
369 -- | Pattern Synonym binding
370 data PatSynBind idL idR
371 = PSB { psb_ext :: XPSB idL idR, -- ^ Post renaming, FVs.
372 -- See Note [Bind free vars]
373 psb_id :: Located (IdP idL), -- ^ Name of the pattern synonym
374 psb_args :: HsPatSynDetails (Located (IdP idR)),
375 -- ^ Formal parameter names
376 psb_def :: LPat idR, -- ^ Right-hand side
377 psb_dir :: HsPatSynDir idR -- ^ Directionality
378 }
379 | XPatSynBind (XXPatSynBind idL idR)
380
381 type instance XPSB (GhcPass idL) GhcPs = NoExtField
382 type instance XPSB (GhcPass idL) GhcRn = NameSet
383 type instance XPSB (GhcPass idL) GhcTc = NameSet
384
385 type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon
386
387 {-
388 Note [AbsBinds]
389 ~~~~~~~~~~~~~~~
390 The AbsBinds constructor is used in the output of the type checker, to
391 record *typechecked* and *generalised* bindings. Specifically
392
393 AbsBinds { abs_tvs = tvs
394 , abs_ev_vars = [d1,d2]
395 , abs_exports = [ABE { abe_poly = fp, abe_mono = fm
396 , abe_wrap = fwrap }
397 ABE { slly for g } ]
398 , abs_ev_binds = DBINDS
399 , abs_binds = BIND[fm,gm] }
400
401 where 'BIND' binds the monomorphic Ids 'fm' and 'gm', means
402
403 fp = fwrap [/\ tvs. \d1 d2. letrec { DBINDS ]
404 [ ; BIND[fm,gm] } ]
405 [ in fm ]
406
407 gp = ...same again, with gm instead of fm
408
409 The 'fwrap' is an impedence-matcher that typically does nothing; see
410 Note [ABExport wrapper].
411
412 This is a pretty bad translation, because it duplicates all the bindings.
413 So the desugarer tries to do a better job:
414
415 fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
416 (fm,gm) -> fm
417 ..ditto for gp..
418
419 tp = /\ [a,b] -> \ [d1,d2] -> letrec { DBINDS; BIND }
420 in (fm,gm)
421
422 In general:
423
424 * abs_tvs are the type variables over which the binding group is
425 generalised
426 * abs_ev_var are the evidence variables (usually dictionaries)
427 over which the binding group is generalised
428 * abs_binds are the monomorphic bindings
429 * abs_ex_binds are the evidence bindings that wrap the abs_binds
430 * abs_exports connects the monomorphic Ids bound by abs_binds
431 with the polymorphic Ids bound by the AbsBinds itself.
432
433 For example, consider a module M, with this top-level binding, where
434 there is no type signature for M.reverse,
435 M.reverse [] = []
436 M.reverse (x:xs) = M.reverse xs ++ [x]
437
438 In Hindley-Milner, a recursive binding is typechecked with the
439 *recursive* uses being *monomorphic*. So after typechecking *and*
440 desugaring we will get something like this
441
442 M.reverse :: forall a. [a] -> [a]
443 = /\a. letrec
444 reverse :: [a] -> [a] = \xs -> case xs of
445 [] -> []
446 (x:xs) -> reverse xs ++ [x]
447 in reverse
448
449 Notice that 'M.reverse' is polymorphic as expected, but there is a local
450 definition for plain 'reverse' which is *monomorphic*. The type variable
451 'a' scopes over the entire letrec.
452
453 That's after desugaring. What about after type checking but before
454 desugaring? That's where AbsBinds comes in. It looks like this:
455
456 AbsBinds { abs_tvs = [a]
457 , abs_ev_vars = []
458 , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],
459 , abe_mono = reverse :: [a] -> [a]}]
460 , abs_ev_binds = {}
461 , abs_binds = { reverse :: [a] -> [a]
462 = \xs -> case xs of
463 [] -> []
464 (x:xs) -> reverse xs ++ [x] } }
465
466 Here,
467
468 * abs_tvs says what type variables are abstracted over the binding
469 group, just 'a' in this case.
470 * abs_binds is the *monomorphic* bindings of the group
471 * abs_exports describes how to get the polymorphic Id 'M.reverse'
472 from the monomorphic one 'reverse'
473
474 Notice that the *original* function (the polymorphic one you thought
475 you were defining) appears in the abe_poly field of the
476 abs_exports. The bindings in abs_binds are for fresh, local, Ids with
477 a *monomorphic* Id.
478
479 If there is a group of mutually recursive (see Note [Polymorphic
480 recursion]) functions without type signatures, we get one AbsBinds
481 with the monomorphic versions of the bindings in abs_binds, and one
482 element of abe_exports for each variable bound in the mutually
483 recursive group. This is true even for pattern bindings. Example:
484 (f,g) = (\x -> x, f)
485 After type checking we get
486 AbsBinds { abs_tvs = [a]
487 , abs_exports = [ ABE { abe_poly = M.f :: forall a. a -> a
488 , abe_mono = f :: a -> a }
489 , ABE { abe_poly = M.g :: forall a. a -> a
490 , abe_mono = g :: a -> a }]
491 , abs_binds = { (f,g) = (\x -> x, f) }
492
493 Note [Polymorphic recursion]
494 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
495 Consider
496 Rec { f x = ...(g ef)...
497
498 ; g :: forall a. [a] -> [a]
499 ; g y = ...(f eg)... }
500
501 These bindings /are/ mutually recursive (f calls g, and g calls f).
502 But we can use the type signature for g to break the recursion,
503 like this:
504
505 1. Add g :: forall a. [a] -> [a] to the type environment
506
507 2. Typecheck the definition of f, all by itself,
508 including generalising it to find its most general
509 type, say f :: forall b. b -> b -> [b]
510
511 3. Extend the type environment with that type for f
512
513 4. Typecheck the definition of g, all by itself,
514 checking that it has the type claimed by its signature
515
516 Steps 2 and 4 each generate a separate AbsBinds, so we end
517 up with
518 Rec { AbsBinds { ...for f ... }
519 ; AbsBinds { ...for g ... } }
520
521 This approach allows both f and to call each other
522 polymorphically, even though only g has a signature.
523
524 We get an AbsBinds that encompasses multiple source-program
525 bindings only when
526 * Each binding in the group has at least one binder that
527 lacks a user type signature
528 * The group forms a strongly connected component
529
530
531 Note [The abs_sig field of AbsBinds]
532 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
533 The abs_sig field supports a couple of special cases for bindings.
534 Consider
535
536 x :: Num a => (# a, a #)
537 x = (# 3, 4 #)
538
539 The general desugaring for AbsBinds would give
540
541 x = /\a. \ ($dNum :: Num a) ->
542 letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in
543 xm
544
545 But that has an illegal let-binding for an unboxed tuple. In this
546 case we'd prefer to generate the (more direct)
547
548 x = /\ a. \ ($dNum :: Num a) ->
549 (# fromInteger $dNum 3, fromInteger $dNum 4 #)
550
551 A similar thing happens with representation-polymorphic defns
552 (#11405):
553
554 undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
555 undef = error "undef"
556
557 Again, the vanilla desugaring gives a local let-binding for a
558 representation-polymorphic (undefm :: a), which is illegal. But
559 again we can desugar without a let:
560
561 undef = /\ a. \ (d:HasCallStack) -> error a d "undef"
562
563 The abs_sig field supports this direct desugaring, with no local
564 let-bining. When abs_sig = True
565
566 * the abs_binds is single FunBind
567
568 * the abs_exports is a singleton
569
570 * we have a complete type sig for binder
571 and hence the abs_binds is non-recursive
572 (it binds the mono_id but refers to the poly_id
573
574 These properties are exploited in DsBinds.dsAbsBinds to
575 generate code without a let-binding.
576
577 Note [ABExport wrapper]
578 ~~~~~~~~~~~~~~~~~~~~~~~
579 Consider
580 (f,g) = (\x.x, \y.y)
581 This ultimately desugars to something like this:
582 tup :: forall a b. (a->a, b->b)
583 tup = /\a b. (\x:a.x, \y:b.y)
584 f :: forall a. a -> a
585 f = /\a. case tup a Any of
586 (fm::a->a,gm:Any->Any) -> fm
587 ...similarly for g...
588
589 The abe_wrap field deals with impedance-matching between
590 (/\a b. case tup a b of { (f,g) -> f })
591 and the thing we really want, which may have fewer type
592 variables. The action happens in TcBinds.mkExport.
593
594 Note [Bind free vars]
595 ~~~~~~~~~~~~~~~~~~~~~
596 The bind_fvs field of FunBind and PatBind records the free variables
597 of the definition. It is used for the following purposes
598
599 a) Dependency analysis prior to type checking
600 (see TcBinds.tc_group)
601
602 b) Deciding whether we can do generalisation of the binding
603 (see TcBinds.decideGeneralisationPlan)
604
605 c) Deciding whether the binding can be used in static forms
606 (see TcExpr.checkClosedInStaticForm for the HsStatic case and
607 TcBinds.isClosedBndrGroup).
608
609 Specifically,
610
611 * bind_fvs includes all free vars that are defined in this module
612 (including top-level things and lexically scoped type variables)
613
614 * bind_fvs excludes imported vars; this is just to keep the set smaller
615
616 * Before renaming, and after typechecking, the field is unused;
617 it's just an error thunk
618 -}
619
620 instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
621 OutputableBndrId idL, OutputableBndrId idR)
622 => Outputable (HsLocalBindsLR idL idR) where
623 ppr (HsValBinds _ bs) = ppr bs
624 ppr (HsIPBinds _ bs) = ppr bs
625 ppr (EmptyLocalBinds _) = empty
626 ppr (XHsLocalBindsLR x) = ppr x
627
628 instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
629 OutputableBndrId idL, OutputableBndrId idR)
630 => Outputable (HsValBindsLR idL idR) where
631 ppr (ValBinds _ binds sigs)
632 = pprDeclList (pprLHsBindsForUser binds sigs)
633
634 ppr (XValBindsLR (NValBinds sccs sigs))
635 = getPprStyle $ \ sty ->
636 if debugStyle sty then -- Print with sccs showing
637 vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
638 else
639 pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)
640 where
641 ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
642 pp_rec Recursive = text "rec"
643 pp_rec NonRecursive = text "nonrec"
644
645 pprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
646 => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
647 pprLHsBinds binds
648 | isEmptyLHsBinds binds = empty
649 | otherwise = pprDeclList (map ppr (bagToList binds))
650
651 pprLHsBindsForUser :: (OutputableBndrId (GhcPass idL),
652 OutputableBndrId (GhcPass idR),
653 OutputableBndrId (GhcPass id2))
654 => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]
655 -- pprLHsBindsForUser is different to pprLHsBinds because
656 -- a) No braces: 'let' and 'where' include a list of HsBindGroups
657 -- and we don't want several groups of bindings each
658 -- with braces around
659 -- b) Sort by location before printing
660 -- c) Include signatures
661 pprLHsBindsForUser binds sigs
662 = map snd (sort_by_loc decls)
663 where
664
665 decls :: [(SrcSpan, SDoc)]
666 decls = [(loc, ppr sig) | L loc sig <- sigs] ++
667 [(loc, ppr bind) | L loc bind <- bagToList binds]
668
669 sort_by_loc decls = sortBy (comparing fst) decls
670
671 pprDeclList :: [SDoc] -> SDoc -- Braces with a space
672 -- Print a bunch of declarations
673 -- One could choose { d1; d2; ... }, using 'sep'
674 -- or d1
675 -- d2
676 -- ..
677 -- using vcat
678 -- At the moment we chose the latter
679 -- Also we do the 'pprDeeperList' thing.
680 pprDeclList ds = pprDeeperList vcat ds
681
682 ------------
683 emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
684 emptyLocalBinds = EmptyLocalBinds noExtField
685
686 -- AZ:These functions do not seem to be used at all?
687 isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
688 isEmptyLocalBindsTc (HsValBinds _ ds) = isEmptyValBinds ds
689 isEmptyLocalBindsTc (HsIPBinds _ ds) = isEmptyIPBindsTc ds
690 isEmptyLocalBindsTc (EmptyLocalBinds _) = True
691 isEmptyLocalBindsTc (XHsLocalBindsLR _) = True
692
693 isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
694 isEmptyLocalBindsPR (HsValBinds _ ds) = isEmptyValBinds ds
695 isEmptyLocalBindsPR (HsIPBinds _ ds) = isEmptyIPBindsPR ds
696 isEmptyLocalBindsPR (EmptyLocalBinds _) = True
697 isEmptyLocalBindsPR (XHsLocalBindsLR _) = True
698
699 eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
700 eqEmptyLocalBinds (EmptyLocalBinds _) = True
701 eqEmptyLocalBinds _ = False
702
703 isEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
704 isEmptyValBinds (ValBinds _ ds sigs) = isEmptyLHsBinds ds && null sigs
705 isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs
706
707 emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
708 emptyValBindsIn = ValBinds noExtField emptyBag []
709 emptyValBindsOut = XValBindsLR (NValBinds [] [])
710
711 emptyLHsBinds :: LHsBindsLR idL idR
712 emptyLHsBinds = emptyBag
713
714 isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
715 isEmptyLHsBinds = isEmptyBag
716
717 ------------
718 plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
719 -> HsValBinds(GhcPass a)
720 plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)
721 = ValBinds noExtField (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
722 plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
723 (XValBindsLR (NValBinds ds2 sigs2))
724 = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))
725 plusHsValBinds _ _
726 = panic "HsBinds.plusHsValBinds"
727
728 instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
729 OutputableBndrId idL, OutputableBndrId idR)
730 => Outputable (HsBindLR idL idR) where
731 ppr mbind = ppr_monobind mbind
732
733 ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
734 => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
735
736 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
737 = pprPatBind pat grhss
738 ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
739 = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
740 ppr_monobind (FunBind { fun_id = fun,
741 fun_co_fn = wrap,
742 fun_matches = matches,
743 fun_tick = ticks })
744 = pprTicks empty (if null ticks then empty
745 else text "-- ticks = " <> ppr ticks)
746 $$ whenPprDebug (pprBndr LetBind (unLoc fun))
747 $$ pprFunBind matches
748 $$ whenPprDebug (ppr wrap)
749 ppr_monobind (PatSynBind _ psb) = ppr psb
750 ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
751 , abs_exports = exports, abs_binds = val_binds
752 , abs_ev_binds = ev_binds })
753 = sdocWithDynFlags $ \ dflags ->
754 if gopt Opt_PrintTypecheckerElaboration dflags then
755 -- Show extra information (bug number: #10662)
756 hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)
757 <+> brackets (interpp'SP dictvars))
758 2 $ braces $ vcat
759 [ text "Exports:" <+>
760 brackets (sep (punctuate comma (map ppr exports)))
761 , text "Exported types:" <+>
762 vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
763 , text "Binds:" <+> pprLHsBinds val_binds
764 , text "Evidence:" <+> ppr ev_binds ]
765 else
766 pprLHsBinds val_binds
767 ppr_monobind (XHsBindsLR x) = ppr x
768
769 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where
770 ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
771 = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
772 , nest 2 (pprTcSpecPrags prags)
773 , nest 2 (text "wrap:" <+> ppr wrap)]
774 ppr (XABExport x) = ppr x
775
776 instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR,
777 Outputable (XXPatSynBind idL idR))
778 => Outputable (PatSynBind idL idR) where
779 ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,
780 psb_dir = dir })
781 = ppr_lhs <+> ppr_rhs
782 where
783 ppr_lhs = text "pattern" <+> ppr_details
784 ppr_simple syntax = syntax <+> ppr pat
785
786 ppr_details = case details of
787 InfixCon v1 v2 -> hsep [ppr v1, pprInfixOcc psyn, ppr v2]
788 PrefixCon vs -> hsep (pprPrefixOcc psyn : map ppr vs)
789 RecCon vs -> pprPrefixOcc psyn
790 <> braces (sep (punctuate comma (map ppr vs)))
791
792 ppr_rhs = case dir of
793 Unidirectional -> ppr_simple (text "<-")
794 ImplicitBidirectional -> ppr_simple equals
795 ExplicitBidirectional mg -> ppr_simple (text "<-") <+> ptext (sLit "where") $$
796 (nest 2 $ pprFunBind mg)
797 ppr (XPatSynBind x) = ppr x
798
799 pprTicks :: SDoc -> SDoc -> SDoc
800 -- Print stuff about ticks only when -dppr-debug is on, to avoid
801 -- them appearing in error messages (from the desugarer); see # 3263
802 -- Also print ticks in dumpStyle, so that -ddump-hpc actually does
803 -- something useful.
804 pprTicks pp_no_debug pp_when_debug
805 = getPprStyle (\ sty -> if debugStyle sty || dumpStyle sty
806 then pp_when_debug
807 else pp_no_debug)
808
809 {-
810 ************************************************************************
811 * *
812 Implicit parameter bindings
813 * *
814 ************************************************************************
815 -}
816
817 -- | Haskell Implicit Parameter Bindings
818 data HsIPBinds id
819 = IPBinds
820 (XIPBinds id)
821 [LIPBind id]
822 -- TcEvBinds -- Only in typechecker output; binds
823 -- -- uses of the implicit parameters
824 | XHsIPBinds (XXHsIPBinds id)
825
826 type instance XIPBinds GhcPs = NoExtField
827 type instance XIPBinds GhcRn = NoExtField
828 type instance XIPBinds GhcTc = TcEvBinds -- binds uses of the
829 -- implicit parameters
830
831
832 type instance XXHsIPBinds (GhcPass p) = NoExtCon
833
834 isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
835 isEmptyIPBindsPR (IPBinds _ is) = null is
836 isEmptyIPBindsPR (XHsIPBinds _) = True
837
838 isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
839 isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds
840 isEmptyIPBindsTc (XHsIPBinds _) = True
841
842 -- | Located Implicit Parameter Binding
843 type LIPBind id = Located (IPBind id)
844 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
845 -- list
846
847 -- For details on above see note [Api annotations] in ApiAnnotation
848
849 -- | Implicit parameter bindings.
850 --
851 -- These bindings start off as (Left "x") in the parser and stay
852 -- that way until after type-checking when they are replaced with
853 -- (Right d), where "d" is the name of the dictionary holding the
854 -- evidence for the implicit parameter.
855 --
856 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
857
858 -- For details on above see note [Api annotations] in ApiAnnotation
859 data IPBind id
860 = IPBind
861 (XCIPBind id)
862 (Either (Located HsIPName) (IdP id))
863 (LHsExpr id)
864 | XIPBind (XXIPBind id)
865
866 type instance XCIPBind (GhcPass p) = NoExtField
867 type instance XXIPBind (GhcPass p) = NoExtCon
868
869 instance (p ~ GhcPass pass, OutputableBndrId p)
870 => Outputable (HsIPBinds p) where
871 ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs)
872 $$ whenPprDebug (ppr ds)
873 ppr (XHsIPBinds x) = ppr x
874
875 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where
876 ppr (IPBind _ lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)
877 where name = case lr of
878 Left (L _ ip) -> pprBndr LetBind ip
879 Right id -> pprBndr LetBind id
880 ppr (XIPBind x) = ppr x
881
882 {-
883 ************************************************************************
884 * *
885 \subsection{@Sig@: type signatures and value-modifying user pragmas}
886 * *
887 ************************************************************************
888
889 It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
890 ``specialise this function to these four types...'') in with type
891 signatures. Then all the machinery to move them into place, etc.,
892 serves for both.
893 -}
894
895 -- | Located Signature
896 type LSig pass = Located (Sig pass)
897
898 -- | Signatures and pragmas
899 data Sig pass
900 = -- | An ordinary type signature
901 --
902 -- > f :: Num a => a -> a
903 --
904 -- After renaming, this list of Names contains the named
905 -- wildcards brought into scope by this signature. For a signature
906 -- @_ -> _a -> Bool@, the renamer will leave the unnamed wildcard @_@
907 -- untouched, and the named wildcard @_a@ is then replaced with
908 -- fresh meta vars in the type. Their names are stored in the type
909 -- signature that brought them into scope, in this third field to be
910 -- more specific.
911 --
912 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',
913 -- 'ApiAnnotation.AnnComma'
914
915 -- For details on above see note [Api annotations] in ApiAnnotation
916 TypeSig
917 (XTypeSig pass)
918 [Located (IdP pass)] -- LHS of the signature; e.g. f,g,h :: blah
919 (LHsSigWcType pass) -- RHS of the signature; can have wildcards
920
921 -- | A pattern synonym type signature
922 --
923 -- > pattern Single :: () => (Show a) => a -> [a]
924 --
925 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
926 -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'
927 -- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
928
929 -- For details on above see note [Api annotations] in ApiAnnotation
930 | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)
931 -- P :: forall a b. Req => Prov => ty
932
933 -- | A signature for a class method
934 -- False: ordinary class-method signature
935 -- True: generic-default class method signature
936 -- e.g. class C a where
937 -- op :: a -> a -- Ordinary
938 -- default op :: Eq a => a -> a -- Generic default
939 -- No wildcards allowed here
940 --
941 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',
942 -- 'ApiAnnotation.AnnDcolon'
943 | ClassOpSig (XClassOpSig pass) Bool [Located (IdP pass)] (LHsSigType pass)
944
945 -- | A type signature in generated code, notably the code
946 -- generated for record selectors. We simply record
947 -- the desired Id itself, replete with its name, type
948 -- and IdDetails. Otherwise it's just like a type
949 -- signature: there should be an accompanying binding
950 | IdSig (XIdSig pass) Id
951
952 -- | An ordinary fixity declaration
953 --
954 -- > infixl 8 ***
955 --
956 --
957 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',
958 -- 'ApiAnnotation.AnnVal'
959
960 -- For details on above see note [Api annotations] in ApiAnnotation
961 | FixSig (XFixSig pass) (FixitySig pass)
962
963 -- | An inline pragma
964 --
965 -- > {#- INLINE f #-}
966 --
967 -- - 'ApiAnnotation.AnnKeywordId' :
968 -- 'ApiAnnotation.AnnOpen' @'{-\# INLINE'@ and @'['@,
969 -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnOpen',
970 -- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde',
971 -- 'ApiAnnotation.AnnClose'
972
973 -- For details on above see note [Api annotations] in ApiAnnotation
974 | InlineSig (XInlineSig pass)
975 (Located (IdP pass)) -- Function name
976 InlinePragma -- Never defaultInlinePragma
977
978 -- | A specialisation pragma
979 --
980 -- > {-# SPECIALISE f :: Int -> Int #-}
981 --
982 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
983 -- 'ApiAnnotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,
984 -- 'ApiAnnotation.AnnTilde',
985 -- 'ApiAnnotation.AnnVal',
986 -- 'ApiAnnotation.AnnClose' @']'@ and @'\#-}'@,
987 -- 'ApiAnnotation.AnnDcolon'
988
989 -- For details on above see note [Api annotations] in ApiAnnotation
990 | SpecSig (XSpecSig pass)
991 (Located (IdP pass)) -- Specialise a function or datatype ...
992 [LHsSigType pass] -- ... to these types
993 InlinePragma -- The pragma on SPECIALISE_INLINE form.
994 -- If it's just defaultInlinePragma, then we said
995 -- SPECIALISE, not SPECIALISE_INLINE
996
997 -- | A specialisation pragma for instance declarations only
998 --
999 -- > {-# SPECIALISE instance Eq [Int] #-}
1000 --
1001 -- (Class tys); should be a specialisation of the
1002 -- current instance declaration
1003 --
1004 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1005 -- 'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'
1006
1007 -- For details on above see note [Api annotations] in ApiAnnotation
1008 | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
1009 -- Note [Pragma source text] in BasicTypes
1010
1011 -- | A minimal complete definition pragma
1012 --
1013 -- > {-# MINIMAL a | (b, c | (d | e)) #-}
1014 --
1015 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1016 -- 'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma',
1017 -- 'ApiAnnotation.AnnClose'
1018
1019 -- For details on above see note [Api annotations] in ApiAnnotation
1020 | MinimalSig (XMinimalSig pass)
1021 SourceText (LBooleanFormula (Located (IdP pass)))
1022 -- Note [Pragma source text] in BasicTypes
1023
1024 -- | A "set cost centre" pragma for declarations
1025 --
1026 -- > {-# SCC funName #-}
1027 --
1028 -- or
1029 --
1030 -- > {-# SCC funName "cost_centre_name" #-}
1031
1032 | SCCFunSig (XSCCFunSig pass)
1033 SourceText -- Note [Pragma source text] in BasicTypes
1034 (Located (IdP pass)) -- Function name
1035 (Maybe (Located StringLiteral))
1036 -- | A complete match pragma
1037 --
1038 -- > {-# COMPLETE C, D [:: T] #-}
1039 --
1040 -- Used to inform the pattern match checker about additional
1041 -- complete matchings which, for example, arise from pattern
1042 -- synonym definitions.
1043 | CompleteMatchSig (XCompleteMatchSig pass)
1044 SourceText
1045 (Located [Located (IdP pass)])
1046 (Maybe (Located (IdP pass)))
1047 | XSig (XXSig pass)
1048
1049 type instance XTypeSig (GhcPass p) = NoExtField
1050 type instance XPatSynSig (GhcPass p) = NoExtField
1051 type instance XClassOpSig (GhcPass p) = NoExtField
1052 type instance XIdSig (GhcPass p) = NoExtField
1053 type instance XFixSig (GhcPass p) = NoExtField
1054 type instance XInlineSig (GhcPass p) = NoExtField
1055 type instance XSpecSig (GhcPass p) = NoExtField
1056 type instance XSpecInstSig (GhcPass p) = NoExtField
1057 type instance XMinimalSig (GhcPass p) = NoExtField
1058 type instance XSCCFunSig (GhcPass p) = NoExtField
1059 type instance XCompleteMatchSig (GhcPass p) = NoExtField
1060 type instance XXSig (GhcPass p) = NoExtCon
1061
1062 -- | Located Fixity Signature
1063 type LFixitySig pass = Located (FixitySig pass)
1064
1065 -- | Fixity Signature
1066 data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity
1067 | XFixitySig (XXFixitySig pass)
1068
1069 type instance XFixitySig (GhcPass p) = NoExtField
1070 type instance XXFixitySig (GhcPass p) = NoExtCon
1071
1072 -- | Type checker Specialisation Pragmas
1073 --
1074 -- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer
1075 data TcSpecPrags
1076 = IsDefaultMethod -- ^ Super-specialised: a default method should
1077 -- be macro-expanded at every call site
1078 | SpecPrags [LTcSpecPrag]
1079 deriving Data
1080
1081 -- | Located Type checker Specification Pragmas
1082 type LTcSpecPrag = Located TcSpecPrag
1083
1084 -- | Type checker Specification Pragma
1085 data TcSpecPrag
1086 = SpecPrag
1087 Id
1088 HsWrapper
1089 InlinePragma
1090 -- ^ The Id to be specialised, a wrapper that specialises the
1091 -- polymorphic function, and inlining spec for the specialised function
1092 deriving Data
1093
1094 noSpecPrags :: TcSpecPrags
1095 noSpecPrags = SpecPrags []
1096
1097 hasSpecPrags :: TcSpecPrags -> Bool
1098 hasSpecPrags (SpecPrags ps) = not (null ps)
1099 hasSpecPrags IsDefaultMethod = False
1100
1101 isDefaultMethod :: TcSpecPrags -> Bool
1102 isDefaultMethod IsDefaultMethod = True
1103 isDefaultMethod (SpecPrags {}) = False
1104
1105
1106 isFixityLSig :: LSig name -> Bool
1107 isFixityLSig (L _ (FixSig {})) = True
1108 isFixityLSig _ = False
1109
1110 isTypeLSig :: LSig name -> Bool -- Type signatures
1111 isTypeLSig (L _(TypeSig {})) = True
1112 isTypeLSig (L _(ClassOpSig {})) = True
1113 isTypeLSig (L _(IdSig {})) = True
1114 isTypeLSig _ = False
1115
1116 isSpecLSig :: LSig name -> Bool
1117 isSpecLSig (L _(SpecSig {})) = True
1118 isSpecLSig _ = False
1119
1120 isSpecInstLSig :: LSig name -> Bool
1121 isSpecInstLSig (L _ (SpecInstSig {})) = True
1122 isSpecInstLSig _ = False
1123
1124 isPragLSig :: LSig name -> Bool
1125 -- Identifies pragmas
1126 isPragLSig (L _ (SpecSig {})) = True
1127 isPragLSig (L _ (InlineSig {})) = True
1128 isPragLSig (L _ (SCCFunSig {})) = True
1129 isPragLSig (L _ (CompleteMatchSig {})) = True
1130 isPragLSig _ = False
1131
1132 isInlineLSig :: LSig name -> Bool
1133 -- Identifies inline pragmas
1134 isInlineLSig (L _ (InlineSig {})) = True
1135 isInlineLSig _ = False
1136
1137 isMinimalLSig :: LSig name -> Bool
1138 isMinimalLSig (L _ (MinimalSig {})) = True
1139 isMinimalLSig _ = False
1140
1141 isSCCFunSig :: LSig name -> Bool
1142 isSCCFunSig (L _ (SCCFunSig {})) = True
1143 isSCCFunSig _ = False
1144
1145 isCompleteMatchSig :: LSig name -> Bool
1146 isCompleteMatchSig (L _ (CompleteMatchSig {} )) = True
1147 isCompleteMatchSig _ = False
1148
1149 hsSigDoc :: Sig name -> SDoc
1150 hsSigDoc (TypeSig {}) = text "type signature"
1151 hsSigDoc (PatSynSig {}) = text "pattern synonym signature"
1152 hsSigDoc (ClassOpSig _ is_deflt _ _)
1153 | is_deflt = text "default type signature"
1154 | otherwise = text "class method signature"
1155 hsSigDoc (IdSig {}) = text "id signature"
1156 hsSigDoc (SpecSig {}) = text "SPECIALISE pragma"
1157 hsSigDoc (InlineSig _ _ prag) = ppr (inlinePragmaSpec prag) <+> text "pragma"
1158 hsSigDoc (SpecInstSig {}) = text "SPECIALISE instance pragma"
1159 hsSigDoc (FixSig {}) = text "fixity declaration"
1160 hsSigDoc (MinimalSig {}) = text "MINIMAL pragma"
1161 hsSigDoc (SCCFunSig {}) = text "SCC pragma"
1162 hsSigDoc (CompleteMatchSig {}) = text "COMPLETE pragma"
1163 hsSigDoc (XSig {}) = text "XSIG TTG extension"
1164
1165 {-
1166 Check if signatures overlap; this is used when checking for duplicate
1167 signatures. Since some of the signatures contain a list of names, testing for
1168 equality is not enough -- we have to check if they overlap.
1169 -}
1170
1171 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Sig p) where
1172 ppr sig = ppr_sig sig
1173
1174 ppr_sig :: (OutputableBndrId (GhcPass p)) => Sig (GhcPass p) -> SDoc
1175 ppr_sig (TypeSig _ vars ty) = pprVarSig (map unLoc vars) (ppr ty)
1176 ppr_sig (ClassOpSig _ is_deflt vars ty)
1177 | is_deflt = text "default" <+> pprVarSig (map unLoc vars) (ppr ty)
1178 | otherwise = pprVarSig (map unLoc vars) (ppr ty)
1179 ppr_sig (IdSig _ id) = pprVarSig [id] (ppr (varType id))
1180 ppr_sig (FixSig _ fix_sig) = ppr fix_sig
1181 ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))
1182 = pragSrcBrackets (inl_src inl) pragmaSrc (pprSpec (unLoc var)
1183 (interpp'SP ty) inl)
1184 where
1185 pragmaSrc = case spec of
1186 NoUserInline -> "{-# SPECIALISE"
1187 _ -> "{-# SPECIALISE_INLINE"
1188 ppr_sig (InlineSig _ var inl)
1189 = pragSrcBrackets (inl_src inl) "{-# INLINE" (pprInline inl
1190 <+> pprPrefixOcc (unLoc var))
1191 ppr_sig (SpecInstSig _ src ty)
1192 = pragSrcBrackets src "{-# SPECIALISE" (text "instance" <+> ppr ty)
1193 ppr_sig (MinimalSig _ src bf)
1194 = pragSrcBrackets src "{-# MINIMAL" (pprMinimalSig bf)
1195 ppr_sig (PatSynSig _ names sig_ty)
1196 = text "pattern" <+> pprVarSig (map unLoc names) (ppr sig_ty)
1197 ppr_sig (SCCFunSig _ src fn mlabel)
1198 = pragSrcBrackets src "{-# SCC" (ppr fn <+> maybe empty ppr mlabel )
1199 ppr_sig (CompleteMatchSig _ src cs mty)
1200 = pragSrcBrackets src "{-# COMPLETE"
1201 ((hsep (punctuate comma (map ppr (unLoc cs))))
1202 <+> opt_sig)
1203 where
1204 opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty
1205 ppr_sig (XSig x) = ppr x
1206
1207 instance (p ~ GhcPass pass, OutputableBndrId p)
1208 => Outputable (FixitySig p) where
1209 ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]
1210 where
1211 pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
1212 ppr (XFixitySig x) = ppr x
1213
1214 pragBrackets :: SDoc -> SDoc
1215 pragBrackets doc = text "{-#" <+> doc <+> text "#-}"
1216
1217 -- | Using SourceText in case the pragma was spelled differently or used mixed
1218 -- case
1219 pragSrcBrackets :: SourceText -> String -> SDoc -> SDoc
1220 pragSrcBrackets (SourceText src) _ doc = text src <+> doc <+> text "#-}"
1221 pragSrcBrackets NoSourceText alt doc = text alt <+> doc <+> text "#-}"
1222
1223 pprVarSig :: (OutputableBndr id) => [id] -> SDoc -> SDoc
1224 pprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty]
1225 where
1226 pprvars = hsep $ punctuate comma (map pprPrefixOcc vars)
1227
1228 pprSpec :: (OutputableBndr id) => id -> SDoc -> InlinePragma -> SDoc
1229 pprSpec var pp_ty inl = pp_inl <+> pprVarSig [var] pp_ty
1230 where
1231 pp_inl | isDefaultInlinePragma inl = empty
1232 | otherwise = pprInline inl
1233
1234 pprTcSpecPrags :: TcSpecPrags -> SDoc
1235 pprTcSpecPrags IsDefaultMethod = text "<default method>"
1236 pprTcSpecPrags (SpecPrags ps) = vcat (map (ppr . unLoc) ps)
1237
1238 instance Outputable TcSpecPrag where
1239 ppr (SpecPrag var _ inl)
1240 = text "SPECIALIZE" <+> pprSpec var (text "<type>") inl
1241
1242 pprMinimalSig :: (OutputableBndr name)
1243 => LBooleanFormula (Located name) -> SDoc
1244 pprMinimalSig (L _ bf) = ppr (fmap unLoc bf)
1245
1246 {-
1247 ************************************************************************
1248 * *
1249 \subsection[PatSynBind]{A pattern synonym definition}
1250 * *
1251 ************************************************************************
1252 -}
1253
1254 -- | Haskell Pattern Synonym Details
1255 type HsPatSynDetails arg = HsConDetails arg [RecordPatSynField arg]
1256
1257 -- See Note [Record PatSyn Fields]
1258 -- | Record Pattern Synonym Field
1259 data RecordPatSynField a
1260 = RecordPatSynField {
1261 recordPatSynSelectorId :: a -- Selector name visible in rest of the file
1262 , recordPatSynPatVar :: a
1263 -- Filled in by renamer, the name used internally
1264 -- by the pattern
1265 } deriving (Data, Functor)
1266
1267
1268
1269 {-
1270 Note [Record PatSyn Fields]
1271
1272 Consider the following two pattern synonyms.
1273
1274 pattern P x y = ([x,True], [y,'v'])
1275 pattern Q{ x, y } =([x,True], [y,'v'])
1276
1277 In P, we just have two local binders, x and y.
1278
1279 In Q, we have local binders but also top-level record selectors
1280 x :: ([Bool], [Char]) -> Bool and similarly for y.
1281
1282 It would make sense to support record-like syntax
1283
1284 pattern Q{ x=x1, y=y1 } = ([x1,True], [y1,'v'])
1285
1286 when we have a different name for the local and top-level binder
1287 the distinction between the two names clear
1288
1289 -}
1290 instance Outputable a => Outputable (RecordPatSynField a) where
1291 ppr (RecordPatSynField { recordPatSynSelectorId = v }) = ppr v
1292
1293 instance Foldable RecordPatSynField where
1294 foldMap f (RecordPatSynField { recordPatSynSelectorId = visible
1295 , recordPatSynPatVar = hidden })
1296 = f visible `mappend` f hidden
1297
1298 instance Traversable RecordPatSynField where
1299 traverse f (RecordPatSynField { recordPatSynSelectorId =visible
1300 , recordPatSynPatVar = hidden })
1301 = (\ sel_id pat_var -> RecordPatSynField { recordPatSynSelectorId = sel_id
1302 , recordPatSynPatVar = pat_var })
1303 <$> f visible <*> f hidden
1304
1305
1306 -- | Haskell Pattern Synonym Direction
1307 data HsPatSynDir id
1308 = Unidirectional
1309 | ImplicitBidirectional
1310 | ExplicitBidirectional (MatchGroup id (LHsExpr id))