2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnBinds]{Renaming and dependency analysis of bindings}
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).
13 -- Renaming top-level bindings
14 rnTopBinds, rnTopBindsLHS, rnTopBindsRHS,
16 -- Renaming local bindings
17 rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
20 rnMethodBinds, renameSigs, mkSigTvFn,
21 rnMatchGroup, rnGRHSs,
22 makeMiniFixityEnv, MiniFixityEnv,
26 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
31 import RnTypes ( rnHsSigType, rnLHsType, checkPrecMatch)
32 import RnPat (rnPats, rnBindPat,
33 NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker
41 import RdrName ( RdrName, rdrNameOcc )
43 import ListSetOps ( findDupsEq )
44 import BasicTypes ( RecFlag(..) )
45 import Digraph ( SCC(..), stronglyConnCompFromEdgedVertices )
49 import Data.List ( partition )
50 import Maybes ( orElse )
54 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
55 -- place and can be used when complaining.
57 The code tree received by the function @rnBinds@ contains definitions
58 in where-clauses which are all apparently mutually recursive, but which may
59 not really depend upon each other. For example, in the top level program
64 the definitions of @a@ and @y@ do not depend on each other at all.
65 Unfortunately, the typechecker cannot always check such definitions.
66 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
67 definitions. In Proceedings of the International Symposium on Programming,
68 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
69 However, the typechecker usually can check definitions in which only the
70 strongly connected components have been collected into recursive bindings.
71 This is precisely what the function @rnBinds@ does.
73 ToDo: deal with case where a single monobinds binds the same variable
76 The vertag tag is a unique @Int@; the tags only need to be unique
77 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
78 (heavy monad machinery not needed).
81 %************************************************************************
83 %* naming conventions *
85 %************************************************************************
87 \subsection[name-conventions]{Name conventions}
89 The basic algorithm involves walking over the tree and returning a tuple
90 containing the new tree plus its free variables. Some functions, such
91 as those walking polymorphic bindings (HsBinds) and qualifier lists in
92 list comprehensions (@Quals@), return the variables bound in local
93 environments. These are then used to calculate the free variables of the
94 expression evaluated in these environments.
96 Conventions for variable names are as follows:
99 new code is given a prime to distinguish it from the old.
102 a set of variables defined in @Exp@ is written @dvExp@
105 a set of variables free in @Exp@ is written @fvExp@
108 %************************************************************************
110 %* analysing polymorphic bindings (HsBindGroup, HsBind)
112 %************************************************************************
114 \subsubsection[dep-HsBinds]{Polymorphic bindings}
116 Non-recursive expressions are reconstructed without any changes at top
117 level, although their component expressions may have to be altered.
118 However, non-recursive expressions are currently not expected as
119 \Haskell{} programs, and this code should not be executed.
121 Monomorphic bindings contain information that is returned in a tuple
122 (a @FlatMonoBinds@) containing:
126 a unique @Int@ that serves as the ``vertex tag'' for this binding.
129 the name of a function or the names in a pattern. These are a set
130 referred to as @dvLhs@, the defined variables of the left hand side.
133 the free variables of the body. These are referred to as @fvBody@.
136 the definition's actual code. This is referred to as just @code@.
139 The function @nonRecDvFv@ returns two sets of variables. The first is
140 the set of variables defined in the set of monomorphic bindings, while the
141 second is the set of free variables in those bindings.
143 The set of variables defined in a non-recursive binding is just the
144 union of all of them, as @union@ removes duplicates. However, the
145 free variables in each successive set of cumulative bindings is the
146 union of those in the previous set plus those of the newest binding after
147 the defined variables of the previous set have been removed.
149 @rnMethodBinds@ deals only with the declarations in class and
150 instance declarations. It expects only to see @FunMonoBind@s, and
151 it expects the global environment to contain bindings for the binders
152 (which are all class operations).
154 %************************************************************************
156 \subsubsection{ Top-level bindings}
158 %************************************************************************
161 -- for top-level bindings, we need to make top-level names,
162 -- so we have a different entry point than for local bindings
163 rnTopBindsLHS :: MiniFixityEnv
164 -> HsValBinds RdrName
165 -> RnM (HsValBindsLR Name RdrName)
166 rnTopBindsLHS fix_env binds
167 = rnValBindsLHS (topRecNameMaker fix_env) binds
169 rnTopBindsRHS :: HsValBindsLR Name RdrName
170 -> RnM (HsValBinds Name, DefUses)
172 = do { is_boot <- tcIsHsBoot
174 then rnTopBindsBoot binds
175 else rnValBindsRHS noTrimFVs -- don't trim free vars
176 Nothing -- Allow SPEC prags for imports
179 -- Wrapper if we don't need to do anything in between the left and right,
180 -- or anything else in the scope of the left
182 -- Never used when there are fixity declarations
183 rnTopBinds :: HsValBinds RdrName
184 -> RnM (HsValBinds Name, DefUses)
186 = do { nl <- rnTopBindsLHS emptyFsEnv b
187 ; let bound_names = collectHsValBinders nl
188 ; bindLocalNames bound_names $
189 rnValBindsRHS noTrimFVs (Just (mkNameSet bound_names)) nl }
192 rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
193 -- A hs-boot file has no bindings.
194 -- Return a single HsBindGroup with empty binds and renamed signatures
195 rnTopBindsBoot (ValBindsIn mbinds sigs)
196 = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
197 ; sigs' <- renameSigs Nothing okHsBootSig sigs
198 ; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }
199 rnTopBindsBoot b = pprPanic "rnTopBindsBoot" (ppr b)
203 %*********************************************************
207 %*********************************************************
210 rnLocalBindsAndThen :: HsLocalBinds RdrName
211 -> (HsLocalBinds Name -> RnM (result, FreeVars))
212 -> RnM (result, FreeVars)
213 -- This version (a) assumes that the binding vars are *not* already in scope
214 -- (b) removes the binders from the free vars of the thing inside
215 -- The parser doesn't produce ThenBinds
216 rnLocalBindsAndThen EmptyLocalBinds thing_inside
217 = thing_inside EmptyLocalBinds
219 rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
220 = rnLocalValBindsAndThen val_binds $ \ val_binds' ->
221 thing_inside (HsValBinds val_binds')
223 rnLocalBindsAndThen (HsIPBinds binds) thing_inside = do
224 (binds',fv_binds) <- rnIPBinds binds
225 (thing, fvs_thing) <- thing_inside (HsIPBinds binds')
226 return (thing, fvs_thing `plusFV` fv_binds)
228 rnIPBinds :: HsIPBinds RdrName -> RnM (HsIPBinds Name, FreeVars)
229 rnIPBinds (IPBinds ip_binds _no_dict_binds) = do
230 (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
231 return (IPBinds ip_binds' emptyTcEvBinds, plusFVs fvs_s)
233 rnIPBind :: IPBind RdrName -> RnM (IPBind Name, FreeVars)
234 rnIPBind (IPBind n expr) = do
235 name <- newIPNameRn n
236 (expr',fvExpr) <- rnLExpr expr
237 return (IPBind name expr', fvExpr)
241 %************************************************************************
245 %************************************************************************
248 -- Renaming local binding gropus
249 -- Does duplicate/shadow check
250 rnLocalValBindsLHS :: MiniFixityEnv
251 -> HsValBinds RdrName
252 -> RnM ([Name], HsValBindsLR Name RdrName)
253 rnLocalValBindsLHS fix_env binds
254 = do { -- Do error checking: 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.
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,
263 -- should not produce a shadowing warning (but it will produce
264 -- an ambiguity warning if you use f), but
266 -- g = let f = ... in f
268 ; binds' <- rnValBindsLHS (localRecNameMaker fix_env) binds
269 ; let bound_names = collectHsValBinders binds'
271 ; checkDupAndShadowedNames envs bound_names
272 ; return (bound_names, binds') }
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 (rnBindLHS topP doc) mbinds
282 ; return $ ValBindsIn mbinds' sigs }
284 bndrs = collectHsBindsBinders mbinds
285 doc = text "In the binding group for:" <+> pprWithCommas ppr bndrs
287 rnValBindsLHS _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
289 -- General version used both from the top-level and for local things
290 -- Assumes the LHS vars are in scope
292 -- Does not bind the local fixity declarations
293 rnValBindsRHS :: (FreeVars -> FreeVars) -- for trimming free var sets
294 -- The trimming function trims the free vars we attach to a
295 -- binding so that it stays reasonably small
296 -> Maybe NameSet -- Names bound by the LHSes
297 -- Nothing if expect sigs for imports
298 -> HsValBindsLR Name RdrName
299 -> RnM (HsValBinds Name, DefUses)
301 rnValBindsRHS trim mb_bound_names (ValBindsIn mbinds sigs)
302 = do { sigs' <- renameSigs mb_bound_names okBindSig sigs
303 ; binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
304 ; case depAnalBinds binds_w_dus of
305 (anal_binds, anal_dus) -> return (valbind', valbind'_dus)
307 valbind' = ValBindsOut anal_binds sigs'
308 valbind'_dus = anal_dus `plusDU` usesOnly (hsSigsFVs sigs')
309 -- Put the sig uses *after* the bindings
310 -- so that the binders are removed from
311 -- the uses in the sigs
314 rnValBindsRHS _ _ b = pprPanic "rnValBindsRHS" (ppr b)
316 noTrimFVs :: FreeVars -> FreeVars
319 -- Wrapper for local binds
321 -- The *client* of this function is responsible for checking for unused binders;
322 -- it doesn't (and can't: we don't have the thing inside the binds) happen here
324 -- The client is also responsible for bringing the fixities into scope
325 rnLocalValBindsRHS :: NameSet -- names bound by the LHSes
326 -> HsValBindsLR Name RdrName
327 -> RnM (HsValBinds Name, DefUses)
328 rnLocalValBindsRHS bound_names binds
329 = rnValBindsRHS trim (Just bound_names) binds
331 trim fvs = intersectNameSet bound_names fvs
332 -- Only keep the names the names from this group
335 -- wrapper that does both the left- and right-hand sides
337 -- here there are no local fixity decls passed in;
338 -- the local fixity decls come from the ValBinds sigs
339 rnLocalValBindsAndThen :: HsValBinds RdrName
340 -> (HsValBinds Name -> RnM (result, FreeVars))
341 -> RnM (result, FreeVars)
342 rnLocalValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
343 = do { -- (A) Create the local fixity environment
344 new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs]
346 -- (B) Rename the LHSes
347 ; (bound_names, new_lhs) <- rnLocalValBindsLHS new_fixities binds
349 -- ...and bring them (and their fixities) into scope
350 ; bindLocalNamesFV bound_names $
351 addLocalFixities new_fixities bound_names $ do
353 { -- (C) Do the RHS and thing inside
354 (binds', dus) <- rnLocalValBindsRHS (mkNameSet bound_names) new_lhs
355 ; (result, result_fvs) <- thing_inside binds'
357 -- Report unused bindings based on the (accurate)
360 -- should report 'x' unused
361 ; let real_uses = findUses dus result_fvs
362 -- Insert fake uses for variables introduced implicitly by wildcards (#4404)
363 implicit_uses = hsValBindsImplicits binds'
364 ; warnUnusedLocalBinds bound_names (real_uses `unionNameSets` implicit_uses)
367 -- The variables "used" in the val binds are:
368 -- (1) the uses of the binds (allUses)
369 -- (2) the FVs of the thing-inside
370 all_uses = allUses dus `plusFV` result_fvs
371 -- Note [Unused binding hack]
372 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
373 -- Note that *in contrast* to the above reporting of
374 -- unused bindings, (1) above uses duUses to return *all*
375 -- the uses, even if the binding is unused. Otherwise consider:
377 -- y = let p = x in 'x' -- NB: p not used
378 -- If we don't "see" the dependency of 'y' on 'x', we may put the
379 -- bindings in the wrong order, and the type checker will complain
380 -- that x isn't in scope
382 -- But note that this means we won't report 'x' as unused,
383 -- whereas we would if we had { x = 3; p = x; y = 'x' }
385 ; return (result, all_uses) }}
386 -- The bound names are pruned out of all_uses
387 -- by the bindLocalNamesFV call above
389 rnLocalValBindsAndThen bs _ = pprPanic "rnLocalValBindsAndThen" (ppr bs)
392 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
393 -- (We keep the location around for reporting duplicate fixity declarations.)
395 -- Checks for duplicates, but not that only locally defined things are fixed.
396 -- Note: for local fixity declarations, duplicates would also be checked in
397 -- check_sigs below. But we also use this function at the top level.
399 makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
401 makeMiniFixityEnv decls = foldlM add_one emptyFsEnv decls
403 add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
404 { -- this fixity decl is a duplicate iff
405 -- the ReaderName's OccName's FastString is already in the env
406 -- (we only need to check the local fix_env because
407 -- definitions of non-local will be caught elsewhere)
408 let { fs = occNameFS (rdrNameOcc name)
409 ; fix_item = L loc fixity };
411 case lookupFsEnv env fs of
412 Nothing -> return $ extendFsEnv env fs fix_item
413 Just (L loc' _) -> do
415 addErrAt name_loc (dupFixityDecl loc' name)
419 dupFixityDecl :: SrcSpan -> RdrName -> SDoc
420 dupFixityDecl loc rdr_name
421 = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name),
422 ptext (sLit "also at ") <+> ppr loc]
424 ---------------------
426 -- renaming a single bind
428 rnBindLHS :: NameMaker
431 -- returns the renamed left-hand side,
432 -- and the FreeVars *of the LHS*
433 -- (i.e., any free variables of the pattern)
434 -> RnM (LHsBindLR Name RdrName)
436 rnBindLHS name_maker _ (L loc bind@(PatBind { pat_lhs = pat }))
437 = setSrcSpan loc $ do
438 -- we don't actually use the FV processing of rnPatsAndThen here
439 (pat',pat'_fvs) <- rnBindPat name_maker pat
440 return (L loc (bind { pat_lhs = pat', bind_fvs = pat'_fvs }))
441 -- We temporarily store the pat's FVs in bind_fvs;
442 -- gets updated to the FVs of the whole bind
443 -- when doing the RHS below
445 rnBindLHS name_maker _ (L loc bind@(FunBind { fun_id = name@(L nameLoc _) }))
447 do { newname <- applyNameMaker name_maker name
448 ; return (L loc (bind { fun_id = L nameLoc newname })) }
450 rnBindLHS _ _ b = pprPanic "rnBindLHS" (ppr b)
452 -- assumes the left-hands-side vars are in scope
453 rnBind :: (Name -> [Name]) -- Signature tyvar function
454 -> (FreeVars -> FreeVars) -- Trimming function for rhs free vars
455 -> LHsBindLR Name RdrName
456 -> RnM (LHsBind Name, [Name], Uses)
457 rnBind _ trim (L loc bind@(PatBind { pat_lhs = pat
459 -- pat fvs were stored in bind_fvs
460 -- after processing the LHS
461 , bind_fvs = pat_fvs }))
463 do { let bndrs = collectPatBinders pat
465 ; (grhss', fvs) <- rnGRHSs PatBindRhs grhss
466 -- No scoped type variables for pattern bindings
467 ; let all_fvs = pat_fvs `plusFV` fvs
470 ; fvs' `seq` -- See Note [Free-variable space leak]
471 return (L loc (bind { pat_rhs = grhss'
472 , bind_fvs = fvs' }),
476 (L loc bind@(FunBind { fun_id = name
477 , fun_infix = is_infix
478 , fun_matches = matches }))
479 -- invariant: no free vars here when it's a FunBind
481 do { let plain_name = unLoc name
483 ; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
484 -- bindSigTyVars tests for Opt_ScopedTyVars
485 rnMatchGroup (FunRhs plain_name is_infix) matches
486 ; let fvs' = trim fvs
488 ; when is_infix $ checkPrecMatch plain_name matches'
490 ; fvs' `seq` -- See Note [Free-variable space leak]
492 return (L loc (bind { fun_matches = matches'
493 , bind_fvs = fvs' }),
497 rnBind _ _ b = pprPanic "rnBind" (ppr b)
500 Note [Free-variable space leak]
501 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
504 and we seq fvs' before turning it as part of a record.
506 The reason is that trim is sometimes something like
507 \xs -> intersectNameSet (mkNameSet bound_names) xs
508 and we don't want to retain the list bound_names. This showed up in
512 ---------------------
513 depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
514 -> ([(RecFlag, LHsBinds Name)], DefUses)
515 -- Dependency analysis; this is important so that
516 -- unused-binding reporting is accurate
517 depAnalBinds binds_w_dus
518 = (map get_binds sccs, map get_du sccs)
520 sccs = stronglyConnCompFromEdgedVertices edges
522 keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
524 edges = [ (node, key, [key | n <- nameSetToList uses,
525 Just key <- [lookupNameEnv key_map n] ])
526 | (node@(_,_,uses), key) <- keyd_nodes ]
528 key_map :: NameEnv Int -- Which binding it comes from
529 key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes
532 get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
533 get_binds (CyclicSCC binds_w_dus) = (Recursive, listToBag [b | (b,_,_) <- binds_w_dus])
535 get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
536 get_du (CyclicSCC binds_w_dus) = (Just defs, uses)
538 defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
539 uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
542 ---------------------
543 -- Bind the top-level forall'd type variables in the sigs.
546 -- The 'a' scopes over the rhs
548 -- NB: there'll usually be just one (for a function binding)
549 -- but if there are many, one may shadow the rest; too bad!
550 -- e.g x :: [a] -> [a]
553 -- In e, 'a' will be in scope, and it'll be the one from 'y'!
555 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
556 -- Return a lookup function that maps an Id Name to the names
557 -- of the type variables that should scope over its body..
559 = \n -> lookupNameEnv env n `orElse` []
561 env :: NameEnv [Name]
562 env = mkNameEnv [ (name, map hsLTyVarName ltvs)
563 | L _ (TypeSig (L _ name)
564 (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
565 -- Note the pattern-match on "Explicit"; we only bind
566 -- type variables from signatures with an explicit top-level for-all
570 @rnMethodBinds@ is used for the method bindings of a class and an instance
571 declaration. Like @rnBinds@ but without dependency analysis.
573 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
574 That's crucial when dealing with an instance decl:
576 instance Foo (T a) where
579 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
580 and unless @op@ occurs we won't treat the type signature of @op@ in the class
581 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
582 in many ways the @op@ in an instance decl is just like an occurrence, not
586 rnMethodBinds :: Name -- Class name
587 -> (Name -> [Name]) -- Signature tyvar function
589 -> RnM (LHsBinds Name, FreeVars)
591 rnMethodBinds cls sig_fn binds
592 = do { checkDupRdrNames meth_names
593 -- Check that the same method is not given twice in the
594 -- same instance decl instance C T where
598 -- We must use checkDupRdrNames because the Name of the
599 -- method is the Name of the class selector, whose SrcSpan
600 -- points to the class declaration; and we use rnMethodBinds
601 -- for instance decls too
603 ; foldlM do_one (emptyBag, emptyFVs) (bagToList binds) }
605 meth_names = collectMethodBinders binds
606 do_one (binds,fvs) bind
607 = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn bind
608 ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) }
612 -> LHsBindLR RdrName RdrName
613 -> RnM (Bag (LHsBindLR Name Name), FreeVars)
614 rnMethodBind cls sig_fn
615 (L loc bind@(FunBind { fun_id = name, fun_infix = is_infix
616 , fun_matches = MatchGroup matches _ }))
617 = setSrcSpan loc $ do
618 sel_name <- wrapLocM (lookupInstDeclBndr cls) name
619 let plain_name = unLoc sel_name
620 -- We use the selector name as the binder
622 (new_matches, fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
623 mapFvRn (rnMatch (FunRhs plain_name is_infix)) matches
624 let new_group = MatchGroup new_matches placeHolderType
626 when is_infix $ checkPrecMatch plain_name new_group
627 return (unitBag (L loc (bind { fun_id = sel_name
628 , fun_matches = new_group
629 , bind_fvs = fvs })),
630 fvs `addOneFV` plain_name)
631 -- The 'fvs' field isn't used for method binds
633 -- Can't handle method pattern-bindings which bind multiple methods.
634 rnMethodBind _ _ (L loc bind@(PatBind {})) = do
635 addErrAt loc (methodBindErr bind)
636 return (emptyBag, emptyFVs)
638 rnMethodBind _ _ b = pprPanic "rnMethodBind" (ppr b)
643 %************************************************************************
645 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
647 %************************************************************************
649 @renameSigs@ checks for:
651 \item more than one sig for one thing;
652 \item signatures given for things not bound here;
655 At the moment we don't gather free-var info from the types in
656 signatures. We'd only need this if we wanted to report unused tyvars.
659 renameSigs :: Maybe NameSet -- If (Just ns) complain if the sig isn't for one of ns
660 -> (Sig Name -> Bool) -- Complain about the wrong kind of signature if this is False
663 -- Renames the signatures and performs error checks
664 renameSigs mb_names ok_sig sigs
665 = do { mapM_ dupSigDeclErr (findDupsEq eqHsSig sigs) -- Duplicate
666 -- Check for duplicates on RdrName version,
667 -- because renamed version has unboundName for
668 -- not-in-scope binders, which gives bogus dup-sig errors
669 -- NB: in a class decl, a 'generic' sig is not considered
670 -- equal to an ordinary sig, so we allow, say
673 -- default op :: Eq a => a -> a
675 ; sigs' <- mapM (wrapLocM (renameSig mb_names)) sigs
677 ; let (good_sigs, bad_sigs) = partition (ok_sig . unLoc) sigs'
678 ; mapM_ misplacedSigErr bad_sigs -- Misplaced
682 ----------------------
683 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
684 -- because this won't work for:
685 -- instance Foo T where
688 -- We'll just rename the INLINE prag to refer to whatever other 'op'
689 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
690 -- Doesn't seem worth much trouble to sort this.
692 renameSig :: Maybe NameSet -> Sig RdrName -> RnM (Sig Name)
693 -- FixitySig is renamed elsewhere.
694 renameSig _ (IdSig x)
695 = return (IdSig x) -- Actually this never occurs
696 renameSig mb_names sig@(TypeSig v ty)
697 = do { new_v <- lookupSigOccRn mb_names sig v
698 ; new_ty <- rnHsSigType (quotes (ppr v)) ty
699 ; return (TypeSig new_v new_ty) }
701 renameSig mb_names sig@(GenericSig v ty)
702 = do { defaultSigs_on <- xoptM Opt_DefaultSignatures
703 ; unless defaultSigs_on (addErr (defaultSigErr sig))
704 ; new_v <- lookupSigOccRn mb_names sig v
705 ; new_ty <- rnHsSigType (quotes (ppr v)) ty
706 ; return (GenericSig new_v new_ty) }
708 renameSig _ (SpecInstSig ty)
709 = do { new_ty <- rnLHsType (text "A SPECIALISE instance pragma") ty
710 ; return (SpecInstSig new_ty) }
712 -- {-# SPECIALISE #-} pragmas can refer to imported Ids
713 -- so, in the top-level case (when mb_names is Nothing)
714 -- we use lookupOccRn. If there's both an imported and a local 'f'
715 -- then the SPECIALISE pragma is ambiguous, unlike all other signatures
716 renameSig mb_names sig@(SpecSig v ty inl)
717 = do { new_v <- case mb_names of
718 Just {} -> lookupSigOccRn mb_names sig v
719 Nothing -> lookupLocatedOccRn v
720 ; new_ty <- rnHsSigType (quotes (ppr v)) ty
721 ; return (SpecSig new_v new_ty inl) }
723 renameSig mb_names sig@(InlineSig v s)
724 = do { new_v <- lookupSigOccRn mb_names sig v
725 ; return (InlineSig new_v s) }
727 renameSig mb_names sig@(FixSig (FixitySig v f))
728 = do { new_v <- lookupSigOccRn mb_names sig v
729 ; return (FixSig (FixitySig new_v f)) }
733 %************************************************************************
737 %************************************************************************
740 rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
741 rnMatchGroup ctxt (MatchGroup ms _)
742 = do { (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt) ms
743 ; return (MatchGroup new_ms placeHolderType, ms_fvs) }
745 rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
746 rnMatch ctxt = wrapLocFstM (rnMatch' ctxt)
748 rnMatch' :: HsMatchContext Name -> Match RdrName -> RnM (Match Name, FreeVars)
749 rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
750 = do { -- Result type signatures are no longer supported
751 case maybe_rhs_sig of
753 Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty)
755 -- Now the main event
756 -- note that there are no local ficity decls for matches
757 ; rnPats ctxt pats $ \ pats' -> do
758 { (grhss', grhss_fvs) <- rnGRHSs ctxt grhss
760 ; return (Match pats' Nothing grhss', grhss_fvs) }}
761 -- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
763 resSigErr :: HsMatchContext Name -> Match RdrName -> HsType RdrName -> SDoc
764 resSigErr ctxt match ty
765 = vcat [ ptext (sLit "Illegal result type signature") <+> quotes (ppr ty)
766 , nest 2 $ ptext (sLit "Result signatures are no longer supported in pattern matches")
767 , pprMatchInCtxt ctxt match ]
771 %************************************************************************
773 \subsubsection{Guarded right-hand sides (GRHSs)}
775 %************************************************************************
778 rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
780 rnGRHSs ctxt (GRHSs grhss binds)
781 = rnLocalBindsAndThen binds $ \ binds' -> do
782 (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt) grhss
783 return (GRHSs grhss' binds', fvGRHSs)
785 rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
786 rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
788 rnGRHS' :: HsMatchContext Name -> GRHS RdrName -> RnM (GRHS Name, FreeVars)
789 rnGRHS' ctxt (GRHS guards rhs)
790 = do { pattern_guards_allowed <- xoptM Opt_PatternGuards
791 ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $ \ _ ->
794 ; unless (pattern_guards_allowed || is_standard_guard guards')
795 (addWarn (nonStdGuardErr guards'))
797 ; return (GRHS guards' rhs', fvs) }
799 -- Standard Haskell 1.4 guards are just a single boolean
800 -- expression, rather than a list of qualifiers as in the
802 is_standard_guard [] = True
803 is_standard_guard [L _ (ExprStmt _ _ _ _)] = True
804 is_standard_guard _ = False
807 %************************************************************************
809 \subsection{Error messages}
811 %************************************************************************
814 dupSigDeclErr :: [LSig RdrName] -> RnM ()
815 dupSigDeclErr sigs@(L loc sig : _)
817 vcat [ptext (sLit "Duplicate") <+> what_it_is <> colon,
818 nest 2 (vcat (map ppr_sig sigs))]
820 what_it_is = hsSigDoc sig
821 ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
822 dupSigDeclErr [] = panic "dupSigDeclErr"
824 misplacedSigErr :: LSig Name -> RnM ()
825 misplacedSigErr (L loc sig)
827 sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]
829 defaultSigErr :: Sig RdrName -> SDoc
830 defaultSigErr sig = vcat [ hang (ptext (sLit "Unexpected default signature:"))
832 , ptext (sLit "Use -XDefaultSignatures to enable default signatures") ]
834 methodBindErr :: HsBindLR RdrName RdrName -> SDoc
836 = hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
839 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc
840 bindsInHsBootFile mbinds
841 = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
844 nonStdGuardErr :: [LStmtLR Name Name] -> SDoc
845 nonStdGuardErr guards
846 = hang (ptext (sLit "accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
847 4 (interpp'SP guards)