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 rnTopBinds, rnBinds, rnBindsAndThen,
14 rnMethodBinds, renameSigs, checkSigs
17 #include "HsVersions.h"
21 import HsBinds ( hsSigDoc, eqHsSig )
25 import RnTypes ( rnHsSigType, rnLHsType, rnLPat )
26 import RnExpr ( rnMatchGroup, rnMatch, rnGRHSs, checkPrecMatch )
27 import RnEnv ( bindLocatedLocalsRn, lookupLocatedBndrRn,
28 lookupLocatedInstDeclBndr,
29 lookupLocatedSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
30 bindLocalFixities, bindSigTyVarsFV,
31 warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
33 import CmdLineOpts ( DynFlag(..) )
34 import Digraph ( SCC(..), stronglyConnComp )
35 import Name ( Name, nameOccName, nameSrcLoc )
37 import PrelNames ( isUnboundName )
38 import RdrName ( RdrName, rdrNameOcc )
39 import BasicTypes ( RecFlag(..), TopLevelFlag(..), isTopLevel )
40 import List ( unzip4 )
41 import SrcLoc ( mkSrcSpan, Located(..), unLoc )
44 import Monad ( foldM )
47 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
48 -- place and can be used when complaining.
50 The code tree received by the function @rnBinds@ contains definitions
51 in where-clauses which are all apparently mutually recursive, but which may
52 not really depend upon each other. For example, in the top level program
57 the definitions of @a@ and @y@ do not depend on each other at all.
58 Unfortunately, the typechecker cannot always check such definitions.
59 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
60 definitions. In Proceedings of the International Symposium on Programming,
61 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
62 However, the typechecker usually can check definitions in which only the
63 strongly connected components have been collected into recursive bindings.
64 This is precisely what the function @rnBinds@ does.
66 ToDo: deal with case where a single monobinds binds the same variable
69 The vertag tag is a unique @Int@; the tags only need to be unique
70 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
71 (heavy monad machinery not needed).
74 %************************************************************************
76 %* naming conventions *
78 %************************************************************************
80 \subsection[name-conventions]{Name conventions}
82 The basic algorithm involves walking over the tree and returning a tuple
83 containing the new tree plus its free variables. Some functions, such
84 as those walking polymorphic bindings (HsBinds) and qualifier lists in
85 list comprehensions (@Quals@), return the variables bound in local
86 environments. These are then used to calculate the free variables of the
87 expression evaluated in these environments.
89 Conventions for variable names are as follows:
92 new code is given a prime to distinguish it from the old.
95 a set of variables defined in @Exp@ is written @dvExp@
98 a set of variables free in @Exp@ is written @fvExp@
101 %************************************************************************
103 %* analysing polymorphic bindings (HsBindGroup, HsBind)
105 %************************************************************************
107 \subsubsection[dep-HsBinds]{Polymorphic bindings}
109 Non-recursive expressions are reconstructed without any changes at top
110 level, although their component expressions may have to be altered.
111 However, non-recursive expressions are currently not expected as
112 \Haskell{} programs, and this code should not be executed.
114 Monomorphic bindings contain information that is returned in a tuple
115 (a @FlatMonoBinds@) containing:
119 a unique @Int@ that serves as the ``vertex tag'' for this binding.
122 the name of a function or the names in a pattern. These are a set
123 referred to as @dvLhs@, the defined variables of the left hand side.
126 the free variables of the body. These are referred to as @fvBody@.
129 the definition's actual code. This is referred to as just @code@.
132 The function @nonRecDvFv@ returns two sets of variables. The first is
133 the set of variables defined in the set of monomorphic bindings, while the
134 second is the set of free variables in those bindings.
136 The set of variables defined in a non-recursive binding is just the
137 union of all of them, as @union@ removes duplicates. However, the
138 free variables in each successive set of cumulative bindings is the
139 union of those in the previous set plus those of the newest binding after
140 the defined variables of the previous set have been removed.
142 @rnMethodBinds@ deals only with the declarations in class and
143 instance declarations. It expects only to see @FunMonoBind@s, and
144 it expects the global environment to contain bindings for the binders
145 (which are all class operations).
147 %************************************************************************
149 \subsubsection{ Top-level bindings}
151 %************************************************************************
153 @rnTopMonoBinds@ assumes that the environment already
154 contains bindings for the binders of this particular binding.
157 rnTopBinds :: LHsBinds RdrName
159 -> RnM ([HsBindGroup Name], DefUses)
161 -- The binders of the binding are in scope already;
162 -- the top level scope resolution does that
164 rnTopBinds mbinds sigs
165 = do { is_boot <- tcIsHsBoot
168 else bindPatSigTyVars (collectSigTysFromHsBinds (bagToList mbinds)) $ \ _ ->
169 -- Hmm; by analogy with Ids, this doesn't look right
170 -- Top-level bound type vars should really scope over
171 -- everything, but we only scope them over the other bindings
172 rnBinds TopLevel mbinds sigs }
174 rnHsBoot :: LHsBinds RdrName
176 -> RnM ([HsBindGroup Name], DefUses)
177 -- A hs-boot file has no bindings.
178 -- Return a single HsBindGroup with empty binds and renamed signatures
180 = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
181 ; sigs' <- renameSigs sigs
182 ; return ([HsBindGroup emptyLHsBinds sigs' NonRecursive],
183 usesOnly (hsSigsFVs sigs')) }
187 %************************************************************************
191 %************************************************************************
194 rnBindsAndThen :: Bag (LHsBind RdrName)
196 -> ([HsBindGroup Name] -> RnM (result, FreeVars))
197 -> RnM (result, FreeVars)
199 rnBindsAndThen mbinds sigs thing_inside
200 = -- Extract all the binders in this group, and extend the
201 -- current scope, inventing new names for the new binders
202 -- This also checks that the names form a set
203 bindLocatedLocalsRn doc mbinders_w_srclocs $ \ _ ->
204 bindPatSigTyVarsFV (collectSigTysFromHsBinds (bagToList mbinds)) $
206 -- Then install local fixity declarations
207 -- Notice that they scope over thing_inside too
208 bindLocalFixities [sig | L _ (FixSig sig) <- sigs ] $
211 rnBinds NotTopLevel mbinds sigs `thenM` \ (binds, bind_dus) ->
213 -- Now do the "thing inside"
214 thing_inside binds `thenM` \ (result,result_fvs) ->
216 -- Final error checking
218 all_uses = duUses bind_dus `plusFV` result_fvs
219 bndrs = duDefs bind_dus
220 unused_bndrs = nameSetToList (bndrs `minusNameSet` all_uses)
222 warnUnusedLocalBinds unused_bndrs `thenM_`
224 returnM (result, all_uses `minusNameSet` bndrs)
225 -- duUses: It's important to return all the uses, not the 'real uses' used for
226 -- warning about unused bindings. Otherwise consider:
228 -- y = let p = x in 'x' -- NB: p not used
229 -- If we don't "see" the dependency of 'y' on 'x', we may put the
230 -- bindings in the wrong order, and the type checker will complain
231 -- that x isn't in scope
233 mbinders_w_srclocs = collectHsBindLocatedBinders mbinds
234 doc = text "In the binding group for:"
235 <+> pprWithCommas ppr (map unLoc mbinders_w_srclocs)
239 %************************************************************************
241 \subsubsection{rnBinds -- the main work is done here}
243 %************************************************************************
245 @rnMonoBinds@ is used by {\em both} top-level and nested bindings.
246 It assumes that all variables bound in this group are already in scope.
247 This is done {\em either} by pass 3 (for the top-level bindings),
248 {\em or} by @rnMonoBinds@ (for the nested ones).
251 rnBinds :: TopLevelFlag
254 -> RnM ([HsBindGroup Name], DefUses)
256 -- Assumes the binders of the binding are in scope already
258 rnBinds top_lvl mbinds sigs
259 = renameSigs sigs `thenM` \ siglist ->
261 -- Rename the bindings, returning a [HsBindVertex]
262 -- which is a list of indivisible vertices so far as
263 -- the strongly-connected-components (SCC) analysis is concerned
264 mkBindVertices siglist mbinds `thenM` \ mbinds_info ->
266 -- Do the SCC analysis
268 scc_result = rnSCC mbinds_info
269 (groups, bind_dus_s) = unzip (map reconstructCycle scc_result)
270 bind_dus = mkDUs bind_dus_s
271 binders = duDefs bind_dus
273 -- Check for duplicate or mis-placed signatures
274 checkSigs (okBindSig binders) siglist `thenM_`
276 -- Warn about missing signatures,
277 -- but only at top level, and not in interface mode
278 -- (The latter is important when renaming bindings from 'deriving' clauses.)
279 doptM Opt_WarnMissingSigs `thenM` \ warn_missing_sigs ->
280 (if isTopLevel top_lvl &&
283 type_sig_vars = [ unLoc n | L _ (Sig n _) <- siglist]
284 un_sigd_binders = filter (not . (`elem` type_sig_vars))
285 (nameSetToList binders)
287 mappM_ missingSigWarn un_sigd_binders
292 returnM (groups, bind_dus `plusDU` usesOnly (hsSigsFVs siglist))
295 @mkBindVertices@ is ever-so-slightly magical in that it sticks
296 unique ``vertex tags'' on its output; minor plumbing required.
299 mkBindVertices :: [LSig Name] -- Signatures
302 mkBindVertices sigs = mapM (mkBindVertex sigs) . bagToList
304 mkBindVertex :: [LSig Name] -> LHsBind RdrName -> RnM BindVertex
305 mkBindVertex sigs (L loc (PatBind pat grhss ty))
307 rnLPat pat `thenM` \ (pat', pat_fvs) ->
309 -- Find which things are bound in this group
311 names_bound_here = mkNameSet (collectPatBinders pat')
313 sigsForMe names_bound_here sigs `thenM` \ sigs_for_me ->
314 bindSigTyVarsFV sigs_for_me (
315 rnGRHSs PatBindRhs grhss
316 ) `thenM` \ (grhss', fvs) ->
318 (names_bound_here, fvs `plusFV` pat_fvs,
319 L loc (PatBind pat' grhss' ty), sigs_for_me
322 mkBindVertex sigs (L loc (FunBind name inf matches))
324 lookupLocatedBndrRn name `thenM` \ new_name ->
326 plain_name = unLoc new_name
327 names_bound_here = unitNameSet plain_name
329 sigsForMe names_bound_here sigs `thenM` \ sigs_for_me ->
330 bindSigTyVarsFV sigs_for_me (
331 rnMatchGroup (FunRhs plain_name) matches
332 ) `thenM` \ (new_matches, fvs) ->
333 checkPrecMatch inf plain_name new_matches `thenM_`
335 (unitNameSet plain_name, fvs,
336 L loc (FunBind new_name inf new_matches), sigs_for_me
339 sigsForMe names_bound_here sigs
340 = foldlM check [] (filter (sigForThisGroup names_bound_here) sigs)
342 -- sigForThisGroup only returns signatures for
343 -- which sigName returns a Just
344 eq sig1 sig2 = eqHsSig (unLoc sig1) (unLoc sig2)
346 check sigs sig = case filter (eq sig) sigs of
347 [] -> returnM (sig:sigs)
348 other -> dupSigDeclErr sig other `thenM_`
353 @rnMethodBinds@ is used for the method bindings of a class and an instance
354 declaration. Like @rnBinds@ but without dependency analysis.
356 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
357 That's crucial when dealing with an instance decl:
359 instance Foo (T a) where
362 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
363 and unless @op@ occurs we won't treat the type signature of @op@ in the class
364 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
365 in many ways the @op@ in an instance decl is just like an occurrence, not
369 rnMethodBinds :: Name -- Class name
370 -> [Name] -- Names for generic type variables
372 -> RnM (LHsBinds Name, FreeVars)
374 rnMethodBinds cls gen_tyvars binds
375 = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
376 where do_one (binds,fvs) bind = do
377 (bind', fvs_bind) <- rnMethodBind cls gen_tyvars bind
378 return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
380 rnMethodBind cls gen_tyvars (L loc (FunBind name inf (MatchGroup matches _)))
382 lookupLocatedInstDeclBndr cls name `thenM` \ sel_name ->
383 let plain_name = unLoc sel_name in
384 -- We use the selector name as the binder
386 mapFvRn (rn_match plain_name) matches `thenM` \ (new_matches, fvs) ->
388 new_group = MatchGroup new_matches placeHolderType
390 checkPrecMatch inf plain_name new_group `thenM_`
391 returnM (unitBag (L loc (FunBind sel_name inf new_group)), fvs `addOneFV` plain_name)
393 -- Truly gruesome; bring into scope the correct members of the generic
394 -- type variables. See comments in RnSource.rnSourceDecl(ClassDecl)
395 rn_match sel_name match@(L _ (Match (L _ (TypePat ty) : _) _ _))
396 = extendTyVarEnvFVRn gen_tvs $
397 rnMatch (FunRhs sel_name) match
399 tvs = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
400 gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
402 rn_match sel_name match = rnMatch (FunRhs sel_name) match
405 -- Can't handle method pattern-bindings which bind multiple methods.
406 rnMethodBind cls gen_tyvars mbind@(L loc (PatBind other_pat _ _))
407 = addLocErr mbind methodBindErr `thenM_`
408 returnM (emptyBag, emptyFVs)
412 %************************************************************************
414 Strongly connected components
416 %************************************************************************
419 type BindVertex = (Defs, Uses, LHsBind Name, [LSig Name])
420 -- Signatures, if any, for this vertex
422 rnSCC :: [BindVertex] -> [SCC BindVertex]
423 rnSCC nodes = stronglyConnComp (mkEdges nodes)
427 mkEdges :: [BindVertex] -> [(BindVertex, VertexTag, [VertexTag])]
428 -- We keep the uses with the binding,
429 -- so we can track unused bindings better
431 = [ (thing, tag, dest_vertices uses)
432 | (thing@(_, uses, _, _), tag) <- tagged_nodes
435 tagged_nodes = nodes `zip` [0::VertexTag ..]
437 -- An edge (v,v') indicates that v depends on v'
438 dest_vertices uses = [ target_vertex
439 | ((defs, _, _, _), target_vertex) <- tagged_nodes,
440 defs `intersectsNameSet` uses
443 reconstructCycle :: SCC BindVertex -> (HsBindGroup Name, (Defs,Uses))
444 reconstructCycle (AcyclicSCC (defs, uses, bind, sigs))
445 = (HsBindGroup (unitBag bind) sigs NonRecursive, (defs, uses))
446 reconstructCycle (CyclicSCC cycle)
447 = (HsBindGroup this_gp_binds this_gp_sigs Recursive,
448 (unionManyNameSets defs_s, unionManyNameSets uses_s))
450 (defs_s, uses_s, binds_s, sigs_s) = unzip4 cycle
451 this_gp_binds = listToBag binds_s
452 this_gp_sigs = foldr1 (++) sigs_s
456 %************************************************************************
458 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
460 %************************************************************************
462 @renameSigs@ checks for:
464 \item more than one sig for one thing;
465 \item signatures given for things not bound here;
466 \item with suitably flaggery, that all top-level things have type signatures.
469 At the moment we don't gather free-var info from the types in
470 signatures. We'd only need this if we wanted to report unused tyvars.
473 checkSigs :: (LSig Name -> Bool) -- OK-sig predicbate
476 checkSigs ok_sig sigs
477 -- Check for (a) duplicate signatures
478 -- (b) signatures for things not in this group
479 -- Well, I can't see the check for (a)... ToDo!
480 = mappM_ unknownSigErr (filter bad sigs)
482 bad sig = not (ok_sig sig) &&
484 Just n | isUnboundName n -> False
485 -- Don't complain about an unbound name again
488 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
489 -- because this won't work for:
490 -- instance Foo T where
493 -- We'll just rename the INLINE prag to refer to whatever other 'op'
494 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
495 -- Doesn't seem worth much trouble to sort this.
497 renameSigs :: [LSig RdrName] -> RnM [LSig Name]
498 renameSigs sigs = mappM (wrapLocM renameSig) (filter (not . isFixityLSig) sigs)
499 -- Remove fixity sigs which have been dealt with already
501 renameSig :: Sig RdrName -> RnM (Sig Name)
502 -- FixitSig is renamed elsewhere.
504 = lookupLocatedSigOccRn v `thenM` \ new_v ->
505 rnHsSigType (quotes (ppr v)) ty `thenM` \ new_ty ->
506 returnM (Sig new_v new_ty)
508 renameSig (SpecInstSig ty)
509 = rnLHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
510 returnM (SpecInstSig new_ty)
512 renameSig (SpecSig v ty)
513 = lookupLocatedSigOccRn v `thenM` \ new_v ->
514 rnHsSigType (quotes (ppr v)) ty `thenM` \ new_ty ->
515 returnM (SpecSig new_v new_ty)
517 renameSig (InlineSig b v p)
518 = lookupLocatedSigOccRn v `thenM` \ new_v ->
519 returnM (InlineSig b new_v p)
523 %************************************************************************
525 \subsection{Error messages}
527 %************************************************************************
530 dupSigDeclErr (L loc sig) sigs
532 vcat [ptext SLIT("Duplicate") <+> what_it_is <> colon,
533 nest 2 (vcat (map ppr_sig (L loc sig:sigs)))]
535 what_it_is = hsSigDoc sig
536 ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
538 unknownSigErr (L loc sig)
540 sep [ptext SLIT("Misplaced") <+> what_it_is <> colon, ppr sig]
542 what_it_is = hsSigDoc sig
545 = addWarnAt (mkSrcSpan loc loc) $
546 sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
548 loc = nameSrcLoc var -- TODO: make a proper span
551 = hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
554 bindsInHsBootFile mbinds
555 = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))