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 )
32 import RnTypes ( rnHsSigType, rnLHsType, checkPrecMatch)
33 import RnPat (rnPats, rnBindPat,
34 NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker
42 import RdrName ( RdrName, rdrNameOcc )
44 import ListSetOps ( findDupsEq )
45 import BasicTypes ( RecFlag(..) )
46 import Digraph ( SCC(..), stronglyConnCompFromEdgedVertices )
50 import Data.List ( partition )
51 import Maybes ( orElse )
55 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
56 -- place and can be used when complaining.
58 The code tree received by the function @rnBinds@ contains definitions
59 in where-clauses which are all apparently mutually recursive, but which may
60 not really depend upon each other. For example, in the top level program
65 the definitions of @a@ and @y@ do not depend on each other at all.
66 Unfortunately, the typechecker cannot always check such definitions.
67 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
68 definitions. In Proceedings of the International Symposium on Programming,
69 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
70 However, the typechecker usually can check definitions in which only the
71 strongly connected components have been collected into recursive bindings.
72 This is precisely what the function @rnBinds@ does.
74 ToDo: deal with case where a single monobinds binds the same variable
77 The vertag tag is a unique @Int@; the tags only need to be unique
78 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
79 (heavy monad machinery not needed).
82 %************************************************************************
84 %* naming conventions *
86 %************************************************************************
88 \subsection[name-conventions]{Name conventions}
90 The basic algorithm involves walking over the tree and returning a tuple
91 containing the new tree plus its free variables. Some functions, such
92 as those walking polymorphic bindings (HsBinds) and qualifier lists in
93 list comprehensions (@Quals@), return the variables bound in local
94 environments. These are then used to calculate the free variables of the
95 expression evaluated in these environments.
97 Conventions for variable names are as follows:
100 new code is given a prime to distinguish it from the old.
103 a set of variables defined in @Exp@ is written @dvExp@
106 a set of variables free in @Exp@ is written @fvExp@
109 %************************************************************************
111 %* analysing polymorphic bindings (HsBindGroup, HsBind)
113 %************************************************************************
115 \subsubsection[dep-HsBinds]{Polymorphic bindings}
117 Non-recursive expressions are reconstructed without any changes at top
118 level, although their component expressions may have to be altered.
119 However, non-recursive expressions are currently not expected as
120 \Haskell{} programs, and this code should not be executed.
122 Monomorphic bindings contain information that is returned in a tuple
123 (a @FlatMonoBinds@) containing:
127 a unique @Int@ that serves as the ``vertex tag'' for this binding.
130 the name of a function or the names in a pattern. These are a set
131 referred to as @dvLhs@, the defined variables of the left hand side.
134 the free variables of the body. These are referred to as @fvBody@.
137 the definition's actual code. This is referred to as just @code@.
140 The function @nonRecDvFv@ returns two sets of variables. The first is
141 the set of variables defined in the set of monomorphic bindings, while the
142 second is the set of free variables in those bindings.
144 The set of variables defined in a non-recursive binding is just the
145 union of all of them, as @union@ removes duplicates. However, the
146 free variables in each successive set of cumulative bindings is the
147 union of those in the previous set plus those of the newest binding after
148 the defined variables of the previous set have been removed.
150 @rnMethodBinds@ deals only with the declarations in class and
151 instance declarations. It expects only to see @FunMonoBind@s, and
152 it expects the global environment to contain bindings for the binders
153 (which are all class operations).
155 %************************************************************************
157 \subsubsection{ Top-level bindings}
159 %************************************************************************
162 -- for top-level bindings, we need to make top-level names,
163 -- so we have a different entry point than for local bindings
164 rnTopBindsLHS :: MiniFixityEnv
165 -> HsValBinds RdrName
166 -> RnM (HsValBindsLR Name RdrName)
167 rnTopBindsLHS fix_env binds
168 = rnValBindsLHS (topRecNameMaker fix_env) binds
170 rnTopBindsRHS :: HsValBindsLR Name RdrName
171 -> RnM (HsValBinds Name, DefUses)
173 = do { is_boot <- tcIsHsBoot
175 then rnTopBindsBoot binds
176 else rnValBindsRHS noTrimFVs -- don't trim free vars
177 Nothing -- Allow SPEC prags for imports
180 -- Wrapper if we don't need to do anything in between the left and right,
181 -- or anything else in the scope of the left
183 -- Never used when there are fixity declarations
184 rnTopBinds :: HsValBinds RdrName
185 -> RnM (HsValBinds Name, DefUses)
187 = do { nl <- rnTopBindsLHS emptyFsEnv b
188 ; let bound_names = collectHsValBinders nl
189 ; bindLocalNames bound_names $
190 rnValBindsRHS noTrimFVs (Just (mkNameSet bound_names)) nl }
193 rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
194 -- A hs-boot file has no bindings.
195 -- Return a single HsBindGroup with empty binds and renamed signatures
196 rnTopBindsBoot (ValBindsIn mbinds sigs)
197 = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
198 ; sigs' <- renameSigs Nothing okHsBootSig sigs
199 ; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }
200 rnTopBindsBoot b = pprPanic "rnTopBindsBoot" (ppr b)
204 %*********************************************************
208 %*********************************************************
211 rnLocalBindsAndThen :: HsLocalBinds RdrName
212 -> (HsLocalBinds Name -> RnM (result, FreeVars))
213 -> RnM (result, FreeVars)
214 -- This version (a) assumes that the binding vars are *not* already in scope
215 -- (b) removes the binders from the free vars of the thing inside
216 -- The parser doesn't produce ThenBinds
217 rnLocalBindsAndThen EmptyLocalBinds thing_inside
218 = thing_inside EmptyLocalBinds
220 rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
221 = rnLocalValBindsAndThen val_binds $ \ val_binds' ->
222 thing_inside (HsValBinds val_binds')
224 rnLocalBindsAndThen (HsIPBinds binds) thing_inside = do
225 (binds',fv_binds) <- rnIPBinds binds
226 (thing, fvs_thing) <- thing_inside (HsIPBinds binds')
227 return (thing, fvs_thing `plusFV` fv_binds)
229 rnIPBinds :: HsIPBinds RdrName -> RnM (HsIPBinds Name, FreeVars)
230 rnIPBinds (IPBinds ip_binds _no_dict_binds) = do
231 (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
232 return (IPBinds ip_binds' emptyTcEvBinds, plusFVs fvs_s)
234 rnIPBind :: IPBind RdrName -> RnM (IPBind Name, FreeVars)
235 rnIPBind (IPBind n expr) = do
236 name <- newIPNameRn n
237 (expr',fvExpr) <- rnLExpr expr
238 return (IPBind name expr', fvExpr)
242 %************************************************************************
246 %************************************************************************
249 -- Renaming local binding gropus
250 -- Does duplicate/shadow check
251 rnLocalValBindsLHS :: MiniFixityEnv
252 -> HsValBinds RdrName
253 -> RnM ([Name], HsValBindsLR Name RdrName)
254 rnLocalValBindsLHS fix_env binds
255 = do { -- Do error checking: we need to check for dups here because we
256 -- don't don't bind all of the variables from the ValBinds at once
257 -- with bindLocatedLocals any more.
259 -- Note that we don't want to do this at the top level, since
260 -- sorting out duplicates and shadowing there happens elsewhere.
261 -- The behavior is even different. For example,
264 -- should not produce a shadowing warning (but it will produce
265 -- an ambiguity warning if you use f), but
267 -- g = let f = ... in f
269 ; binds' <- rnValBindsLHS (localRecNameMaker fix_env) binds
270 ; let bound_names = collectHsValBinders binds'
272 ; checkDupAndShadowedNames envs bound_names
273 ; return (bound_names, binds') }
275 -- renames the left-hand sides
276 -- generic version used both at the top level and for local binds
277 -- does some error checking, but not what gets done elsewhere at the top level
278 rnValBindsLHS :: NameMaker
279 -> HsValBinds RdrName
280 -> RnM (HsValBindsLR Name RdrName)
281 rnValBindsLHS topP (ValBindsIn mbinds sigs)
282 = do { mbinds' <- mapBagM (rnBindLHS topP doc) mbinds
283 ; return $ ValBindsIn mbinds' sigs }
285 bndrs = collectHsBindsBinders mbinds
286 doc = text "In the binding group for:" <+> pprWithCommas ppr bndrs
288 rnValBindsLHS _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
290 -- General version used both from the top-level and for local things
291 -- Assumes the LHS vars are in scope
293 -- Does not bind the local fixity declarations
294 rnValBindsRHS :: (FreeVars -> FreeVars) -- for trimming free var sets
295 -- The trimming function trims the free vars we attach to a
296 -- binding so that it stays reasonably small
297 -> Maybe NameSet -- Names bound by the LHSes
298 -- Nothing if expect sigs for imports
299 -> HsValBindsLR Name RdrName
300 -> RnM (HsValBinds Name, DefUses)
302 rnValBindsRHS trim mb_bound_names (ValBindsIn mbinds sigs)
303 = do { sigs' <- renameSigs mb_bound_names okBindSig sigs
304 ; binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
305 ; case depAnalBinds binds_w_dus of
306 (anal_binds, anal_dus) -> return (valbind', valbind'_dus)
308 valbind' = ValBindsOut anal_binds sigs'
309 valbind'_dus = usesOnly (hsSigsFVs sigs') `plusDU` anal_dus
312 rnValBindsRHS _ _ b = pprPanic "rnValBindsRHS" (ppr b)
314 noTrimFVs :: FreeVars -> FreeVars
317 -- Wrapper for local binds
319 -- The *client* of this function is responsible for checking for unused binders;
320 -- it doesn't (and can't: we don't have the thing inside the binds) happen here
322 -- The client is also responsible for bringing the fixities into scope
323 rnLocalValBindsRHS :: NameSet -- names bound by the LHSes
324 -> HsValBindsLR Name RdrName
325 -> RnM (HsValBinds Name, DefUses)
326 rnLocalValBindsRHS bound_names binds
327 = rnValBindsRHS trim (Just bound_names) binds
329 trim fvs = intersectNameSet bound_names fvs
330 -- Only keep the names the names from this group
333 -- wrapper that does both the left- and right-hand sides
335 -- here there are no local fixity decls passed in;
336 -- the local fixity decls come from the ValBinds sigs
337 rnLocalValBindsAndThen :: HsValBinds RdrName
338 -> (HsValBinds Name -> RnM (result, FreeVars))
339 -> RnM (result, FreeVars)
340 rnLocalValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
341 = do { -- (A) Create the local fixity environment
342 new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs]
344 -- (B) Rename the LHSes
345 ; (bound_names, new_lhs) <- rnLocalValBindsLHS new_fixities binds
347 -- ...and bring them (and their fixities) into scope
348 ; bindLocalNamesFV bound_names $
349 addLocalFixities new_fixities bound_names $ do
351 { -- (C) Do the RHS and thing inside
352 (binds', dus) <- rnLocalValBindsRHS (mkNameSet bound_names) new_lhs
353 ; (result, result_fvs) <- thing_inside binds'
355 -- Report unused bindings based on the (accurate)
358 -- should report 'x' unused
359 ; let real_uses = findUses dus result_fvs
360 -- Insert fake uses for variables introduced implicitly by wildcards (#4404)
361 implicit_uses = hsValBindsImplicits binds'
362 ; warnUnusedLocalBinds bound_names (real_uses `unionNameSets` implicit_uses)
365 -- The variables "used" in the val binds are:
366 -- (1) the uses of the binds (allUses)
367 -- (2) the FVs of the thing-inside
368 all_uses = allUses dus `plusFV` result_fvs
369 -- Note [Unused binding hack]
370 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
371 -- Note that *in contrast* to the above reporting of
372 -- unused bindings, (1) above uses duUses to return *all*
373 -- the uses, even if the binding is unused. Otherwise consider:
375 -- y = let p = x in 'x' -- NB: p not used
376 -- If we don't "see" the dependency of 'y' on 'x', we may put the
377 -- bindings in the wrong order, and the type checker will complain
378 -- that x isn't in scope
380 -- But note that this means we won't report 'x' as unused,
381 -- whereas we would if we had { x = 3; p = x; y = 'x' }
383 ; return (result, all_uses) }}
384 -- The bound names are pruned out of all_uses
385 -- by the bindLocalNamesFV call above
387 rnLocalValBindsAndThen bs _ = pprPanic "rnLocalValBindsAndThen" (ppr bs)
390 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
391 -- (We keep the location around for reporting duplicate fixity declarations.)
393 -- Checks for duplicates, but not that only locally defined things are fixed.
394 -- Note: for local fixity declarations, duplicates would also be checked in
395 -- check_sigs below. But we also use this function at the top level.
397 makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
399 makeMiniFixityEnv decls = foldlM add_one emptyFsEnv decls
401 add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
402 { -- this fixity decl is a duplicate iff
403 -- the ReaderName's OccName's FastString is already in the env
404 -- (we only need to check the local fix_env because
405 -- definitions of non-local will be caught elsewhere)
406 let { fs = occNameFS (rdrNameOcc name)
407 ; fix_item = L loc fixity };
409 case lookupFsEnv env fs of
410 Nothing -> return $ extendFsEnv env fs fix_item
411 Just (L loc' _) -> do
413 addErrAt name_loc (dupFixityDecl loc' name)
417 dupFixityDecl :: SrcSpan -> RdrName -> SDoc
418 dupFixityDecl loc rdr_name
419 = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name),
420 ptext (sLit "also at ") <+> ppr loc]
422 ---------------------
424 -- renaming a single bind
426 rnBindLHS :: NameMaker
429 -- returns the renamed left-hand side,
430 -- and the FreeVars *of the LHS*
431 -- (i.e., any free variables of the pattern)
432 -> RnM (LHsBindLR Name RdrName)
434 rnBindLHS name_maker _ (L loc bind@(PatBind { pat_lhs = pat }))
435 = setSrcSpan loc $ do
436 -- we don't actually use the FV processing of rnPatsAndThen here
437 (pat',pat'_fvs) <- rnBindPat name_maker pat
438 return (L loc (bind { pat_lhs = pat', bind_fvs = pat'_fvs }))
439 -- We temporarily store the pat's FVs in bind_fvs;
440 -- gets updated to the FVs of the whole bind
441 -- when doing the RHS below
443 rnBindLHS name_maker _ (L loc bind@(FunBind { fun_id = name@(L nameLoc _) }))
445 do { newname <- applyNameMaker name_maker name
446 ; return (L loc (bind { fun_id = L nameLoc newname })) }
448 rnBindLHS _ _ b = pprPanic "rnBindLHS" (ppr b)
450 -- assumes the left-hands-side vars are in scope
451 rnBind :: (Name -> [Name]) -- Signature tyvar function
452 -> (FreeVars -> FreeVars) -- Trimming function for rhs free vars
453 -> LHsBindLR Name RdrName
454 -> RnM (LHsBind Name, [Name], Uses)
455 rnBind _ trim (L loc bind@(PatBind { pat_lhs = pat
457 -- pat fvs were stored in bind_fvs
458 -- after processing the LHS
459 , bind_fvs = pat_fvs }))
461 do { let bndrs = collectPatBinders pat
463 ; (grhss', fvs) <- rnGRHSs PatBindRhs grhss
464 -- No scoped type variables for pattern bindings
465 ; let all_fvs = pat_fvs `plusFV` fvs
468 ; fvs' `seq` -- See Note [Free-variable space leak]
469 return (L loc (bind { pat_rhs = grhss'
470 , bind_fvs = fvs' }),
474 (L loc bind@(FunBind { fun_id = name
475 , fun_infix = is_infix
476 , fun_matches = matches }))
477 -- invariant: no free vars here when it's a FunBind
479 do { let plain_name = unLoc name
481 ; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
482 -- bindSigTyVars tests for Opt_ScopedTyVars
483 rnMatchGroup (FunRhs plain_name is_infix) matches
484 ; let fvs' = trim fvs
486 ; when is_infix $ checkPrecMatch plain_name matches'
488 ; fvs' `seq` -- See Note [Free-variable space leak]
490 return (L loc (bind { fun_matches = matches'
491 , bind_fvs = fvs' }),
495 rnBind _ _ b = pprPanic "rnBind" (ppr b)
498 Note [Free-variable space leak]
499 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
502 and we seq fvs' before turning it as part of a record.
504 The reason is that trim is sometimes something like
505 \xs -> intersectNameSet (mkNameSet bound_names) xs
506 and we don't want to retain the list bound_names. This showed up in
510 ---------------------
511 depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
512 -> ([(RecFlag, LHsBinds Name)], DefUses)
513 -- Dependency analysis; this is important so that
514 -- unused-binding reporting is accurate
515 depAnalBinds binds_w_dus
516 = (map get_binds sccs, map get_du sccs)
518 sccs = stronglyConnCompFromEdgedVertices edges
520 keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
522 edges = [ (node, key, [key | n <- nameSetToList uses,
523 Just key <- [lookupNameEnv key_map n] ])
524 | (node@(_,_,uses), key) <- keyd_nodes ]
526 key_map :: NameEnv Int -- Which binding it comes from
527 key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes
530 get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
531 get_binds (CyclicSCC binds_w_dus) = (Recursive, listToBag [b | (b,_,_) <- binds_w_dus])
533 get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
534 get_du (CyclicSCC binds_w_dus) = (Just defs, uses)
536 defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
537 uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
540 ---------------------
541 -- Bind the top-level forall'd type variables in the sigs.
544 -- The 'a' scopes over the rhs
546 -- NB: there'll usually be just one (for a function binding)
547 -- but if there are many, one may shadow the rest; too bad!
548 -- e.g x :: [a] -> [a]
551 -- In e, 'a' will be in scope, and it'll be the one from 'y'!
553 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
554 -- Return a lookup function that maps an Id Name to the names
555 -- of the type variables that should scope over its body..
557 = \n -> lookupNameEnv env n `orElse` []
559 env :: NameEnv [Name]
560 env = mkNameEnv [ (name, map hsLTyVarName ltvs)
561 | L _ (TypeSig (L _ name)
562 (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
563 -- Note the pattern-match on "Explicit"; we only bind
564 -- type variables from signatures with an explicit top-level for-all
568 @rnMethodBinds@ is used for the method bindings of a class and an instance
569 declaration. Like @rnBinds@ but without dependency analysis.
571 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
572 That's crucial when dealing with an instance decl:
574 instance Foo (T a) where
577 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
578 and unless @op@ occurs we won't treat the type signature of @op@ in the class
579 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
580 in many ways the @op@ in an instance decl is just like an occurrence, not
584 rnMethodBinds :: Name -- Class name
585 -> (Name -> [Name]) -- Signature tyvar function
586 -> [Name] -- Names for generic type variables
588 -> RnM (LHsBinds Name, FreeVars)
590 rnMethodBinds cls sig_fn gen_tyvars binds
591 = foldlM do_one (emptyBag,emptyFVs) (bagToList binds)
593 do_one (binds,fvs) bind
594 = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind
595 ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) }
600 -> LHsBindLR RdrName RdrName
601 -> RnM (Bag (LHsBindLR Name Name), FreeVars)
602 rnMethodBind cls sig_fn gen_tyvars
603 (L loc bind@(FunBind { fun_id = name, fun_infix = is_infix
604 , fun_matches = MatchGroup matches _ }))
605 = setSrcSpan loc $ do
606 sel_name <- wrapLocM (lookupInstDeclBndr cls) name
607 let plain_name = unLoc sel_name
608 -- We use the selector name as the binder
610 (new_matches, fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
611 mapFvRn (rn_match (FunRhs plain_name is_infix)) matches
612 let new_group = MatchGroup new_matches placeHolderType
614 when is_infix $ checkPrecMatch plain_name new_group
615 return (unitBag (L loc (bind { fun_id = sel_name
616 , fun_matches = new_group
617 , bind_fvs = fvs })),
618 fvs `addOneFV` plain_name)
619 -- The 'fvs' field isn't used for method binds
621 -- Truly gruesome; bring into scope the correct members of the generic
622 -- type variables. See comments in RnSource.rnSourceDecl(ClassDecl)
623 rn_match info match@(L _ (Match (L _ (TypePat ty) : _) _ _))
624 = extendTyVarEnvFVRn gen_tvs $
627 tvs = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
628 gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
630 rn_match info match = rnMatch info match
632 -- Can't handle method pattern-bindings which bind multiple methods.
633 rnMethodBind _ _ _ (L loc bind@(PatBind {})) = do
634 addErrAt loc (methodBindErr bind)
635 return (emptyBag, emptyFVs)
637 rnMethodBind _ _ _ b = pprPanic "rnMethodBind" (ppr b)
642 %************************************************************************
644 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
646 %************************************************************************
648 @renameSigs@ checks for:
650 \item more than one sig for one thing;
651 \item signatures given for things not bound here;
654 At the moment we don't gather free-var info from the types in
655 signatures. We'd only need this if we wanted to report unused tyvars.
658 renameSigs :: Maybe NameSet -- If (Just ns) complain if the sig isn't for one of ns
659 -> (Sig Name -> Bool) -- Complain about the wrong kind of signature if this is False
662 -- Renames the signatures and performs error checks
663 renameSigs mb_names ok_sig sigs
664 = do { mapM_ dupSigDeclErr (findDupsEq eqHsSig sigs) -- Duplicate
665 -- Check for duplicates on RdrName version,
666 -- because renamed version has unboundName for
667 -- not-in-scope binders, which gives bogus dup-sig errors
669 ; sigs' <- mapM (wrapLocM (renameSig mb_names)) sigs
671 ; let (good_sigs, bad_sigs) = partition (ok_sig . unLoc) sigs'
672 ; mapM_ misplacedSigErr bad_sigs -- Misplaced
676 ----------------------
677 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
678 -- because this won't work for:
679 -- instance Foo T where
682 -- We'll just rename the INLINE prag to refer to whatever other 'op'
683 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
684 -- Doesn't seem worth much trouble to sort this.
686 renameSig :: Maybe NameSet -> Sig RdrName -> RnM (Sig Name)
687 -- FixitySig is renamed elsewhere.
688 renameSig _ (IdSig x)
689 = return (IdSig x) -- Actually this never occurs
690 renameSig mb_names sig@(TypeSig v ty)
691 = do { new_v <- lookupSigOccRn mb_names sig v
692 ; new_ty <- rnHsSigType (quotes (ppr v)) ty
693 ; return (TypeSig new_v new_ty) }
695 renameSig _ (SpecInstSig ty)
696 = do { new_ty <- rnLHsType (text "A SPECIALISE instance pragma") ty
697 ; return (SpecInstSig new_ty) }
699 -- {-# SPECIALISE #-} pragmas can refer to imported Ids
700 -- so, in the top-level case (when mb_names is Nothing)
701 -- we use lookupOccRn. If there's both an imported and a local 'f'
702 -- then the SPECIALISE pragma is ambiguous, unlike all other signatures
703 renameSig mb_names sig@(SpecSig v ty inl)
704 = do { new_v <- case mb_names of
705 Just {} -> lookupSigOccRn mb_names sig v
706 Nothing -> lookupLocatedOccRn v
707 ; new_ty <- rnHsSigType (quotes (ppr v)) ty
708 ; return (SpecSig new_v new_ty inl) }
710 renameSig mb_names sig@(InlineSig v s)
711 = do { new_v <- lookupSigOccRn mb_names sig v
712 ; return (InlineSig new_v s) }
714 renameSig mb_names sig@(FixSig (FixitySig v f))
715 = do { new_v <- lookupSigOccRn mb_names sig v
716 ; return (FixSig (FixitySig new_v f)) }
720 %************************************************************************
724 %************************************************************************
727 rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
728 rnMatchGroup ctxt (MatchGroup ms _)
729 = do { (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt) ms
730 ; return (MatchGroup new_ms placeHolderType, ms_fvs) }
732 rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
733 rnMatch ctxt = wrapLocFstM (rnMatch' ctxt)
735 rnMatch' :: HsMatchContext Name -> Match RdrName -> RnM (Match Name, FreeVars)
736 rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
737 = do { -- Result type signatures are no longer supported
738 case maybe_rhs_sig of
740 Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty)
742 -- Now the main event
743 -- note that there are no local ficity decls for matches
744 ; rnPats ctxt pats $ \ pats' -> do
745 { (grhss', grhss_fvs) <- rnGRHSs ctxt grhss
747 ; return (Match pats' Nothing grhss', grhss_fvs) }}
748 -- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
750 resSigErr :: HsMatchContext Name -> Match RdrName -> HsType RdrName -> SDoc
751 resSigErr ctxt match ty
752 = vcat [ ptext (sLit "Illegal result type signature") <+> quotes (ppr ty)
753 , nest 2 $ ptext (sLit "Result signatures are no longer supported in pattern matches")
754 , pprMatchInCtxt ctxt match ]
758 %************************************************************************
760 \subsubsection{Guarded right-hand sides (GRHSs)}
762 %************************************************************************
765 rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
767 rnGRHSs ctxt (GRHSs grhss binds)
768 = rnLocalBindsAndThen binds $ \ binds' -> do
769 (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt) grhss
770 return (GRHSs grhss' binds', fvGRHSs)
772 rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
773 rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
775 rnGRHS' :: HsMatchContext Name -> GRHS RdrName -> RnM (GRHS Name, FreeVars)
776 rnGRHS' ctxt (GRHS guards rhs)
777 = do { pattern_guards_allowed <- xoptM Opt_PatternGuards
778 ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $ \ _ ->
781 ; unless (pattern_guards_allowed || is_standard_guard guards')
782 (addWarn (nonStdGuardErr guards'))
784 ; return (GRHS guards' rhs', fvs) }
786 -- Standard Haskell 1.4 guards are just a single boolean
787 -- expression, rather than a list of qualifiers as in the
789 is_standard_guard [] = True
790 is_standard_guard [L _ (ExprStmt _ _ _)] = True
791 is_standard_guard _ = False
794 %************************************************************************
796 \subsection{Error messages}
798 %************************************************************************
801 dupSigDeclErr :: [LSig RdrName] -> RnM ()
802 dupSigDeclErr sigs@(L loc sig : _)
804 vcat [ptext (sLit "Duplicate") <+> what_it_is <> colon,
805 nest 2 (vcat (map ppr_sig sigs))]
807 what_it_is = hsSigDoc sig
808 ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
809 dupSigDeclErr [] = panic "dupSigDeclErr"
811 misplacedSigErr :: LSig Name -> RnM ()
812 misplacedSigErr (L loc sig)
814 sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]
816 methodBindErr :: HsBindLR RdrName RdrName -> SDoc
818 = hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
821 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc
822 bindsInHsBootFile mbinds
823 = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
826 nonStdGuardErr :: [LStmtLR Name Name] -> SDoc
827 nonStdGuardErr guards
828 = hang (ptext (sLit "accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
829 4 (interpp'SP guards)