1af93f35d2aac5199bc74708e29b7f6ad2df54c5
[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 ; envs <- getRdrEnvs
262 ; checkDupAndShadowedNames envs bound_names
263
264 ; return (bound_names, binds') }
265
266 -- renames the left-hand sides
267 -- generic version used both at the top level and for local binds
268 -- does some error checking, but not what gets done elsewhere at the top level
269 rnValBindsLHS :: NameMaker
270 -> HsValBinds RdrName
271 -> RnM (HsValBindsLR Name RdrName)
272 rnValBindsLHS topP (ValBindsIn mbinds sigs)
273 = do { mbinds' <- mapBagM (wrapLocM (rnBindLHS topP doc)) mbinds
274 ; return $ ValBindsIn mbinds' sigs }
275 where
276 bndrs = collectHsBindsBinders mbinds
277 doc = text "In the binding group for:" <+> pprWithCommas ppr bndrs
278
279 rnValBindsLHS _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
280
281 -- General version used both from the top-level and for local things
282 -- Assumes the LHS vars are in scope
283 --
284 -- Does not bind the local fixity declarations
285 rnValBindsRHS :: HsSigCtxt
286 -> HsValBindsLR Name RdrName
287 -> RnM (HsValBinds Name, DefUses)
288
289 rnValBindsRHS ctxt (ValBindsIn mbinds sigs)
290 = do { (sigs', sig_fvs) <- renameSigs ctxt sigs
291 ; binds_w_dus <- mapBagM (rnLBind (mkSigTvFn sigs')) mbinds
292 ; case depAnalBinds binds_w_dus of
293 (anal_binds, anal_dus) -> return (valbind', valbind'_dus)
294 where
295 valbind' = ValBindsOut anal_binds sigs'
296 valbind'_dus = anal_dus `plusDU` usesOnly sig_fvs
297 -- Put the sig uses *after* the bindings
298 -- so that the binders are removed from
299 -- the uses in the sigs
300 }
301
302 rnValBindsRHS _ b = pprPanic "rnValBindsRHS" (ppr b)
303
304 -- Wrapper for local binds
305 --
306 -- The *client* of this function is responsible for checking for unused binders;
307 -- it doesn't (and can't: we don't have the thing inside the binds) happen here
308 --
309 -- The client is also responsible for bringing the fixities into scope
310 rnLocalValBindsRHS :: NameSet -- names bound by the LHSes
311 -> HsValBindsLR Name RdrName
312 -> RnM (HsValBinds Name, DefUses)
313 rnLocalValBindsRHS bound_names binds
314 = rnValBindsRHS (LocalBindCtxt bound_names) binds
315
316 -- for local binds
317 -- wrapper that does both the left- and right-hand sides
318 --
319 -- here there are no local fixity decls passed in;
320 -- the local fixity decls come from the ValBinds sigs
321 rnLocalValBindsAndThen :: HsValBinds RdrName
322 -> (HsValBinds Name -> RnM (result, FreeVars))
323 -> RnM (result, FreeVars)
324 rnLocalValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
325 = do { -- (A) Create the local fixity environment
326 new_fixities <- makeMiniFixityEnv [L loc sig
327 | L loc (FixSig sig) <- sigs]
328
329 -- (B) Rename the LHSes
330 ; (bound_names, new_lhs) <- rnLocalValBindsLHS new_fixities binds
331
332 -- ...and bring them (and their fixities) into scope
333 ; bindLocalNamesFV bound_names $
334 addLocalFixities new_fixities bound_names $ do
335
336 { -- (C) Do the RHS and thing inside
337 (binds', dus) <- rnLocalValBindsRHS (mkNameSet bound_names) new_lhs
338 ; (result, result_fvs) <- thing_inside binds'
339
340 -- Report unused bindings based on the (accurate)
341 -- findUses. E.g.
342 -- let x = x in 3
343 -- should report 'x' unused
344 ; let real_uses = findUses dus result_fvs
345 -- Insert fake uses for variables introduced implicitly by
346 -- wildcards (#4404)
347 implicit_uses = hsValBindsImplicits binds'
348 ; warnUnusedLocalBinds bound_names
349 (real_uses `unionNameSet` implicit_uses)
350
351 ; let
352 -- The variables "used" in the val binds are:
353 -- (1) the uses of the binds (allUses)
354 -- (2) the FVs of the thing-inside
355 all_uses = allUses dus `plusFV` result_fvs
356 -- Note [Unused binding hack]
357 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
358 -- Note that *in contrast* to the above reporting of
359 -- unused bindings, (1) above uses duUses to return *all*
360 -- the uses, even if the binding is unused. Otherwise consider:
361 -- x = 3
362 -- y = let p = x in 'x' -- NB: p not used
363 -- If we don't "see" the dependency of 'y' on 'x', we may put the
364 -- bindings in the wrong order, and the type checker will complain
365 -- that x isn't in scope
366 --
367 -- But note that this means we won't report 'x' as unused,
368 -- whereas we would if we had { x = 3; p = x; y = 'x' }
369
370 ; return (result, all_uses) }}
371 -- The bound names are pruned out of all_uses
372 -- by the bindLocalNamesFV call above
373
374 rnLocalValBindsAndThen bs _ = pprPanic "rnLocalValBindsAndThen" (ppr bs)
375
376
377 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
378 -- (We keep the location around for reporting duplicate fixity declarations.)
379 --
380 -- Checks for duplicates, but not that only locally defined things are fixed.
381 -- Note: for local fixity declarations, duplicates would also be checked in
382 -- check_sigs below. But we also use this function at the top level.
383
384 makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
385
386 makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls
387 where
388 add_one_sig env (L loc (FixitySig names fixity)) =
389 foldlM add_one env [ (loc,name_loc,name,fixity)
390 | L name_loc name <- names ]
391
392 add_one env (loc, name_loc, name,fixity) = do
393 { -- this fixity decl is a duplicate iff
394 -- the ReaderName's OccName's FastString is already in the env
395 -- (we only need to check the local fix_env because
396 -- definitions of non-local will be caught elsewhere)
397 let { fs = occNameFS (rdrNameOcc name)
398 ; fix_item = L loc fixity };
399
400 case lookupFsEnv env fs of
401 Nothing -> return $ extendFsEnv env fs fix_item
402 Just (L loc' _) -> do
403 { setSrcSpan loc $
404 addErrAt name_loc (dupFixityDecl loc' name)
405 ; return env}
406 }
407
408 dupFixityDecl :: SrcSpan -> RdrName -> SDoc
409 dupFixityDecl loc rdr_name
410 = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name),
411 ptext (sLit "also at ") <+> ppr loc]
412
413 ---------------------
414
415 -- renaming a single bind
416
417 rnBindLHS :: NameMaker
418 -> SDoc
419 -> HsBind RdrName
420 -- returns the renamed left-hand side,
421 -- and the FreeVars *of the LHS*
422 -- (i.e., any free variables of the pattern)
423 -> RnM (HsBindLR Name RdrName)
424
425 rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat })
426 = do
427 -- we don't actually use the FV processing of rnPatsAndThen here
428 (pat',pat'_fvs) <- rnBindPat name_maker pat
429 return (bind { pat_lhs = pat', bind_fvs = pat'_fvs })
430 -- We temporarily store the pat's FVs in bind_fvs;
431 -- gets updated to the FVs of the whole bind
432 -- when doing the RHS below
433
434 rnBindLHS name_maker _ bind@(FunBind { fun_id = name@(L nameLoc _) })
435 = do { newname <- applyNameMaker name_maker name
436 ; return (bind { fun_id = L nameLoc newname
437 , bind_fvs = placeHolderNamesTc }) }
438
439 rnBindLHS name_maker _ (PatSynBind psb@PSB{ psb_id = rdrname@(L nameLoc _) })
440 = do { unless (isTopRecNameMaker name_maker) $
441 addErr localPatternSynonymErr
442 ; addLocM checkConName rdrname
443 ; name <- applyNameMaker name_maker rdrname
444 ; return (PatSynBind psb{ psb_id = L nameLoc name }) }
445 where
446 localPatternSynonymErr :: SDoc
447 localPatternSynonymErr
448 = hang (ptext (sLit "Illegal pattern synonym declaration"))
449 2 (ptext (sLit "Pattern synonym declarations are only valid in the top-level scope"))
450
451 rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b)
452
453 rnLBind :: (Name -> [Name]) -- Signature tyvar function
454 -> LHsBindLR Name RdrName
455 -> RnM (LHsBind Name, [Name], Uses)
456 rnLBind sig_fn (L loc bind)
457 = setSrcSpan loc $
458 do { (bind', bndrs, dus) <- rnBind sig_fn bind
459 ; return (L loc bind', bndrs, dus) }
460
461 -- assumes the left-hands-side vars are in scope
462 rnBind :: (Name -> [Name]) -- Signature tyvar function
463 -> HsBindLR Name RdrName
464 -> RnM (HsBind Name, [Name], Uses)
465 rnBind _ bind@(PatBind { pat_lhs = pat
466 , pat_rhs = grhss
467 -- pat fvs were stored in bind_fvs
468 -- after processing the LHS
469 , bind_fvs = pat_fvs })
470 = do { mod <- getModule
471 ; (grhss', rhs_fvs) <- rnGRHSs PatBindRhs rnLExpr grhss
472
473 -- No scoped type variables for pattern bindings
474 ; let all_fvs = pat_fvs `plusFV` rhs_fvs
475 fvs' = filterNameSet (nameIsLocalOrFrom mod) all_fvs
476 -- Keep locally-defined Names
477 -- As well as dependency analysis, we need these for the
478 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
479 bndrs = collectPatBinders pat
480 bind' = bind { pat_rhs = grhss',
481 pat_rhs_ty = placeHolderType, bind_fvs = fvs' }
482 is_wild_pat = case pat of
483 L _ (WildPat {}) -> True
484 L _ (BangPat (L _ (WildPat {}))) -> True -- #9127
485 _ -> False
486
487 -- Warn if the pattern binds no variables, except for the
488 -- entirely-explicit idiom _ = rhs
489 -- which (a) is not that different from _v = rhs
490 -- (b) is sometimes used to give a type sig for,
491 -- or an occurrence of, a variable on the RHS
492 ; whenWOptM Opt_WarnUnusedBinds $
493 when (null bndrs && not is_wild_pat) $
494 addWarn $ unusedPatBindWarn bind'
495
496 ; fvs' `seq` -- See Note [Free-variable space leak]
497 return (bind', bndrs, all_fvs) }
498
499 rnBind sig_fn bind@(FunBind { fun_id = name
500 , fun_infix = is_infix
501 , fun_matches = matches })
502 -- invariant: no free vars here when it's a FunBind
503 = do { let plain_name = unLoc name
504
505 ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
506 -- bindSigTyVars tests for Opt_ScopedTyVars
507 rnMatchGroup (FunRhs plain_name is_infix)
508 rnLExpr matches
509 ; when is_infix $ checkPrecMatch plain_name matches'
510
511 ; mod <- getModule
512 ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) rhs_fvs
513 -- Keep locally-defined Names
514 -- As well as dependency analysis, we need these for the
515 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
516
517 ; fvs' `seq` -- See Note [Free-variable space leak]
518 return (bind { fun_matches = matches'
519 , bind_fvs = fvs' },
520 [plain_name], rhs_fvs)
521 }
522
523 rnBind sig_fn (PatSynBind bind)
524 = do { (bind', name, fvs) <- rnPatSynBind sig_fn bind
525 ; return (PatSynBind bind', name, fvs) }
526
527 rnBind _ b = pprPanic "rnBind" (ppr b)
528
529 {-
530 Note [Free-variable space leak]
531 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
532 We have
533 fvs' = trim fvs
534 and we seq fvs' before turning it as part of a record.
535
536 The reason is that trim is sometimes something like
537 \xs -> intersectNameSet (mkNameSet bound_names) xs
538 and we don't want to retain the list bound_names. This showed up in
539 trac ticket #1136.
540 -}
541
542 rnPatSynBind :: (Name -> [Name]) -- Signature tyvar function
543 -> PatSynBind Name RdrName
544 -> RnM (PatSynBind Name Name, [Name], Uses)
545 rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name
546 , psb_args = details
547 , psb_def = pat
548 , psb_dir = dir })
549 -- invariant: no free vars here when it's a FunBind
550 = do { pattern_synonym_ok <- xoptM Opt_PatternSynonyms
551 ; unless pattern_synonym_ok (addErr patternSynonymErr)
552
553 ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do
554 -- We check the 'RdrName's instead of the 'Name's
555 -- so that the binding locations are reported
556 -- from the left-hand side
557 { (details', fvs) <- case details of
558 PrefixPatSyn vars ->
559 do { checkDupRdrNames vars
560 ; names <- mapM lookupVar vars
561 ; return (PrefixPatSyn names, mkFVs (map unLoc names)) }
562 InfixPatSyn var1 var2 ->
563 do { checkDupRdrNames [var1, var2]
564 ; name1 <- lookupVar var1
565 ; name2 <- lookupVar var2
566 -- ; checkPrecMatch -- TODO
567 ; return (InfixPatSyn name1 name2, mkFVs (map unLoc [name1, name2])) }
568 ; return ((pat', details'), fvs) }
569 ; (dir', fvs2) <- case dir of
570 Unidirectional -> return (Unidirectional, emptyFVs)
571 ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
572 ExplicitBidirectional mg ->
573 do { (mg', fvs) <- rnMatchGroup PatSyn rnLExpr mg
574 ; return (ExplicitBidirectional mg', fvs) }
575
576 ; mod <- getModule
577 ; let fvs = fvs1 `plusFV` fvs2
578 fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs
579 -- Keep locally-defined Names
580 -- As well as dependency analysis, we need these for the
581 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
582
583 ; let bind' = bind{ psb_args = details'
584 , psb_def = pat'
585 , psb_dir = dir'
586 , psb_fvs = fvs' }
587
588 ; fvs' `seq` -- See Note [Free-variable space leak]
589 return (bind', [name], fvs1)
590 -- See Note [Pattern synonym wrappers don't yield dependencies]
591 }
592 where
593 lookupVar = wrapLocM lookupOccRn
594
595 patternSynonymErr :: SDoc
596 patternSynonymErr
597 = hang (ptext (sLit "Illegal pattern synonym declaration"))
598 2 (ptext (sLit "Use -XPatternSynonyms to enable this extension"))
599
600 {-
601 Note [Pattern synonym wrappers don't yield dependencies]
602 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
603 When renaming a pattern synonym that has an explicit wrapper,
604 references in the wrapper definition should not be used when
605 calculating dependencies. For example, consider the following pattern
606 synonym definition:
607
608 pattern P x <- C1 x where
609 P x = f (C1 x)
610
611 f (P x) = C2 x
612
613 In this case, 'P' needs to be typechecked in two passes:
614
615 1. Typecheck the pattern definition of 'P', which fully determines the
616 type of 'P'. This step doesn't require knowing anything about 'f',
617 since the wrapper definition is not looked at.
618
619 2. Typecheck the wrapper definition, which needs the typechecked
620 definition of 'f' to be in scope.
621
622 This behaviour is implemented in 'tcValBinds', but it crucially
623 depends on 'P' not being put in a recursive group with 'f' (which
624 would make it look like a recursive pattern synonym a la 'pattern P =
625 P' which is unsound and rejected).
626
627 -}
628
629 ---------------------
630 depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
631 -> ([(RecFlag, LHsBinds Name)], DefUses)
632 -- Dependency analysis; this is important so that
633 -- unused-binding reporting is accurate
634 depAnalBinds binds_w_dus
635 = (map get_binds sccs, map get_du sccs)
636 where
637 sccs = depAnal (\(_, defs, _) -> defs)
638 (\(_, _, uses) -> nameSetElems uses)
639 (bagToList binds_w_dus)
640
641 get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
642 get_binds (CyclicSCC binds_w_dus) = (Recursive, listToBag [b | (b,_,_) <- binds_w_dus])
643
644 get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
645 get_du (CyclicSCC binds_w_dus) = (Just defs, uses)
646 where
647 defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
648 uses = unionNameSets [u | (_,_,u) <- binds_w_dus]
649
650 ---------------------
651 -- Bind the top-level forall'd type variables in the sigs.
652 -- E.g f :: a -> a
653 -- f = rhs
654 -- The 'a' scopes over the rhs
655 --
656 -- NB: there'll usually be just one (for a function binding)
657 -- but if there are many, one may shadow the rest; too bad!
658 -- e.g x :: [a] -> [a]
659 -- y :: [(a,a)] -> a
660 -- (x,y) = e
661 -- In e, 'a' will be in scope, and it'll be the one from 'y'!
662
663 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
664 -- Return a lookup function that maps an Id Name to the names
665 -- of the type variables that should scope over its body..
666 mkSigTvFn sigs
667 = \n -> lookupNameEnv env n `orElse` []
668 where
669 extractScopedTyVars :: LHsType Name -> [Name]
670 extractScopedTyVars (L _ (HsForAllTy Explicit _ ltvs _ _)) = hsLKiTyVarNames ltvs
671 extractScopedTyVars _ = []
672
673 env :: NameEnv [Name]
674 env = mkNameEnv [ (name, nwcs ++ extractScopedTyVars ty) -- Kind variables and type variables
675 | L _ (TypeSig names ty nwcs) <- sigs
676 , L _ name <- names]
677 -- Note the pattern-match on "Explicit"; we only bind
678 -- type variables from signatures with an explicit top-level for-all
679
680 {-
681 @rnMethodBinds@ is used for the method bindings of a class and an instance
682 declaration. Like @rnBinds@ but without dependency analysis.
683
684 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
685 That's crucial when dealing with an instance decl:
686 \begin{verbatim}
687 instance Foo (T a) where
688 op x = ...
689 \end{verbatim}
690 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
691 and unless @op@ occurs we won't treat the type signature of @op@ in the class
692 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
693 in many ways the @op@ in an instance decl is just like an occurrence, not
694 a binder.
695 -}
696
697 rnMethodBinds :: Name -- Class name
698 -> (Name -> [Name]) -- Signature tyvar function
699 -> LHsBinds RdrName
700 -> RnM (LHsBinds Name, FreeVars)
701
702 rnMethodBinds cls sig_fn binds
703 = do { checkDupRdrNames meth_names
704 -- Check that the same method is not given twice in the
705 -- same instance decl instance C T where
706 -- f x = ...
707 -- g y = ...
708 -- f x = ...
709 -- We must use checkDupRdrNames because the Name of the
710 -- method is the Name of the class selector, whose SrcSpan
711 -- points to the class declaration; and we use rnMethodBinds
712 -- for instance decls too
713
714 ; foldlM do_one (emptyBag, emptyFVs) (bagToList binds) }
715 where
716 meth_names = collectMethodBinders binds
717 do_one (binds,fvs) bind
718 = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn bind
719 ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) }
720
721 rnMethodBind :: Name
722 -> (Name -> [Name])
723 -> LHsBindLR RdrName RdrName
724 -> RnM (Bag (LHsBindLR Name Name), FreeVars)
725 rnMethodBind cls sig_fn
726 (L loc bind@(FunBind { fun_id = name, fun_infix = is_infix
727 , fun_matches = MG { mg_alts = matches
728 , mg_origin = origin } }))
729 = setSrcSpan loc $ do
730 sel_name <- wrapLocM (lookupInstDeclBndr cls (ptext (sLit "method"))) name
731 let plain_name = unLoc sel_name
732 -- We use the selector name as the binder
733
734 (new_matches, fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
735 mapFvRn (rnMatch (FunRhs plain_name is_infix) rnLExpr)
736 matches
737 let new_group = mkMatchGroupName origin new_matches
738
739 when is_infix $ checkPrecMatch plain_name new_group
740 return (unitBag (L loc (bind { fun_id = sel_name
741 , fun_matches = new_group
742 , bind_fvs = fvs })),
743 fvs `addOneFV` plain_name)
744 -- The 'fvs' field isn't used for method binds
745
746 -- Can't handle method pattern-bindings which bind multiple methods.
747 rnMethodBind _ _ (L loc bind@(PatBind {})) = do
748 addErrAt loc (methodBindErr bind)
749 return (emptyBag, emptyFVs)
750
751 -- Associated pattern synonyms are not implemented yet
752 rnMethodBind _ _ (L loc bind@(PatSynBind {})) = do
753 addErrAt loc $ methodPatSynErr bind
754 return (emptyBag, emptyFVs)
755
756 rnMethodBind _ _ b = pprPanic "rnMethodBind" (ppr b)
757
758 {-
759 ************************************************************************
760 * *
761 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
762 * *
763 ************************************************************************
764
765 @renameSigs@ checks for:
766 \begin{enumerate}
767 \item more than one sig for one thing;
768 \item signatures given for things not bound here;
769 \end{enumerate}
770
771 At the moment we don't gather free-var info from the types in
772 signatures. We'd only need this if we wanted to report unused tyvars.
773 -}
774
775 renameSigs :: HsSigCtxt
776 -> [LSig RdrName]
777 -> RnM ([LSig Name], FreeVars)
778 -- Renames the signatures and performs error checks
779 renameSigs ctxt sigs
780 = do { mapM_ dupSigDeclErr (findDupSigs sigs)
781
782 ; checkDupMinimalSigs sigs
783
784 ; (sigs', sig_fvs) <- mapFvRn (wrapLocFstM (renameSig ctxt)) sigs
785
786 ; let (good_sigs, bad_sigs) = partition (okHsSig ctxt) sigs'
787 ; mapM_ misplacedSigErr bad_sigs -- Misplaced
788
789 ; return (good_sigs, sig_fvs) }
790
791 ----------------------
792 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
793 -- because this won't work for:
794 -- instance Foo T where
795 -- {-# INLINE op #-}
796 -- Baz.op = ...
797 -- We'll just rename the INLINE prag to refer to whatever other 'op'
798 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
799 -- Doesn't seem worth much trouble to sort this.
800
801 renameSig :: HsSigCtxt -> Sig RdrName -> RnM (Sig Name, FreeVars)
802 -- FixitySig is renamed elsewhere.
803 renameSig _ (IdSig x)
804 = return (IdSig x, emptyFVs) -- Actually this never occurs
805
806 renameSig ctxt sig@(TypeSig vs ty _)
807 = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
808 -- (named and anonymous) wildcards are bound here.
809 ; (wcs, ty') <- extractWildcards ty
810 ; bindLocatedLocalsFV wcs $ \wcs_new -> do {
811 (new_ty, fvs) <- rnHsSigType (ppr_sig_bndrs vs) ty'
812 ; return (TypeSig new_vs new_ty wcs_new, fvs) } }
813
814 renameSig ctxt sig@(GenericSig vs ty)
815 = do { defaultSigs_on <- xoptM Opt_DefaultSignatures
816 ; unless defaultSigs_on (addErr (defaultSigErr sig))
817 ; new_v <- mapM (lookupSigOccRn ctxt sig) vs
818 ; (new_ty, fvs) <- rnHsSigType (ppr_sig_bndrs vs) ty
819 ; return (GenericSig new_v new_ty, fvs) }
820
821 renameSig _ (SpecInstSig ty)
822 = do { (new_ty, fvs) <- rnLHsType SpecInstSigCtx ty
823 ; return (SpecInstSig new_ty,fvs) }
824
825 -- {-# SPECIALISE #-} pragmas can refer to imported Ids
826 -- so, in the top-level case (when mb_names is Nothing)
827 -- we use lookupOccRn. If there's both an imported and a local 'f'
828 -- then the SPECIALISE pragma is ambiguous, unlike all other signatures
829 renameSig ctxt sig@(SpecSig v tys inl)
830 = do { new_v <- case ctxt of
831 TopSigCtxt {} -> lookupLocatedOccRn v
832 _ -> lookupSigOccRn ctxt sig v
833 -- ; (new_ty, fvs) <- rnHsSigType (quotes (ppr v)) ty
834 ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
835 ; return (SpecSig new_v new_ty inl, fvs) }
836 where
837 do_one (tys,fvs) ty
838 = do { (new_ty, fvs_ty) <- rnHsSigType (quotes (ppr v)) ty
839 ; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
840
841 renameSig ctxt sig@(InlineSig v s)
842 = do { new_v <- lookupSigOccRn ctxt sig v
843 ; return (InlineSig new_v s, emptyFVs) }
844
845 renameSig ctxt sig@(FixSig (FixitySig vs f))
846 = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
847 ; return (FixSig (FixitySig new_vs f), emptyFVs) }
848
849 renameSig ctxt sig@(MinimalSig bf)
850 = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
851 return (MinimalSig new_bf, emptyFVs)
852
853 renameSig ctxt sig@(PatSynSig v (flag, qtvs) prov req ty)
854 = do { v' <- lookupSigOccRn ctxt sig v
855 ; let doc = TypeSigCtx $ quotes (ppr v)
856 ; loc <- getSrcSpanM
857
858 ; let (tv_kvs, mentioned) = extractHsTysRdrTyVars (ty:unLoc prov ++ unLoc req)
859 ; tv_bndrs <- case flag of
860 Implicit ->
861 return $ mkHsQTvs . userHsTyVarBndrs loc $ mentioned
862 Explicit ->
863 do { let heading = ptext (sLit "In the pattern synonym type signature")
864 <+> quotes (ppr sig)
865 ; warnUnusedForAlls (heading $$ docOfHsDocContext doc) qtvs mentioned
866 ; return qtvs }
867 Qualified -> panic "renameSig: Qualified"
868
869 ; bindHsTyVars doc Nothing tv_kvs tv_bndrs $ \ tyvars -> do
870 { (prov', fvs1) <- rnContext doc prov
871 ; (req', fvs2) <- rnContext doc req
872 ; (ty', fvs3) <- rnLHsType doc ty
873
874 ; let fvs = plusFVs [fvs1, fvs2, fvs3]
875 ; return (PatSynSig v' (flag, tyvars) prov' req' ty', fvs) }}
876
877 ppr_sig_bndrs :: [Located RdrName] -> SDoc
878 ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
879
880 okHsSig :: HsSigCtxt -> LSig a -> Bool
881 okHsSig ctxt (L _ sig)
882 = case (sig, ctxt) of
883 (GenericSig {}, ClsDeclCtxt {}) -> True
884 (GenericSig {}, _) -> False
885
886 (TypeSig {}, _) -> True
887
888 (PatSynSig {}, TopSigCtxt{}) -> True
889 (PatSynSig {}, _) -> False
890
891 (FixSig {}, InstDeclCtxt {}) -> False
892 (FixSig {}, _) -> True
893
894 (IdSig {}, TopSigCtxt {}) -> True
895 (IdSig {}, InstDeclCtxt {}) -> True
896 (IdSig {}, _) -> False
897
898 (InlineSig {}, HsBootCtxt) -> False
899 (InlineSig {}, _) -> True
900
901 (SpecSig {}, TopSigCtxt {}) -> True
902 (SpecSig {}, LocalBindCtxt {}) -> True
903 (SpecSig {}, InstDeclCtxt {}) -> True
904 (SpecSig {}, _) -> False
905
906 (SpecInstSig {}, InstDeclCtxt {}) -> True
907 (SpecInstSig {}, _) -> False
908
909 (MinimalSig {}, ClsDeclCtxt {}) -> True
910 (MinimalSig {}, _) -> False
911
912 -------------------
913 findDupSigs :: [LSig RdrName] -> [[(Located RdrName, Sig RdrName)]]
914 -- Check for duplicates on RdrName version,
915 -- because renamed version has unboundName for
916 -- not-in-scope binders, which gives bogus dup-sig errors
917 -- NB: in a class decl, a 'generic' sig is not considered
918 -- equal to an ordinary sig, so we allow, say
919 -- class C a where
920 -- op :: a -> a
921 -- default op :: Eq a => a -> a
922 findDupSigs sigs
923 = findDupsEq matching_sig (concatMap (expand_sig . unLoc) sigs)
924 where
925 expand_sig sig@(FixSig (FixitySig ns _)) = zip ns (repeat sig)
926 expand_sig sig@(InlineSig n _) = [(n,sig)]
927 expand_sig sig@(TypeSig ns _ _) = [(n,sig) | n <- ns]
928 expand_sig sig@(GenericSig ns _) = [(n,sig) | n <- ns]
929 expand_sig _ = []
930
931 matching_sig (L _ n1,sig1) (L _ n2,sig2) = n1 == n2 && mtch sig1 sig2
932 mtch (FixSig {}) (FixSig {}) = True
933 mtch (InlineSig {}) (InlineSig {}) = True
934 mtch (TypeSig {}) (TypeSig {}) = True
935 mtch (GenericSig {}) (GenericSig {}) = True
936 mtch _ _ = False
937
938 -- Warn about multiple MINIMAL signatures
939 checkDupMinimalSigs :: [LSig RdrName] -> RnM ()
940 checkDupMinimalSigs sigs
941 = case filter isMinimalLSig sigs of
942 minSigs@(_:_:_) -> dupMinimalSigErr minSigs
943 _ -> return ()
944
945 {-
946 ************************************************************************
947 * *
948 \subsection{Match}
949 * *
950 ************************************************************************
951 -}
952
953 rnMatchGroup :: Outputable (body RdrName) => HsMatchContext Name
954 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
955 -> MatchGroup RdrName (Located (body RdrName))
956 -> RnM (MatchGroup Name (Located (body Name)), FreeVars)
957 rnMatchGroup ctxt rnBody (MG { mg_alts = ms, mg_origin = origin })
958 = do { empty_case_ok <- xoptM Opt_EmptyCase
959 ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt))
960 ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms
961 ; return (mkMatchGroupName origin new_ms, ms_fvs) }
962
963 rnMatch :: Outputable (body RdrName) => HsMatchContext Name
964 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
965 -> LMatch RdrName (Located (body RdrName))
966 -> RnM (LMatch Name (Located (body Name)), FreeVars)
967 rnMatch ctxt rnBody = wrapLocFstM (rnMatch' ctxt rnBody)
968
969 rnMatch' :: Outputable (body RdrName) => HsMatchContext Name
970 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
971 -> Match RdrName (Located (body RdrName))
972 -> RnM (Match Name (Located (body Name)), FreeVars)
973 rnMatch' ctxt rnBody match@(Match pats maybe_rhs_sig grhss)
974 = do { -- Result type signatures are no longer supported
975 case maybe_rhs_sig of
976 Nothing -> return ()
977 Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty)
978
979 -- Now the main event
980 -- note that there are no local ficity decls for matches
981 ; rnPats ctxt pats $ \ pats' -> do
982 { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
983
984 ; return (Match pats' Nothing grhss', grhss_fvs) }}
985
986 emptyCaseErr :: HsMatchContext Name -> SDoc
987 emptyCaseErr ctxt = hang (ptext (sLit "Empty list of alternatives in") <+> pp_ctxt)
988 2 (ptext (sLit "Use EmptyCase to allow this"))
989 where
990 pp_ctxt = case ctxt of
991 CaseAlt -> ptext (sLit "case expression")
992 LambdaExpr -> ptext (sLit "\\case expression")
993 _ -> ptext (sLit "(unexpected)") <+> pprMatchContextNoun ctxt
994
995
996 resSigErr :: Outputable body
997 => HsMatchContext Name -> Match RdrName body -> HsType RdrName -> SDoc
998 resSigErr ctxt match ty
999 = vcat [ ptext (sLit "Illegal result type signature") <+> quotes (ppr ty)
1000 , nest 2 $ ptext (sLit
1001 "Result signatures are no longer supported in pattern matches")
1002 , pprMatchInCtxt ctxt match ]
1003
1004 {-
1005 ************************************************************************
1006 * *
1007 \subsubsection{Guarded right-hand sides (GRHSs)}
1008 * *
1009 ************************************************************************
1010 -}
1011
1012 rnGRHSs :: HsMatchContext Name
1013 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1014 -> GRHSs RdrName (Located (body RdrName))
1015 -> RnM (GRHSs Name (Located (body Name)), FreeVars)
1016 rnGRHSs ctxt rnBody (GRHSs grhss binds)
1017 = rnLocalBindsAndThen binds $ \ binds' -> do
1018 (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss
1019 return (GRHSs grhss' binds', fvGRHSs)
1020
1021 rnGRHS :: HsMatchContext Name
1022 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1023 -> LGRHS RdrName (Located (body RdrName))
1024 -> RnM (LGRHS Name (Located (body Name)), FreeVars)
1025 rnGRHS ctxt rnBody = wrapLocFstM (rnGRHS' ctxt rnBody)
1026
1027 rnGRHS' :: HsMatchContext Name
1028 -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1029 -> GRHS RdrName (Located (body RdrName))
1030 -> RnM (GRHS Name (Located (body Name)), FreeVars)
1031 rnGRHS' ctxt rnBody (GRHS guards rhs)
1032 = do { pattern_guards_allowed <- xoptM Opt_PatternGuards
1033 ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) rnLExpr guards $ \ _ ->
1034 rnBody rhs
1035
1036 ; unless (pattern_guards_allowed || is_standard_guard guards')
1037 (addWarn (nonStdGuardErr guards'))
1038
1039 ; return (GRHS guards' rhs', fvs) }
1040 where
1041 -- Standard Haskell 1.4 guards are just a single boolean
1042 -- expression, rather than a list of qualifiers as in the
1043 -- Glasgow extension
1044 is_standard_guard [] = True
1045 is_standard_guard [L _ (BodyStmt _ _ _ _)] = True
1046 is_standard_guard _ = False
1047
1048 {-
1049 ************************************************************************
1050 * *
1051 \subsection{Error messages}
1052 * *
1053 ************************************************************************
1054 -}
1055
1056 dupSigDeclErr :: [(Located RdrName, Sig RdrName)] -> RnM ()
1057 dupSigDeclErr pairs@((L loc name, sig) : _)
1058 = addErrAt loc $
1059 vcat [ ptext (sLit "Duplicate") <+> what_it_is
1060 <> ptext (sLit "s for") <+> quotes (ppr name)
1061 , ptext (sLit "at") <+> vcat (map ppr $ sort $ map (getLoc . fst) pairs) ]
1062 where
1063 what_it_is = hsSigDoc sig
1064
1065 dupSigDeclErr [] = panic "dupSigDeclErr"
1066
1067 misplacedSigErr :: LSig Name -> RnM ()
1068 misplacedSigErr (L loc sig)
1069 = addErrAt loc $
1070 sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]
1071
1072 defaultSigErr :: Sig RdrName -> SDoc
1073 defaultSigErr sig = vcat [ hang (ptext (sLit "Unexpected default signature:"))
1074 2 (ppr sig)
1075 , ptext (sLit "Use DefaultSignatures to enable default signatures") ]
1076
1077 methodBindErr :: HsBindLR RdrName RdrName -> SDoc
1078 methodBindErr mbind
1079 = hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
1080 2 (ppr mbind)
1081
1082 methodPatSynErr :: HsBindLR RdrName RdrName -> SDoc
1083 methodPatSynErr mbind
1084 = hang (ptext (sLit "Pattern synonyms not allowed in class/instance declarations"))
1085 2 (ppr mbind)
1086
1087 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc
1088 bindsInHsBootFile mbinds
1089 = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
1090 2 (ppr mbinds)
1091
1092 nonStdGuardErr :: Outputable body => [LStmtLR Name Name body] -> SDoc
1093 nonStdGuardErr guards
1094 = hang (ptext (sLit "accepting non-standard pattern guards (use PatternGuards to suppress this message)"))
1095 4 (interpp'SP guards)
1096
1097 unusedPatBindWarn :: HsBind Name -> SDoc
1098 unusedPatBindWarn bind
1099 = hang (ptext (sLit "This pattern-binding binds no variables:"))
1100 2 (ppr bind)
1101
1102 dupMinimalSigErr :: [LSig RdrName] -> RnM ()
1103 dupMinimalSigErr sigs@(L loc _ : _)
1104 = addErrAt loc $
1105 vcat [ ptext (sLit "Multiple minimal complete definitions")
1106 , ptext (sLit "at") <+> vcat (map ppr $ sort $ map getLoc sigs)
1107 , ptext (sLit "Combine alternative minimal complete definitions with `|'") ]
1108 dupMinimalSigErr [] = panic "dupMinimalSigErr"