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