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 -- The above warning supression flag is a temporary kludge.
14 -- While working on this module you are encouraged to remove it and fix
15 -- any warnings in the module. See
16 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
19 module RnBinds (rnTopBinds, rnTopBindsLHS, rnTopBindsRHS, -- use these for top-level bindings
20 rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS, -- or these for local bindings
21 rnMethodBinds, renameSigs, mkSigTvFn,
22 rnMatchGroup, rnGRHSs,
23 makeMiniFixityEnv, MiniFixityEnv
26 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
32 import RnTypes ( rnHsSigType, rnLHsType, rnHsTypeFVs,checkPrecMatch)
33 import RnPat (rnPatsAndThen_LocalRightwards, rnBindPat,
34 NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker,
38 import DynFlags ( DynFlag(..) )
39 import HscTypes (FixItem(..))
44 import PrelNames ( isUnboundName )
45 import RdrName ( RdrName, rdrNameOcc )
46 import SrcLoc ( Located(..), unLoc, noLoc )
47 import ListSetOps ( findDupsEq )
48 import BasicTypes ( RecFlag(..) )
49 import Digraph ( SCC(..), stronglyConnComp )
53 import Maybes ( orElse )
54 import Util ( filterOut )
55 import Monad ( foldM, unless )
58 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
59 -- place and can be used when complaining.
61 The code tree received by the function @rnBinds@ contains definitions
62 in where-clauses which are all apparently mutually recursive, but which may
63 not really depend upon each other. For example, in the top level program
68 the definitions of @a@ and @y@ do not depend on each other at all.
69 Unfortunately, the typechecker cannot always check such definitions.
70 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
71 definitions. In Proceedings of the International Symposium on Programming,
72 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
73 However, the typechecker usually can check definitions in which only the
74 strongly connected components have been collected into recursive bindings.
75 This is precisely what the function @rnBinds@ does.
77 ToDo: deal with case where a single monobinds binds the same variable
80 The vertag tag is a unique @Int@; the tags only need to be unique
81 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
82 (heavy monad machinery not needed).
85 %************************************************************************
87 %* naming conventions *
89 %************************************************************************
91 \subsection[name-conventions]{Name conventions}
93 The basic algorithm involves walking over the tree and returning a tuple
94 containing the new tree plus its free variables. Some functions, such
95 as those walking polymorphic bindings (HsBinds) and qualifier lists in
96 list comprehensions (@Quals@), return the variables bound in local
97 environments. These are then used to calculate the free variables of the
98 expression evaluated in these environments.
100 Conventions for variable names are as follows:
103 new code is given a prime to distinguish it from the old.
106 a set of variables defined in @Exp@ is written @dvExp@
109 a set of variables free in @Exp@ is written @fvExp@
112 %************************************************************************
114 %* analysing polymorphic bindings (HsBindGroup, HsBind)
116 %************************************************************************
118 \subsubsection[dep-HsBinds]{Polymorphic bindings}
120 Non-recursive expressions are reconstructed without any changes at top
121 level, although their component expressions may have to be altered.
122 However, non-recursive expressions are currently not expected as
123 \Haskell{} programs, and this code should not be executed.
125 Monomorphic bindings contain information that is returned in a tuple
126 (a @FlatMonoBinds@) containing:
130 a unique @Int@ that serves as the ``vertex tag'' for this binding.
133 the name of a function or the names in a pattern. These are a set
134 referred to as @dvLhs@, the defined variables of the left hand side.
137 the free variables of the body. These are referred to as @fvBody@.
140 the definition's actual code. This is referred to as just @code@.
143 The function @nonRecDvFv@ returns two sets of variables. The first is
144 the set of variables defined in the set of monomorphic bindings, while the
145 second is the set of free variables in those bindings.
147 The set of variables defined in a non-recursive binding is just the
148 union of all of them, as @union@ removes duplicates. However, the
149 free variables in each successive set of cumulative bindings is the
150 union of those in the previous set plus those of the newest binding after
151 the defined variables of the previous set have been removed.
153 @rnMethodBinds@ deals only with the declarations in class and
154 instance declarations. It expects only to see @FunMonoBind@s, and
155 it expects the global environment to contain bindings for the binders
156 (which are all class operations).
158 %************************************************************************
160 \subsubsection{ Top-level bindings}
162 %************************************************************************
165 -- for top-level bindings, we need to make top-level names,
166 -- so we have a different entry point than for local bindings
167 rnTopBindsLHS :: MiniFixityEnv
168 -> HsValBinds RdrName
169 -> RnM (HsValBindsLR Name RdrName)
170 rnTopBindsLHS fix_env binds =
171 (uncurry $ rnValBindsLHSFromDoc (topRecNameMaker fix_env)) (bindersAndDoc binds) binds
173 rnTopBindsRHS :: [Name] -- the names bound by these binds
174 -> HsValBindsLR Name RdrName
175 -> RnM (HsValBinds Name, DefUses)
176 rnTopBindsRHS bound_names binds =
177 do { is_boot <- tcIsHsBoot
179 then rnTopBindsBoot binds
180 else rnValBindsRHSGen (\x -> x) -- don't trim free vars
184 -- wrapper if we don't need to do anything in between the left and right,
185 -- or anything else in the scope of the left
187 -- never used when there are fixity declarations
188 rnTopBinds :: HsValBinds RdrName
189 -> RnM (HsValBinds Name, DefUses)
191 do nl <- rnTopBindsLHS emptyFsEnv b
192 let bound_names = map unLoc (collectHsValBinders nl)
193 bindLocalNames bound_names $ rnTopBindsRHS bound_names nl
196 rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
197 -- A hs-boot file has no bindings.
198 -- Return a single HsBindGroup with empty binds and renamed signatures
199 rnTopBindsBoot (ValBindsIn mbinds sigs)
200 = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
201 ; sigs' <- renameSigs okHsBootSig sigs
202 ; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }
207 %*********************************************************
211 %*********************************************************
214 rnLocalBindsAndThen :: HsLocalBinds RdrName
215 -> (HsLocalBinds Name -> RnM (result, FreeVars))
216 -> RnM (result, FreeVars)
217 -- This version (a) assumes that the binding vars are *not* already in scope
218 -- (b) removes the binders from the free vars of the thing inside
219 -- The parser doesn't produce ThenBinds
220 rnLocalBindsAndThen EmptyLocalBinds thing_inside
221 = thing_inside EmptyLocalBinds
223 rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
224 = rnValBindsAndThen val_binds $ \ val_binds' ->
225 thing_inside (HsValBinds val_binds')
227 rnLocalBindsAndThen (HsIPBinds binds) thing_inside = do
228 (binds',fv_binds) <- rnIPBinds binds
229 (thing, fvs_thing) <- thing_inside (HsIPBinds binds')
230 return (thing, fvs_thing `plusFV` fv_binds)
233 rnIPBinds (IPBinds ip_binds _no_dict_binds) = do
234 (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
235 return (IPBinds ip_binds' emptyLHsBinds, plusFVs fvs_s)
237 rnIPBind (IPBind n expr) = do
238 name <- newIPNameRn n
239 (expr',fvExpr) <- rnLExpr expr
240 return (IPBind name expr', fvExpr)
244 %************************************************************************
248 %************************************************************************
251 -- wrapper for local binds
252 -- creates the documentation info and calls the helper below
253 rnValBindsLHS :: MiniFixityEnv
254 -> HsValBinds RdrName
255 -> RnM (HsValBindsLR Name RdrName)
256 rnValBindsLHS fix_env binds =
257 let (boundNames,doc) = bindersAndDoc binds
258 in rnValBindsLHSFromDoc_Local boundNames doc fix_env binds
260 -- a helper used for local binds that does the duplicates check,
261 -- just so we don't forget to do it somewhere
262 rnValBindsLHSFromDoc_Local :: [Located RdrName] -- RdrNames of the LHS (so we don't have to gather them twice)
263 -> SDoc -- doc string for dup names and shadowing
265 -> HsValBinds RdrName
266 -> RnM (HsValBindsLR Name RdrName)
268 rnValBindsLHSFromDoc_Local boundNames doc fix_env binds = do
269 -- Do error checking: we need to check for dups here because we
270 -- don't don't bind all of the variables from the ValBinds at once
271 -- with bindLocatedLocals any more.
272 checkDupAndShadowedRdrNames doc boundNames
274 -- (Note that we don't want to do this at the top level, since
275 -- sorting out duplicates and shadowing there happens elsewhere.
276 -- The behavior is even different. For example,
279 -- should not produce a shadowing warning (but it will produce
280 -- an ambiguity warning if you use f), but
282 -- g = let f = ... in f
284 rnValBindsLHSFromDoc (localRecNameMaker fix_env) boundNames doc binds
286 bindersAndDoc :: HsValBinds RdrName -> ([Located RdrName], SDoc)
287 bindersAndDoc binds =
289 -- the unrenamed bndrs for error checking and reporting
290 orig = collectHsValBinders binds
291 doc = text "In the binding group for:" <+> pprWithCommas ppr (map unLoc orig)
295 -- renames the left-hand sides
296 -- generic version used both at the top level and for local binds
297 -- does some error checking, but not what gets done elsewhere at the top level
298 rnValBindsLHSFromDoc :: NameMaker
299 -> [Located RdrName] -- RdrNames of the LHS (so we don't have to gather them twice)
300 -> SDoc -- doc string for dup names and shadowing
301 -> HsValBinds RdrName
302 -> RnM (HsValBindsLR Name RdrName)
303 rnValBindsLHSFromDoc topP original_bndrs doc binds@(ValBindsIn mbinds sigs) = do
305 mbinds' <- mapBagM (rnBindLHS topP doc) mbinds
306 return $ ValBindsIn mbinds' sigs
308 -- assumes the LHS vars are in scope
309 -- general version used both from the top-level and for local things
311 -- does not bind the local fixity declarations
312 rnValBindsRHSGen :: (FreeVars -> FreeVars) -- for trimming free var sets
313 -- The trimming function trims the free vars we attach to a
314 -- binding so that it stays reasonably small
315 -> [Name] -- names bound by the LHSes
316 -> HsValBindsLR Name RdrName
317 -> RnM (HsValBinds Name, DefUses)
319 rnValBindsRHSGen trim bound_names binds@(ValBindsIn mbinds sigs) = do
322 traceRn (ptext (sLit "Rename sigs") <+> ppr (tcg_rdr_env env))
323 sigs' <- rename_sigs sigs
325 binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
326 let (anal_binds, anal_dus) = depAnalBinds binds_w_dus
327 (valbind', valbind'_dus) = (ValBindsOut anal_binds sigs',
328 usesOnly (hsSigsFVs sigs') `plusDU` anal_dus)
329 -- We do the check-sigs after renaming the bindings,
330 -- so that we have convenient access to the binders
331 check_sigs (okBindSig (duDefs anal_dus)) sigs'
332 return (valbind', valbind'_dus)
334 -- Wrapper for local binds
336 -- The *client* of this function is responsible for checking for unused binders;
337 -- it doesn't (and can't: we don't have the thing inside the binds) happen here
339 -- The client is also responsible for bringing the fixities into scope
340 rnValBindsRHS :: [Name] -- names bound by the LHSes
341 -> HsValBindsLR Name RdrName
342 -> RnM (HsValBinds Name, DefUses)
343 rnValBindsRHS bound_names binds =
344 rnValBindsRHSGen (\ fvs -> -- only keep the names the names from this group
345 intersectNameSet (mkNameSet bound_names) fvs) bound_names binds
349 -- wrapper that does both the left- and right-hand sides
351 -- here there are no local fixity decls passed in;
352 -- the local fixity decls come from the ValBinds sigs
353 rnValBindsAndThen :: HsValBinds RdrName
354 -> (HsValBinds Name -> RnM (result, FreeVars))
355 -> RnM (result, FreeVars)
356 rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
357 = do { let (original_bndrs, doc) = bindersAndDoc binds
359 -- (A) Create the local fixity environment
360 ; new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs]
362 -- (B) Rename the LHSes
363 ; new_lhs <- rnValBindsLHSFromDoc_Local original_bndrs doc new_fixities binds
364 ; let bound_names = map unLoc $ collectHsValBinders new_lhs
366 -- ...and bring them (and their fixities) into scope
367 ; bindLocalNamesFV_WithFixities bound_names new_fixities $ do
369 { -- (C) Do the RHS and thing inside
370 (binds', dus) <- rnValBindsRHS bound_names new_lhs
371 ; (result, result_fvs) <- thing_inside binds'
373 -- Report unused bindings based on the (accurate)
376 -- should report 'x' unused
377 ; let real_uses = findUses dus result_fvs
378 ; warnUnusedLocalBinds bound_names real_uses
381 -- The variables "used" in the val binds are:
382 -- (1) the uses of the binds (duUses)
383 -- (2) the FVs of the thing-inside
384 all_uses = duUses dus `plusFV` result_fvs
385 -- Note [Unused binding hack]
386 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
387 -- Note that *in contrast* to the above reporting of
388 -- unused bindings, (1) above uses duUses to return *all*
389 -- the uses, even if the binding is unused. Otherwise consider:
391 -- y = let p = x in 'x' -- NB: p not used
392 -- If we don't "see" the dependency of 'y' on 'x', we may put the
393 -- bindings in the wrong order, and the type checker will complain
394 -- that x isn't in scope
396 -- But note that this means we won't report 'x' as unused,
397 -- whereas we would if we had { x = 3; p = x; y = 'x' }
399 ; return (result, all_uses) }}
400 -- The bound names are pruned out of all_uses
401 -- by the bindLocalNamesFV call above
405 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
406 -- (We keep the location around for reporting duplicate fixity declarations.)
408 -- Checks for duplicates, but not that only locally defined things are fixed.
409 -- Note: for local fixity declarations, duplicates would also be checked in
410 -- check_sigs below. But we also use this function at the top level.
412 makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
414 makeMiniFixityEnv decls = foldlM add_one emptyFsEnv decls
416 add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
417 { -- this fixity decl is a duplicate iff
418 -- the ReaderName's OccName's FastString is already in the env
419 -- (we only need to check the local fix_env because
420 -- definitions of non-local will be caught elsewhere)
421 let { fs = occNameFS (rdrNameOcc name)
422 ; fix_item = L loc fixity };
424 case lookupFsEnv env fs of
425 Nothing -> return $ extendFsEnv env fs fix_item
426 Just (L loc' _) -> do
428 addLocErr (L name_loc name) (dupFixityDecl loc')
432 pprFixEnv :: NameEnv FixItem -> SDoc
434 = pprWithCommas (\ (FixItem n f) -> ppr f <+> ppr n)
437 dupFixityDecl loc rdr_name
438 = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name),
439 ptext (sLit "also at ") <+> ppr loc]
441 ---------------------
443 -- renaming a single bind
445 rnBindLHS :: NameMaker
448 -- returns the renamed left-hand side,
449 -- and the FreeVars *of the LHS*
450 -- (i.e., any free variables of the pattern)
451 -> RnM (LHsBindLR Name RdrName)
453 rnBindLHS name_maker doc (L loc (PatBind { pat_lhs = pat,
456 pat_rhs_ty=pat_rhs_ty
458 = setSrcSpan loc $ do
459 -- we don't actually use the FV processing of rnPatsAndThen here
460 (pat',pat'_fvs) <- rnBindPat name_maker pat
461 return (L loc (PatBind { pat_lhs = pat',
463 -- we temporarily store the pat's FVs here;
464 -- gets updated to the FVs of the whole bind
465 -- when doing the RHS below
467 -- these will get ignored in the next pass,
468 -- when we rename the RHS
469 pat_rhs_ty = pat_rhs_ty }))
471 rnBindLHS name_maker doc (L loc (FunBind { fun_id = name@(L nameLoc _),
473 fun_matches = matches,
474 fun_co_fn = fun_co_fn,
479 do { (newname, _fvs) <- applyNameMaker name_maker name $ \ newname ->
480 return (newname, emptyFVs)
481 ; return (L loc (FunBind { fun_id = L nameLoc newname,
483 fun_matches = matches,
484 -- we temporatily store the LHS's FVs (empty in this case) here
485 -- gets updated when doing the RHS below
487 -- everything else will get ignored in the next pass
488 fun_co_fn = fun_co_fn,
492 -- assumes the left-hands-side vars are in scope
493 rnBind :: (Name -> [Name]) -- Signature tyvar function
494 -> (FreeVars -> FreeVars) -- Trimming function for rhs free vars
495 -> LHsBindLR Name RdrName
496 -> RnM (LHsBind Name, [Name], Uses)
497 rnBind sig_fn trim (L loc (PatBind { pat_lhs = pat,
499 -- pat fvs were stored here while processing the LHS
502 do {let bndrs = collectPatBinders pat
504 ; (grhss', fvs) <- rnGRHSs PatBindRhs grhss
505 -- No scoped type variables for pattern bindings
507 ; return (L loc (PatBind { pat_lhs = pat,
509 pat_rhs_ty = placeHolderType,
510 bind_fvs = trim fvs }),
511 bndrs, pat_fvs `plusFV` fvs) }
515 (L loc (FunBind { fun_id = name,
517 fun_matches = matches,
521 -- invariant: no free vars here when it's a FunBind
523 do { let plain_name = unLoc name
525 ; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
526 -- bindSigTyVars tests for Opt_ScopedTyVars
527 rnMatchGroup (FunRhs plain_name inf) matches
529 ; checkPrecMatch inf plain_name matches'
531 ; return (L loc (FunBind { fun_id = name,
533 fun_matches = matches',
535 fun_co_fn = idHsWrapper,
536 fun_tick = Nothing }),
540 ---------------------
541 depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
542 -> ([(RecFlag, LHsBinds Name)], DefUses)
543 -- Dependency analysis; this is important so that
544 -- unused-binding reporting is accurate
545 depAnalBinds binds_w_dus
546 = (map get_binds sccs, map get_du sccs)
548 sccs = stronglyConnComp edges
550 keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
552 edges = [ (node, key, [key | n <- nameSetToList uses,
553 Just key <- [lookupNameEnv key_map n] ])
554 | (node@(_,_,uses), key) <- keyd_nodes ]
556 key_map :: NameEnv Int -- Which binding it comes from
557 key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes
560 get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
561 get_binds (CyclicSCC binds_w_dus) = (Recursive, listToBag [b | (b,d,u) <- binds_w_dus])
563 get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
564 get_du (CyclicSCC binds_w_dus) = (Just defs, uses)
566 defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
567 uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
570 ---------------------
571 -- Bind the top-level forall'd type variables in the sigs.
574 -- The 'a' scopes over the rhs
576 -- NB: there'll usually be just one (for a function binding)
577 -- but if there are many, one may shadow the rest; too bad!
578 -- e.g x :: [a] -> [a]
581 -- In e, 'a' will be in scope, and it'll be the one from 'y'!
583 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
584 -- Return a lookup function that maps an Id Name to the names
585 -- of the type variables that should scope over its body..
587 = \n -> lookupNameEnv env n `orElse` []
589 env :: NameEnv [Name]
590 env = mkNameEnv [ (name, map hsLTyVarName ltvs)
591 | L _ (TypeSig (L _ name)
592 (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
593 -- Note the pattern-match on "Explicit"; we only bind
594 -- type variables from signatures with an explicit top-level for-all
598 @rnMethodBinds@ is used for the method bindings of a class and an instance
599 declaration. Like @rnBinds@ but without dependency analysis.
601 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
602 That's crucial when dealing with an instance decl:
604 instance Foo (T a) where
607 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
608 and unless @op@ occurs we won't treat the type signature of @op@ in the class
609 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
610 in many ways the @op@ in an instance decl is just like an occurrence, not
614 rnMethodBinds :: Name -- Class name
615 -> (Name -> [Name]) -- Signature tyvar function
616 -> [Name] -- Names for generic type variables
618 -> RnM (LHsBinds Name, FreeVars)
620 rnMethodBinds cls sig_fn gen_tyvars binds
621 = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
622 where do_one (binds,fvs) bind = do
623 (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind
624 return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
626 rnMethodBind cls sig_fn gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = inf,
627 fun_matches = MatchGroup matches _ }))
628 = setSrcSpan loc $ do
629 sel_name <- lookupInstDeclBndr cls name
630 let plain_name = unLoc sel_name
631 -- We use the selector name as the binder
633 bindSigTyVarsFV (sig_fn plain_name) $ do
634 (new_matches, fvs) <- mapFvRn (rn_match plain_name) matches
636 new_group = MatchGroup new_matches placeHolderType
638 checkPrecMatch inf plain_name new_group
639 return (unitBag (L loc (FunBind {
640 fun_id = sel_name, fun_infix = inf,
641 fun_matches = new_group,
642 bind_fvs = fvs, fun_co_fn = idHsWrapper,
643 fun_tick = Nothing })),
644 fvs `addOneFV` plain_name)
645 -- The 'fvs' field isn't used for method binds
647 -- Truly gruesome; bring into scope the correct members of the generic
648 -- type variables. See comments in RnSource.rnSourceDecl(ClassDecl)
649 rn_match sel_name match@(L _ (Match (L _ (TypePat ty) : _) _ _))
650 = extendTyVarEnvFVRn gen_tvs $
651 rnMatch (FunRhs sel_name inf) match
653 tvs = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
654 gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
656 rn_match sel_name match = rnMatch (FunRhs sel_name inf) match
659 -- Can't handle method pattern-bindings which bind multiple methods.
660 rnMethodBind cls sig_fn gen_tyvars mbind@(L loc (PatBind other_pat _ _ _)) = do
661 addLocErr mbind methodBindErr
662 return (emptyBag, emptyFVs)
667 %************************************************************************
669 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
671 %************************************************************************
673 @renameSigs@ checks for:
675 \item more than one sig for one thing;
676 \item signatures given for things not bound here;
677 \item with suitably flaggery, that all top-level things have type signatures.
680 At the moment we don't gather free-var info from the types in
681 signatures. We'd only need this if we wanted to report unused tyvars.
684 renameSigs :: (LSig Name -> Bool) -> [LSig RdrName] -> RnM [LSig Name]
685 -- Renames the signatures and performs error checks
686 renameSigs ok_sig sigs
687 = do { sigs' <- rename_sigs sigs
688 ; check_sigs ok_sig sigs'
691 ----------------------
692 rename_sigs :: [LSig RdrName] -> RnM [LSig Name]
693 rename_sigs sigs = mapM (wrapLocM renameSig) sigs
695 ----------------------
696 check_sigs :: (LSig Name -> Bool) -> [LSig Name] -> RnM ()
697 -- Used for class and instance decls, as well as regular bindings
698 check_sigs ok_sig sigs = do
699 -- Check for (a) duplicate signatures
700 -- (b) signatures for things not in this group = do
701 traceRn (text "SIGS" <+> ppr sigs)
702 mapM_ unknownSigErr (filter (not . ok_sig) sigs')
703 mapM_ dupSigDeclErr (findDupsEq eqHsSig sigs')
705 -- Don't complain about an unbound name again
706 sigs' = filterOut bad_name sigs
707 bad_name sig = case sigName sig of
708 Just n -> isUnboundName n
711 -- We use lookupLocatedSigOccRn in the signatures, which is a little bit unsatisfactory
712 -- because this won't work for:
713 -- instance Foo T where
716 -- We'll just rename the INLINE prag to refer to whatever other 'op'
717 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
718 -- Doesn't seem worth much trouble to sort this.
720 renameSig :: Sig RdrName -> RnM (Sig Name)
721 -- FixitSig is renamed elsewhere.
722 renameSig (TypeSig v ty) = do
723 new_v <- lookupLocatedSigOccRn v
724 new_ty <- rnHsSigType (quotes (ppr v)) ty
725 return (TypeSig new_v new_ty)
727 renameSig (SpecInstSig ty) = do
728 new_ty <- rnLHsType (text "A SPECIALISE instance pragma") ty
729 return (SpecInstSig new_ty)
731 renameSig (SpecSig v ty inl) = do
732 new_v <- lookupLocatedSigOccRn v
733 new_ty <- rnHsSigType (quotes (ppr v)) ty
734 return (SpecSig new_v new_ty inl)
736 renameSig (InlineSig v s) = do
737 new_v <- lookupLocatedSigOccRn v
738 return (InlineSig new_v s)
740 renameSig (FixSig (FixitySig v f)) = do
741 new_v <- lookupLocatedSigOccRn v
742 return (FixSig (FixitySig new_v f))
746 ************************************************************************
750 ************************************************************************
753 rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
754 rnMatchGroup ctxt (MatchGroup ms _) = do
755 (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt) ms
756 return (MatchGroup new_ms placeHolderType, ms_fvs)
758 rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
759 rnMatch ctxt = wrapLocFstM (rnMatch' ctxt)
761 rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
763 -- Deal with the rhs type signature
764 bindPatSigTyVarsFV rhs_sig_tys $ do
765 opt_PatternSignatures <- doptM Opt_PatternSignatures
766 (maybe_rhs_sig', ty_fvs) <-
767 case maybe_rhs_sig of
768 Nothing -> return (Nothing, emptyFVs)
769 Just ty | opt_PatternSignatures -> do (ty', ty_fvs) <- rnHsTypeFVs doc_sig ty
770 return (Just ty', ty_fvs)
771 | otherwise -> do addLocErr ty patSigErr
772 return (Nothing, emptyFVs)
774 -- Now the main event
775 -- note that there are no local ficity decls for matches
776 rnPatsAndThen_LocalRightwards ctxt pats $ \ pats' -> do
777 (grhss', grhss_fvs) <- rnGRHSs ctxt grhss
779 return (Match pats' maybe_rhs_sig' grhss', grhss_fvs `plusFV` ty_fvs)
780 -- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
782 rhs_sig_tys = case maybe_rhs_sig of
785 doc_sig = text "In a result type-signature"
789 %************************************************************************
791 \subsubsection{Guarded right-hand sides (GRHSs)}
793 %************************************************************************
796 rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
798 rnGRHSs ctxt (GRHSs grhss binds)
799 = rnLocalBindsAndThen binds $ \ binds' -> do
800 (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt) grhss
801 return (GRHSs grhss' binds', fvGRHSs)
803 rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
804 rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
806 rnGRHS' ctxt (GRHS guards rhs)
807 = do { pattern_guards_allowed <- doptM Opt_PatternGuards
808 ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
811 ; unless (pattern_guards_allowed || is_standard_guard guards')
812 (addWarn (nonStdGuardErr guards'))
814 ; return (GRHS guards' rhs', fvs) }
816 -- Standard Haskell 1.4 guards are just a single boolean
817 -- expression, rather than a list of qualifiers as in the
819 is_standard_guard [] = True
820 is_standard_guard [L _ (ExprStmt _ _ _)] = True
821 is_standard_guard other = False
824 %************************************************************************
826 \subsection{Error messages}
828 %************************************************************************
831 dupSigDeclErr sigs@(L loc sig : _)
833 vcat [ptext (sLit "Duplicate") <+> what_it_is <> colon,
834 nest 2 (vcat (map ppr_sig sigs))]
836 what_it_is = hsSigDoc sig
837 ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
839 unknownSigErr (L loc sig)
840 = do { mod <- getModule
842 vcat [sep [ptext (sLit "Misplaced") <+> what_it_is <> colon, ppr sig],
843 extra_stuff mod sig] }
845 what_it_is = hsSigDoc sig
846 extra_stuff mod (TypeSig (L _ n) _)
847 | nameIsLocalOrFrom mod n
848 = ptext (sLit "The type signature must be given where")
849 <+> quotes (ppr n) <+> ptext (sLit "is declared")
851 = ptext (sLit "You cannot give a type signature for an imported value")
853 extra_stuff mod other = empty
856 = hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
859 bindsInHsBootFile mbinds
860 = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
863 nonStdGuardErr guards
864 = hang (ptext (sLit "accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
865 4 (interpp'SP guards)