Permit empty closed type families
[ghc.git] / compiler / rename / RnBinds.hs
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4 \section[RnBinds]{Renaming and dependency analysis of bindings}
5
6 This module does renaming and dependency analysis on value bindings in
7 the abstract syntax. It does {\em not} do cycle-checks on class or
8 type-synonym declarations; those cannot be done at this stage because
9 they may be affected by renaming (which isn't fully worked out yet).
10 -}
11
12 {-# LANGUAGE CPP #-}
13
14 module RnBinds (
15 -- Renaming top-level bindings
16 rnTopBindsLHS, rnTopBindsRHS, rnValBindsRHS,
17
18 -- Renaming local bindings
19 rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
20
21 -- Other bindings
22 rnMethodBinds, renameSigs, mkSigTvFn,
23 rnMatchGroup, rnGRHSs, rnGRHS,
24 makeMiniFixityEnv, MiniFixityEnv,
25 HsSigCtxt(..)
26 ) where
27
28 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
29
30 import HsSyn
31 import TcRnMonad
32 import TcEvidence ( emptyTcEvBinds )
33 import RnTypes
34 import RnPat
35 import RnNames
36 import RnEnv
37 import DynFlags
38 import Module
39 import Name
40 import NameEnv
41 import NameSet
42 import RdrName ( RdrName, rdrNameOcc )
43 import SrcLoc
44 import ListSetOps ( findDupsEq )
45 import BasicTypes ( RecFlag(..) )
46 import Digraph ( SCC(..) )
47 import Bag
48 import Outputable
49 import FastString
50 import Data.List ( partition, sort )
51 import Maybes ( orElse )
52 import Control.Monad
53 #if __GLASGOW_HASKELL__ < 709
54 import Data.Traversable ( traverse )
55 #endif
56
57 {-
58 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
59 -- place and can be used when complaining.
60
61 The code tree received by the function @rnBinds@ contains definitions
62 in where-clauses which are all apparently mutually recursive, but which may
63 not really depend upon each other. For example, in the top level program
64 \begin{verbatim}
65 f x = y where a = x
66 y = x
67 \end{verbatim}
68 the definitions of @a@ and @y@ do not depend on each other at all.
69 Unfortunately, the typechecker cannot always check such definitions.
70 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
71 definitions. In Proceedings of the International Symposium on Programming,
72 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
73 However, the typechecker usually can check definitions in which only the
74 strongly connected components have been collected into recursive bindings.
75 This is precisely what the function @rnBinds@ does.
76
77 ToDo: deal with case where a single monobinds binds the same variable
78 twice.
79
80 The vertag tag is a unique @Int@; the tags only need to be unique
81 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
82 (heavy monad machinery not needed).
83
84
85 ************************************************************************
86 * *
87 * naming conventions *
88 * *
89 ************************************************************************
90
91 \subsection[name-conventions]{Name conventions}
92
93 The basic algorithm involves walking over the tree and returning a tuple
94 containing the new tree plus its free variables. Some functions, such
95 as those walking polymorphic bindings (HsBinds) and qualifier lists in
96 list comprehensions (@Quals@), return the variables bound in local
97 environments. These are then used to calculate the free variables of the
98 expression evaluated in these environments.
99
100 Conventions for variable names are as follows:
101 \begin{itemize}
102 \item
103 new code is given a prime to distinguish it from the old.
104
105 \item
106 a set of variables defined in @Exp@ is written @dvExp@
107
108 \item
109 a set of variables free in @Exp@ is written @fvExp@
110 \end{itemize}
111
112 ************************************************************************
113 * *
114 * analysing polymorphic bindings (HsBindGroup, HsBind)
115 * *
116 ************************************************************************
117
118 \subsubsection[dep-HsBinds]{Polymorphic bindings}
119
120 Non-recursive expressions are reconstructed without any changes at top
121 level, although their component expressions may have to be altered.
122 However, non-recursive expressions are currently not expected as
123 \Haskell{} programs, and this code should not be executed.
124
125 Monomorphic bindings contain information that is returned in a tuple
126 (a @FlatMonoBinds@) containing:
127
128 \begin{enumerate}
129 \item
130 a unique @Int@ that serves as the ``vertex tag'' for this binding.
131
132 \item
133 the name of a function or the names in a pattern. These are a set
134 referred to as @dvLhs@, the defined variables of the left hand side.
135
136 \item
137 the free variables of the body. These are referred to as @fvBody@.
138
139 \item
140 the definition's actual code. This is referred to as just @code@.
141 \end{enumerate}
142
143 The function @nonRecDvFv@ returns two sets of variables. The first is
144 the set of variables defined in the set of monomorphic bindings, while the
145 second is the set of free variables in those bindings.
146
147 The set of variables defined in a non-recursive binding is just the
148 union of all of them, as @union@ removes duplicates. However, the
149 free variables in each successive set of cumulative bindings is the
150 union of those in the previous set plus those of the newest binding after
151 the defined variables of the previous set have been removed.
152
153 @rnMethodBinds@ deals only with the declarations in class and
154 instance declarations. It expects only to see @FunMonoBind@s, and
155 it expects the global environment to contain bindings for the binders
156 (which are all class operations).
157
158 ************************************************************************
159 * *
160 \subsubsection{ Top-level bindings}
161 * *
162 ************************************************************************
163 -}
164
165 -- for top-level bindings, we need to make top-level names,
166 -- so we have a different entry point than for local bindings
167 rnTopBindsLHS :: MiniFixityEnv
168 -> HsValBinds RdrName
169 -> RnM (HsValBindsLR Name RdrName)
170 rnTopBindsLHS fix_env binds
171 = rnValBindsLHS (topRecNameMaker fix_env) binds
172
173 rnTopBindsRHS :: NameSet -> HsValBindsLR Name RdrName
174 -> RnM (HsValBinds Name, DefUses)
175 rnTopBindsRHS bound_names binds
176 = do { is_boot <- tcIsHsBootOrSig
177 ; if is_boot
178 then rnTopBindsBoot binds
179 else rnValBindsRHS (TopSigCtxt bound_names False) binds }
180
181 rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
182 -- A hs-boot file has no bindings.
183 -- Return a single HsBindGroup with empty binds and renamed signatures
184 rnTopBindsBoot (ValBindsIn mbinds sigs)
185 = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
186 ; (sigs', fvs) <- renameSigs HsBootCtxt sigs
187 ; return (ValBindsOut [] sigs', usesOnly fvs) }
188 rnTopBindsBoot b = pprPanic "rnTopBindsBoot" (ppr b)
189
190 {-
191 *********************************************************
192 * *
193 HsLocalBinds
194 * *
195 *********************************************************
196 -}
197
198 rnLocalBindsAndThen :: HsLocalBinds RdrName
199 -> (HsLocalBinds Name -> RnM (result, FreeVars))
200 -> RnM (result, FreeVars)
201 -- This version (a) assumes that the binding vars are *not* already in scope
202 -- (b) removes the binders from the free vars of the thing inside
203 -- The parser doesn't produce ThenBinds
204 rnLocalBindsAndThen EmptyLocalBinds thing_inside
205 = thing_inside EmptyLocalBinds
206
207 rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
208 = rnLocalValBindsAndThen val_binds $ \ val_binds' ->
209 thing_inside (HsValBinds val_binds')
210
211 rnLocalBindsAndThen (HsIPBinds binds) thing_inside = do
212 (binds',fv_binds) <- rnIPBinds binds
213 (thing, fvs_thing) <- thing_inside (HsIPBinds binds')
214 return (thing, fvs_thing `plusFV` fv_binds)
215
216 rnIPBinds :: HsIPBinds RdrName -> RnM (HsIPBinds Name, FreeVars)
217 rnIPBinds (IPBinds ip_binds _no_dict_binds) = do
218 (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
219 return (IPBinds ip_binds' emptyTcEvBinds, plusFVs fvs_s)
220
221 rnIPBind :: IPBind RdrName -> RnM (IPBind Name, FreeVars)
222 rnIPBind (IPBind ~(Left n) expr) = do
223 (expr',fvExpr) <- rnLExpr expr
224 return (IPBind (Left n) expr', fvExpr)
225
226 {-
227 ************************************************************************
228 * *
229 ValBinds
230 * *
231 ************************************************************************
232 -}
233
234 -- Renaming local binding groups
235 -- Does duplicate/shadow check
236 rnLocalValBindsLHS :: MiniFixityEnv
237 -> HsValBinds RdrName
238 -> RnM ([Name], HsValBindsLR Name RdrName)
239 rnLocalValBindsLHS fix_env binds
240 = do { binds' <- rnValBindsLHS (localRecNameMaker fix_env) binds
241
242 -- Check for duplicates and shadowing
243 -- Must do this *after* renaming the patterns
244 -- See Note [Collect binders only after renaming] in HsUtils
245
246 -- We need to check for dups here because we
247 -- don't don't bind all of the variables from the ValBinds at once
248 -- with bindLocatedLocals any more.
249 --
250 -- Note that we don't want to do this at the top level, since
251 -- sorting out duplicates and shadowing there happens elsewhere.
252 -- The behavior is even different. For example,
253 -- import A(f)
254 -- f = ...
255 -- should not produce a shadowing warning (but it will produce
256 -- an ambiguity warning if you use f), but
257 -- import A(f)
258 -- g = let f = ... in f
259 -- should.
260 ; let bound_names = collectHsValBinders binds'
261 -- There should be only Ids, but if there are any bogus
262 -- pattern synonyms, we'll collect them anyway, so that
263 -- we don't generate subsequent out-of-scope messages
264 ; envs <- getRdrEnvs
265 ; checkDupAndShadowedNames envs bound_names
266
267 ; return (bound_names, binds') }
268
269 -- renames the left-hand sides
270 -- generic version used both at the top level and for local binds
271 -- does some error checking, but not what gets done elsewhere at the top level
272 rnValBindsLHS :: NameMaker
273 -> HsValBinds RdrName
274 -> RnM (HsValBindsLR Name RdrName)
275 rnValBindsLHS topP (ValBindsIn mbinds sigs)
276 = do { mbinds' <- mapBagM (wrapLocM (rnBindLHS topP doc)) mbinds
277 ; return $ ValBindsIn mbinds' sigs }
278 where
279 bndrs = collectHsBindsBinders mbinds
280 doc = text "In the binding group for:" <+> pprWithCommas ppr bndrs
281
282 rnValBindsLHS _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
283
284 -- General version used both from the top-level and for local things
285 -- Assumes the LHS vars are in scope
286 --
287 -- Does not bind the local fixity declarations
288 rnValBindsRHS :: HsSigCtxt
289 -> HsValBindsLR Name RdrName
290 -> RnM (HsValBinds Name, DefUses)
291
292 rnValBindsRHS ctxt (ValBindsIn mbinds sigs)
293 = do { (sigs', sig_fvs) <- renameSigs ctxt sigs
294 ; binds_w_dus <- mapBagM (rnLBind (mkSigTvFn sigs')) mbinds
295 ; case depAnalBinds binds_w_dus of
296 (anal_binds, anal_dus) -> return (valbind', valbind'_dus)
297 where
298 valbind' = ValBindsOut anal_binds sigs'
299 valbind'_dus = anal_dus `plusDU` usesOnly sig_fvs
300 -- Put the sig uses *after* the bindings
301 -- so that the binders are removed from
302 -- the uses in the sigs
303 }
304
305 rnValBindsRHS _ b = pprPanic "rnValBindsRHS" (ppr b)
306
307 -- Wrapper for local binds
308 --
309 -- The *client* of this function is responsible for checking for unused binders;
310 -- it doesn't (and can't: we don't have the thing inside the binds) happen here
311 --
312 -- The client is also responsible for bringing the fixities into scope
313 rnLocalValBindsRHS :: NameSet -- names bound by the LHSes
314 -> HsValBindsLR Name RdrName
315 -> RnM (HsValBinds Name, DefUses)
316 rnLocalValBindsRHS bound_names binds
317 = rnValBindsRHS (LocalBindCtxt bound_names) binds
318
319 -- for local binds
320 -- wrapper that does both the left- and right-hand sides
321 --
322 -- here there are no local fixity decls passed in;
323 -- the local fixity decls come from the ValBinds sigs
324 rnLocalValBindsAndThen :: HsValBinds RdrName
325 -> (HsValBinds Name -> RnM (result, FreeVars))
326 -> RnM (result, FreeVars)
327 rnLocalValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
328 = do { -- (A) Create the local fixity environment
329 new_fixities <- makeMiniFixityEnv [L loc sig
330 | L loc (FixSig sig) <- sigs]
331
332 -- (B) Rename the LHSes
333 ; (bound_names, new_lhs) <- rnLocalValBindsLHS new_fixities binds
334
335 -- ...and bring them (and their fixities) into scope
336 ; bindLocalNamesFV bound_names $
337 addLocalFixities new_fixities bound_names $ do
338
339 { -- (C) Do the RHS and thing inside
340 (binds', dus) <- rnLocalValBindsRHS (mkNameSet bound_names) new_lhs
341 ; (result, result_fvs) <- thing_inside binds'
342
343 -- Report unused bindings based on the (accurate)
344 -- findUses. E.g.
345 -- let x = x in 3
346 -- should report 'x' unused
347 ; let real_uses = findUses dus result_fvs
348 -- Insert fake uses for variables introduced implicitly by
349 -- wildcards (#4404)
350 implicit_uses = hsValBindsImplicits binds'
351 ; warnUnusedLocalBinds bound_names
352 (real_uses `unionNameSet` implicit_uses)
353
354 ; let
355 -- The variables "used" in the val binds are:
356 -- (1) the uses of the binds (allUses)
357 -- (2) the FVs of the thing-inside
358 all_uses = allUses dus `plusFV` result_fvs
359 -- Note [Unused binding hack]
360 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
361 -- Note that *in contrast* to the above reporting of
362 -- unused bindings, (1) above uses duUses to return *all*
363 -- the uses, even if the binding is unused. Otherwise consider:
364 -- x = 3
365 -- y = let p = x in 'x' -- NB: p not used
366 -- If we don't "see" the dependency of 'y' on 'x', we may put the
367 -- bindings in the wrong order, and the type checker will complain
368 -- that x isn't in scope
369 --
370 -- But note that this means we won't report 'x' as unused,
371 -- whereas we would if we had { x = 3; p = x; y = 'x' }
372
373 ; return (result, all_uses) }}
374 -- The bound names are pruned out of all_uses
375 -- by the bindLocalNamesFV call above
376
377 rnLocalValBindsAndThen bs _ = pprPanic "rnLocalValBindsAndThen" (ppr bs)
378
379
380 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
381 -- (We keep the location around for reporting duplicate fixity declarations.)
382 --
383 -- Checks for duplicates, but not that only locally defined things are fixed.
384 -- Note: for local fixity declarations, duplicates would also be checked in
385 -- check_sigs below. But we also use this function at the top level.
386
387 makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
388
389 makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls
390 where
391 add_one_sig env (L loc (FixitySig names fixity)) =
392 foldlM add_one env [ (loc,name_loc,name,fixity)
393 | L name_loc name <- names ]
394
395 add_one env (loc, name_loc, name,fixity) = do
396 { -- this fixity decl is a duplicate iff
397 -- the ReaderName's OccName's FastString is already in the env
398 -- (we only need to check the local fix_env because
399 -- definitions of non-local will be caught elsewhere)
400 let { fs = occNameFS (rdrNameOcc name)
401 ; fix_item = L loc fixity };
402
403 case lookupFsEnv env fs of
404 Nothing -> return $ extendFsEnv env fs fix_item
405 Just (L loc' _) -> do
406 { setSrcSpan loc $
407 addErrAt name_loc (dupFixityDecl loc' name)
408 ; return env}
409 }
410
411 dupFixityDecl :: SrcSpan -> RdrName -> SDoc
412 dupFixityDecl loc rdr_name
413 = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name),
414 ptext (sLit "also at ") <+> ppr loc]
415
416 ---------------------
417
418 -- renaming a single bind
419
420 rnBindLHS :: NameMaker
421 -> SDoc
422 -> HsBind RdrName
423 -- returns the renamed left-hand side,
424 -- and the FreeVars *of the LHS*
425 -- (i.e., any free variables of the pattern)
426 -> RnM (HsBindLR Name RdrName)
427
428 rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat })
429 = do
430 -- we don't actually use the FV processing of rnPatsAndThen here
431 (pat',pat'_fvs) <- rnBindPat name_maker pat
432 return (bind { pat_lhs = pat', bind_fvs = pat'_fvs })
433 -- We temporarily store the pat's FVs in bind_fvs;
434 -- gets updated to the FVs of the whole bind
435 -- when doing the RHS below
436
437 rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name })
438 = do { name <- applyNameMaker name_maker rdr_name
439 ; return (bind { fun_id = name
440 , bind_fvs = placeHolderNamesTc }) }
441
442 rnBindLHS name_maker _ (PatSynBind psb@PSB{ psb_id = rdrname })
443 | isTopRecNameMaker name_maker
444 = do { addLocM checkConName rdrname
445 ; name <- lookupLocatedTopBndrRn rdrname -- Should be bound at top level already
446 ; return (PatSynBind psb{ psb_id = name }) }
447
448 | otherwise -- Pattern synonym, not at top level
449 = do { addErr localPatternSynonymErr -- Complain, but make up a fake
450 -- name so that we can carry on
451 ; name <- applyNameMaker name_maker rdrname
452 ; return (PatSynBind psb{ psb_id = name }) }
453 where
454 localPatternSynonymErr :: SDoc
455 localPatternSynonymErr
456 = hang (ptext (sLit "Illegal pattern synonym declaration for") <+> quotes (ppr rdrname))
457 2 (ptext (sLit "Pattern synonym declarations are only valid at top level"))
458
459 rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b)
460
461 rnLBind :: (Name -> [Name]) -- Signature tyvar function
462 -> LHsBindLR Name RdrName
463 -> RnM (LHsBind Name, [Name], Uses)
464 rnLBind sig_fn (L loc bind)
465 = setSrcSpan loc $
466 do { (bind', bndrs, dus) <- rnBind sig_fn bind
467 ; return (L loc bind', bndrs, dus) }
468
469 -- assumes the left-hands-side vars are in scope
470 rnBind :: (Name -> [Name]) -- Signature tyvar function
471 -> HsBindLR Name RdrName
472 -> RnM (HsBind Name, [Name], Uses)
473 rnBind _ bind@(PatBind { pat_lhs = pat
474 , pat_rhs = grhss
475 -- pat fvs were stored in bind_fvs
476 -- after processing the LHS
477 , bind_fvs = pat_fvs })
478 = do { mod <- getModule
479 ; (grhss', rhs_fvs) <- rnGRHSs PatBindRhs rnLExpr grhss
480
481 -- No scoped type variables for pattern bindings
482 ; let all_fvs = pat_fvs `plusFV` rhs_fvs
483 fvs' = filterNameSet (nameIsLocalOrFrom mod) all_fvs
484 -- Keep locally-defined Names
485 -- As well as dependency analysis, we need these for the
486 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
487 bndrs = collectPatBinders pat
488 bind' = bind { pat_rhs = grhss',
489 pat_rhs_ty = placeHolderType, bind_fvs = fvs' }
490 is_wild_pat = case pat of
491 L _ (WildPat {}) -> True
492 L _ (BangPat (L _ (WildPat {}))) -> True -- #9127
493 _ -> False
494
495 -- Warn if the pattern binds no variables, except for the
496 -- entirely-explicit idiom _ = rhs
497 -- which (a) is not that different from _v = rhs
498 -- (b) is sometimes used to give a type sig for,
499 -- or an occurrence of, a variable on the RHS
500 ; whenWOptM Opt_WarnUnusedPatternBinds $
501 when (null bndrs && not is_wild_pat) $
502 addWarn $ unusedPatBindWarn bind'
503
504 ; fvs' `seq` -- See Note [Free-variable space leak]
505 return (bind', bndrs, all_fvs) }
506
507 rnBind sig_fn bind@(FunBind { fun_id = name
508 , fun_infix = is_infix
509 , fun_matches = matches })
510 -- invariant: no free vars here when it's a FunBind
511 = do { let plain_name = unLoc name
512
513 ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
514 -- bindSigTyVars tests for Opt_ScopedTyVars
515 rnMatchGroup (FunRhs plain_name is_infix)
516 rnLExpr matches
517 ; when is_infix $ checkPrecMatch plain_name matches'
518
519 ; mod <- getModule
520 ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) rhs_fvs
521 -- Keep locally-defined Names
522 -- As well as dependency analysis, we need these for the
523 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
524
525 ; fvs' `seq` -- See Note [Free-variable space leak]
526 return (bind { fun_matches = matches'
527 , bind_fvs = fvs' },
528 [plain_name], rhs_fvs)
529 }
530
531 rnBind sig_fn (PatSynBind bind)
532 = do { (bind', name, fvs) <- rnPatSynBind sig_fn bind
533 ; return (PatSynBind bind', name, fvs) }
534
535 rnBind _ b = pprPanic "rnBind" (ppr b)
536
537 {-
538 Note [Free-variable space leak]
539 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
540 We have
541 fvs' = trim fvs
542 and we seq fvs' before turning it as part of a record.
543
544 The reason is that trim is sometimes something like
545 \xs -> intersectNameSet (mkNameSet bound_names) xs
546 and we don't want to retain the list bound_names. This showed up in
547 trac ticket #1136.
548 -}
549
550 rnPatSynBind :: (Name -> [Name]) -- Signature tyvar function
551 -> PatSynBind Name RdrName
552 -> RnM (PatSynBind Name Name, [Name], Uses)
553 rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name
554 , psb_args = details
555 , psb_def = pat
556 , psb_dir = dir })
557 -- invariant: no free vars here when it's a FunBind
558 = do { pattern_synonym_ok <- xoptM Opt_PatternSynonyms
559 ; unless pattern_synonym_ok (addErr patternSynonymErr)
560
561 ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do
562 -- We check the 'RdrName's instead of the 'Name's
563 -- so that the binding locations are reported
564 -- from the left-hand side
565 { (details', fvs) <- case details of
566 PrefixPatSyn vars ->
567 do { checkDupRdrNames vars
568 ; names <- mapM lookupVar vars
569 ; return (PrefixPatSyn names, mkFVs (map unLoc names)) }
570 InfixPatSyn var1 var2 ->
571 do { checkDupRdrNames [var1, var2]
572 ; name1 <- lookupVar var1
573 ; name2 <- lookupVar var2
574 -- ; checkPrecMatch -- TODO
575 ; return (InfixPatSyn name1 name2, mkFVs (map unLoc [name1, name2])) }
576 ; return ((pat', details'), fvs) }
577 ; (dir', fvs2) <- case dir of
578 Unidirectional -> return (Unidirectional, emptyFVs)
579 ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
580 ExplicitBidirectional mg ->
581 do { (mg', fvs) <- rnMatchGroup PatSyn rnLExpr mg
582 ; return (ExplicitBidirectional mg', fvs) }
583
584 ; mod <- getModule
585 ; let fvs = fvs1 `plusFV` fvs2
586 fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs
587 -- Keep locally-defined Names
588 -- As well as dependency analysis, we need these for the
589 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
590
591 ; let bind' = bind{ psb_args = details'
592 , psb_def = pat'
593 , psb_dir = dir'
594 , psb_fvs = fvs' }
595
596 ; fvs' `seq` -- See Note [Free-variable space leak]
597 return (bind', [name], fvs1)
598 -- See Note [Pattern synonym builders don't yield dependencies]
599 }
600 where
601 lookupVar = wrapLocM lookupOccRn
602
603 patternSynonymErr :: SDoc
604 patternSynonymErr
605 = hang (ptext (sLit "Illegal pattern synonym declaration"))
606 2 (ptext (sLit "Use -XPatternSynonyms to enable this extension"))
607
608 {-
609 Note [Pattern synonym builders don't yield dependencies]
610 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
611 When renaming a pattern synonym that has an explicit builder,
612 references in the builder definition should not be used when
613 calculating dependencies. For example, consider the following pattern
614 synonym definition:
615
616 pattern P x <- C1 x where
617 P x = f (C1 x)
618
619 f (P x) = C2 x
620
621 In this case, 'P' needs to be typechecked in two passes:
622
623 1. Typecheck the pattern definition of 'P', which fully determines the
624 type of 'P'. This step doesn't require knowing anything about 'f',
625 since the builder definition is not looked at.
626
627 2. Typecheck the builder definition, which needs the typechecked
628 definition of 'f' to be in scope.
629
630 This behaviour is implemented in 'tcValBinds', but it crucially
631 depends on 'P' not being put in a recursive group with 'f' (which
632 would make it look like a recursive pattern synonym a la 'pattern P =
633 P' which is unsound and rejected).
634
635 -}
636
637 ---------------------
638 depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
639 -> ([(RecFlag, LHsBinds Name)], DefUses)
640 -- Dependency analysis; this is important so that
641 -- unused-binding reporting is accurate
642 depAnalBinds binds_w_dus
643 = (map get_binds sccs, map get_du sccs)
644 where
645 sccs = depAnal (\(_, defs, _) -> defs)
646 (\(_, _, uses) -> nameSetElems uses)
647 (bagToList binds_w_dus)
648
649 get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
650 get_binds (CyclicSCC binds_w_dus) = (Recursive, listToBag [b | (b,_,_) <- binds_w_dus])
651
652 get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
653 get_du (CyclicSCC binds_w_dus) = (Just defs, uses)
654 where
655 defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
656 uses = unionNameSets [u | (_,_,u) <- binds_w_dus]
657
658 ---------------------
659 -- Bind the top-level forall'd type variables in the sigs.
660 -- E.g f :: a -> a
661 -- f = rhs
662 -- The 'a' scopes over the rhs
663 --
664 -- NB: there'll usually be just one (for a function binding)
665 -- but if there are many, one may shadow the rest; too bad!
666 -- e.g x :: [a] -> [a]
667 -- y :: [(a,a)] -> a
668 -- (x,y) = e
669 -- In e, 'a' will be in scope, and it'll be the one from 'y'!
670
671 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
672 -- Return a lookup function that maps an Id Name to the names
673 -- of the type variables that should scope over its body..
674 mkSigTvFn sigs
675 = \n -> lookupNameEnv env n `orElse` []
676 where
677 extractScopedTyVars :: LHsType Name -> [Name]
678 extractScopedTyVars (L _ (HsForAllTy Explicit _ ltvs _ _)) = hsLKiTyVarNames ltvs
679 extractScopedTyVars _ = []
680
681 env :: NameEnv [Name]
682 env = mkNameEnv [ (name, nwcs ++ extractScopedTyVars ty) -- Kind variables and type variables
683 | L _ (TypeSig names ty nwcs) <- sigs
684 , L _ name <- names]
685 -- Note the pattern-match on "Explicit"; we only bind
686 -- type variables from signatures with an explicit top-level for-all
687
688 {-
689 @rnMethodBinds@ is used for the method bindings of a class and an instance
690 declaration. Like @rnBinds@ but without dependency analysis.
691
692 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
693 That's crucial when dealing with an instance decl:
694 \begin{verbatim}
695 instance Foo (T a) where
696 op x = ...
697 \end{verbatim}
698 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
699 and unless @op@ occurs we won't treat the type signature of @op@ in the class
700 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
701 in many ways the @op@ in an instance decl is just like an occurrence, not
702 a binder.
703 -}
704
705 rnMethodBinds :: Name -- Class name
706 -> (Name -> [Name]) -- Signature tyvar function
707 -> LHsBinds RdrName
708 -> RnM (LHsBinds Name, FreeVars)
709
710 rnMethodBinds cls sig_fn binds
711 = do { checkDupRdrNames meth_names
712 -- Check that the same method is not given twice in the
713 -- same instance decl instance C T where
714 -- f x = ...
715 -- g y = ...
716 -- f x = ...
717 -- We must use checkDupRdrNames because the Name of the
718 -- method is the Name of the class selector, whose SrcSpan
719 -- points to the class declaration; and we use rnMethodBinds
720 -- for instance decls too
721
722 ; foldlM do_one (emptyBag, emptyFVs) (bagToList binds) }
723 where
724 meth_names = collectMethodBinders binds
725 do_one (binds,fvs) bind
726 = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn bind
727 ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) }
728
729 rnMethodBind :: Name
730 -> (Name -> [Name])
731 -> LHsBindLR RdrName RdrName
732 -> RnM (Bag (LHsBindLR Name Name), FreeVars)
733 rnMethodBind cls sig_fn
734 (L loc bind@(FunBind { fun_id = name, fun_infix = is_infix
735 , fun_matches = MG { mg_alts = matches
736 , mg_origin = origin } }))
737 = setSrcSpan loc $ do
738 sel_name <- wrapLocM (lookupInstDeclBndr cls (ptext (sLit "method"))) name
739 let plain_name = unLoc sel_name
740 -- We use the selector name as the binder
741
742 (new_matches, fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
743 mapFvRn (rnMatch (FunRhs plain_name is_infix) rnLExpr)
744 matches
745 let new_group = mkMatchGroupName origin new_matches
746
747 when is_infix $ checkPrecMatch plain_name new_group
748 return (unitBag (L loc (bind { fun_id = sel_name
749 , fun_matches = new_group
750 , bind_fvs = fvs })),
751 fvs `addOneFV` plain_name)
752 -- The 'fvs' field isn't used for method binds
753
754 -- Can't handle method pattern-bindings which bind multiple methods.
755 rnMethodBind _ _ (L loc bind@(PatBind {})) = do
756 addErrAt loc (methodBindErr bind)
757 return (emptyBag, emptyFVs)
758
759 -- Associated pattern synonyms are not implemented yet
760 rnMethodBind _ _ (L loc bind@(PatSynBind {})) = do
761 addErrAt loc $ methodPatSynErr bind
762 return (emptyBag, emptyFVs)
763
764 rnMethodBind _ _ b = pprPanic "rnMethodBind" (ppr b)
765
766 {-
767 ************************************************************************
768 * *
769 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
770 * *
771 ************************************************************************
772
773 @renameSigs@ checks for:
774 \begin{enumerate}
775 \item more than one sig for one thing;
776 \item signatures given for things not bound here;
777 \end{enumerate}
778
779 At the moment we don't gather free-var info from the types in
780 signatures. We'd only need this if we wanted to report unused tyvars.
781 -}
782
783 renameSigs :: HsSigCtxt
784 -> [LSig RdrName]
785 -> RnM ([LSig Name], FreeVars)
786 -- Renames the signatures and performs error checks
787 renameSigs ctxt sigs
788 = do { mapM_ dupSigDeclErr (findDupSigs sigs)
789
790 ; checkDupMinimalSigs sigs
791
792 ; (sigs', sig_fvs) <- mapFvRn (wrapLocFstM (renameSig ctxt)) sigs
793
794 ; let (good_sigs, bad_sigs) = partition (okHsSig ctxt) sigs'
795 ; mapM_ misplacedSigErr bad_sigs -- Misplaced
796
797 ; return (good_sigs, sig_fvs) }
798
799 ----------------------
800 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
801 -- because this won't work for:
802 -- instance Foo T where
803 -- {-# INLINE op #-}
804 -- Baz.op = ...
805 -- We'll just rename the INLINE prag to refer to whatever other 'op'
806 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
807 -- Doesn't seem worth much trouble to sort this.
808
809 renameSig :: HsSigCtxt -> Sig RdrName -> RnM (Sig Name, FreeVars)
810 -- FixitySig is renamed elsewhere.
811 renameSig _ (IdSig x)
812 = return (IdSig x, emptyFVs) -- Actually this never occurs
813
814 renameSig ctxt sig@(TypeSig vs ty _)
815 = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
816 -- (named and anonymous) wildcards are bound here.
817 ; (wcs, ty') <- extractWildcards ty
818 ; bindLocatedLocalsFV wcs $ \wcs_new -> do {
819 (new_ty, fvs) <- rnHsSigType (ppr_sig_bndrs vs) ty'
820 ; return (TypeSig new_vs new_ty wcs_new, fvs) } }
821
822 renameSig ctxt sig@(GenericSig vs ty)
823 = do { defaultSigs_on <- xoptM Opt_DefaultSignatures
824 ; unless defaultSigs_on (addErr (defaultSigErr sig))
825 ; new_v <- mapM (lookupSigOccRn ctxt sig) vs
826 ; (new_ty, fvs) <- rnHsSigType (ppr_sig_bndrs vs) ty
827 ; return (GenericSig new_v new_ty, fvs) }
828
829 renameSig _ (SpecInstSig src ty)
830 = do { (new_ty, fvs) <- rnLHsType SpecInstSigCtx ty
831 ; return (SpecInstSig src new_ty,fvs) }
832
833 -- {-# SPECIALISE #-} pragmas can refer to imported Ids
834 -- so, in the top-level case (when mb_names is Nothing)
835 -- we use lookupOccRn. If there's both an imported and a local 'f'
836 -- then the SPECIALISE pragma is ambiguous, unlike all other signatures
837 renameSig ctxt sig@(SpecSig v tys inl)
838 = do { new_v <- case ctxt of
839 TopSigCtxt {} -> lookupLocatedOccRn v
840 _ -> lookupSigOccRn ctxt sig v
841 -- ; (new_ty, fvs) <- rnHsSigType (quotes (ppr v)) ty
842 ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
843 ; return (SpecSig new_v new_ty inl, fvs) }
844 where
845 do_one (tys,fvs) ty
846 = do { (new_ty, fvs_ty) <- rnHsSigType (quotes (ppr v)) ty
847 ; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
848
849 renameSig ctxt sig@(InlineSig v s)
850 = do { new_v <- lookupSigOccRn ctxt sig v
851 ; return (InlineSig new_v s, emptyFVs) }
852
853 renameSig ctxt sig@(FixSig (FixitySig vs f))
854 = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
855 ; return (FixSig (FixitySig new_vs f), emptyFVs) }
856
857 renameSig ctxt sig@(MinimalSig s bf)
858 = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
859 return (MinimalSig s new_bf, emptyFVs)
860
861 renameSig ctxt sig@(PatSynSig v (flag, qtvs) prov req ty)
862 = do { v' <- lookupSigOccRn ctxt sig v
863 ; let doc = TypeSigCtx $ quotes (ppr v)
864 ; loc <- getSrcSpanM
865
866 ; let (tv_kvs, mentioned) = extractHsTysRdrTyVars (ty:unLoc prov ++ unLoc req)
867 ; tv_bndrs <- case flag of
868 Implicit ->
869 return $ mkHsQTvs . userHsTyVarBndrs loc $ mentioned
870 Explicit ->
871 do { let heading = ptext (sLit "In the pattern synonym type signature")
872 <+> quotes (ppr sig)
873 ; warnUnusedForAlls (heading $$ docOfHsDocContext doc) qtvs mentioned
874 ; return qtvs }
875 Qualified -> panic "renameSig: Qualified"
876
877 ; bindHsTyVars doc Nothing tv_kvs tv_bndrs $ \ tyvars -> do
878 { (prov', fvs1) <- rnContext doc prov
879 ; (req', fvs2) <- rnContext doc req
880 ; (ty', fvs3) <- rnLHsType doc ty
881
882 ; let fvs = plusFVs [fvs1, fvs2, fvs3]
883 ; return (PatSynSig v' (flag, tyvars) prov' req' ty', fvs) }}
884
885 ppr_sig_bndrs :: [Located RdrName] -> SDoc
886 ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
887
888 okHsSig :: HsSigCtxt -> LSig a -> Bool
889 okHsSig ctxt (L _ sig)
890 = case (sig, ctxt) of
891 (GenericSig {}, ClsDeclCtxt {}) -> True
892 (GenericSig {}, _) -> False
893
894 (TypeSig {}, _) -> True
895
896 (PatSynSig {}, TopSigCtxt{}) -> True
897 (PatSynSig {}, _) -> False
898
899 (FixSig {}, InstDeclCtxt {}) -> False
900 (FixSig {}, _) -> True
901
902 (IdSig {}, TopSigCtxt {}) -> True
903 (IdSig {}, InstDeclCtxt {}) -> True
904 (IdSig {}, _) -> False
905
906 (InlineSig {}, HsBootCtxt) -> False
907 (InlineSig {}, _) -> True
908
909 (SpecSig {}, TopSigCtxt {}) -> True
910 (SpecSig {}, LocalBindCtxt {}) -> True
911 (SpecSig {}, InstDeclCtxt {}) -> True
912 (SpecSig {}, _) -> False
913
914 (SpecInstSig {}, InstDeclCtxt {}) -> True
915 (SpecInstSig {}, _) -> False
916
917 (MinimalSig {}, ClsDeclCtxt {}) -> True
918 (MinimalSig {}, _) -> False
919
920 -------------------
921 findDupSigs :: [LSig RdrName] -> [[(Located RdrName, Sig RdrName)]]
922 -- Check for duplicates on RdrName version,
923 -- because renamed version has unboundName for
924 -- not-in-scope binders, which gives bogus dup-sig errors
925 -- NB: in a class decl, a 'generic' sig is not considered
926 -- equal to an ordinary sig, so we allow, say
927 -- class C a where
928 -- op :: a -> a
929 -- default op :: Eq a => a -> a
930 findDupSigs sigs
931 = findDupsEq matching_sig (concatMap (expand_sig . unLoc) sigs)
932 where
933 expand_sig sig@(FixSig (FixitySig ns _)) = zip ns (repeat sig)
934 expand_sig sig@(InlineSig n _) = [(n,sig)]
935 expand_sig sig@(TypeSig ns _ _) = [(n,sig) | n <- ns]
936 expand_sig sig@(GenericSig ns _) = [(n,sig) | n <- ns]
937 expand_sig _ = []
938
939 matching_sig (L _ n1,sig1) (L _ n2,sig2) = n1 == n2 && mtch sig1 sig2
940 mtch (FixSig {}) (FixSig {}) = True
941 mtch (InlineSig {}) (InlineSig {}) = True
942 mtch (TypeSig {}) (TypeSig {}) = True
943 mtch (GenericSig {}) (GenericSig {}) = True
944 mtch _ _ = False
945
946 -- Warn about multiple MINIMAL signatures
947 checkDupMinimalSigs :: [LSig RdrName] -> RnM ()
948 checkDupMinimalSigs sigs
949 = case filter isMinimalLSig sigs of
950 minSigs@(_:_:_) -> dupMinimalSigErr minSigs
951 _ -> return ()
952
953 {-
954 ************************************************************************
955 * *
956 \subsection{Match}
957 * *
958 ************************************************************************
959 -}
960
961 rnMatchGroup :: Outputable (body RdrName) => HsMatchContext Name
962 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
963 -> MatchGroup RdrName (Located (body RdrName))
964 -> RnM (MatchGroup Name (Located (body Name)), FreeVars)
965 rnMatchGroup ctxt rnBody (MG { mg_alts = ms, mg_origin = origin })
966 = do { empty_case_ok <- xoptM Opt_EmptyCase
967 ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt))
968 ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms
969 ; return (mkMatchGroupName origin new_ms, ms_fvs) }
970
971 rnMatch :: Outputable (body RdrName) => HsMatchContext Name
972 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
973 -> LMatch RdrName (Located (body RdrName))
974 -> RnM (LMatch Name (Located (body Name)), FreeVars)
975 rnMatch ctxt rnBody = wrapLocFstM (rnMatch' ctxt rnBody)
976
977 rnMatch' :: Outputable (body RdrName) => HsMatchContext Name
978 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
979 -> Match RdrName (Located (body RdrName))
980 -> RnM (Match Name (Located (body Name)), FreeVars)
981 rnMatch' ctxt rnBody match@(Match { m_fun_id_infix = mf, m_pats = pats
982 , m_type = maybe_rhs_sig, m_grhss = grhss })
983 = do { -- Result type signatures are no longer supported
984 case maybe_rhs_sig of
985 Nothing -> return ()
986 Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty)
987
988 -- Now the main event
989 -- Note that there are no local fixity decls for matches
990 ; rnPats ctxt pats $ \ pats' -> do
991 { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
992 ; let mf' = case (ctxt,mf) of
993 (FunRhs funid isinfix,Just (L lf _,_))
994 -> Just (L lf funid,isinfix)
995 _ -> Nothing
996 ; return (Match { m_fun_id_infix = mf', m_pats = pats'
997 , m_type = Nothing, m_grhss = grhss'}, grhss_fvs ) }}
998
999 emptyCaseErr :: HsMatchContext Name -> SDoc
1000 emptyCaseErr ctxt = hang (ptext (sLit "Empty list of alternatives in") <+> pp_ctxt)
1001 2 (ptext (sLit "Use EmptyCase to allow this"))
1002 where
1003 pp_ctxt = case ctxt of
1004 CaseAlt -> ptext (sLit "case expression")
1005 LambdaExpr -> ptext (sLit "\\case expression")
1006 _ -> ptext (sLit "(unexpected)") <+> pprMatchContextNoun ctxt
1007
1008
1009 resSigErr :: Outputable body
1010 => HsMatchContext Name -> Match RdrName body -> HsType RdrName -> SDoc
1011 resSigErr ctxt match ty
1012 = vcat [ ptext (sLit "Illegal result type signature") <+> quotes (ppr ty)
1013 , nest 2 $ ptext (sLit
1014 "Result signatures are no longer supported in pattern matches")
1015 , pprMatchInCtxt ctxt match ]
1016
1017 {-
1018 ************************************************************************
1019 * *
1020 \subsubsection{Guarded right-hand sides (GRHSs)}
1021 * *
1022 ************************************************************************
1023 -}
1024
1025 rnGRHSs :: HsMatchContext Name
1026 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1027 -> GRHSs RdrName (Located (body RdrName))
1028 -> RnM (GRHSs Name (Located (body Name)), FreeVars)
1029 rnGRHSs ctxt rnBody (GRHSs grhss binds)
1030 = rnLocalBindsAndThen binds $ \ binds' -> do
1031 (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss
1032 return (GRHSs grhss' binds', fvGRHSs)
1033
1034 rnGRHS :: HsMatchContext Name
1035 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1036 -> LGRHS RdrName (Located (body RdrName))
1037 -> RnM (LGRHS Name (Located (body Name)), FreeVars)
1038 rnGRHS ctxt rnBody = wrapLocFstM (rnGRHS' ctxt rnBody)
1039
1040 rnGRHS' :: HsMatchContext Name
1041 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1042 -> GRHS RdrName (Located (body RdrName))
1043 -> RnM (GRHS Name (Located (body Name)), FreeVars)
1044 rnGRHS' ctxt rnBody (GRHS guards rhs)
1045 = do { pattern_guards_allowed <- xoptM Opt_PatternGuards
1046 ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) rnLExpr guards $ \ _ ->
1047 rnBody rhs
1048
1049 ; unless (pattern_guards_allowed || is_standard_guard guards')
1050 (addWarn (nonStdGuardErr guards'))
1051
1052 ; return (GRHS guards' rhs', fvs) }
1053 where
1054 -- Standard Haskell 1.4 guards are just a single boolean
1055 -- expression, rather than a list of qualifiers as in the
1056 -- Glasgow extension
1057 is_standard_guard [] = True
1058 is_standard_guard [L _ (BodyStmt _ _ _ _)] = True
1059 is_standard_guard _ = False
1060
1061 {-
1062 ************************************************************************
1063 * *
1064 \subsection{Error messages}
1065 * *
1066 ************************************************************************
1067 -}
1068
1069 dupSigDeclErr :: [(Located RdrName, Sig RdrName)] -> RnM ()
1070 dupSigDeclErr pairs@((L loc name, sig) : _)
1071 = addErrAt loc $
1072 vcat [ ptext (sLit "Duplicate") <+> what_it_is
1073 <> ptext (sLit "s for") <+> quotes (ppr name)
1074 , ptext (sLit "at") <+> vcat (map ppr $ sort $ map (getLoc . fst) pairs) ]
1075 where
1076 what_it_is = hsSigDoc sig
1077
1078 dupSigDeclErr [] = panic "dupSigDeclErr"
1079
1080 misplacedSigErr :: LSig Name -> RnM ()
1081 misplacedSigErr (L loc sig)
1082 = addErrAt loc $
1083 sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]
1084
1085 defaultSigErr :: Sig RdrName -> SDoc
1086 defaultSigErr sig = vcat [ hang (ptext (sLit "Unexpected default signature:"))
1087 2 (ppr sig)
1088 , ptext (sLit "Use DefaultSignatures to enable default signatures") ]
1089
1090 methodBindErr :: HsBindLR RdrName RdrName -> SDoc
1091 methodBindErr mbind
1092 = hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
1093 2 (ppr mbind)
1094
1095 methodPatSynErr :: HsBindLR RdrName RdrName -> SDoc
1096 methodPatSynErr mbind
1097 = hang (ptext (sLit "Pattern synonyms not allowed in class/instance declarations"))
1098 2 (ppr mbind)
1099
1100 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc
1101 bindsInHsBootFile mbinds
1102 = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
1103 2 (ppr mbinds)
1104
1105 nonStdGuardErr :: Outputable body => [LStmtLR Name Name body] -> SDoc
1106 nonStdGuardErr guards
1107 = hang (ptext (sLit "accepting non-standard pattern guards (use PatternGuards to suppress this message)"))
1108 4 (interpp'SP guards)
1109
1110 unusedPatBindWarn :: HsBind Name -> SDoc
1111 unusedPatBindWarn bind
1112 = hang (ptext (sLit "This pattern-binding binds no variables:"))
1113 2 (ppr bind)
1114
1115 dupMinimalSigErr :: [LSig RdrName] -> RnM ()
1116 dupMinimalSigErr sigs@(L loc _ : _)
1117 = addErrAt loc $
1118 vcat [ ptext (sLit "Multiple minimal complete definitions")
1119 , ptext (sLit "at") <+> vcat (map ppr $ sort $ map getLoc sigs)
1120 , ptext (sLit "Combine alternative minimal complete definitions with `|'") ]
1121 dupMinimalSigErr [] = panic "dupMinimalSigErr"