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