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 rnTopMonoBinds, rnMonoBinds, rnMonoBindsAndThen,
14 rnMethodBinds, renameSigs, checkSigs, unknownSigErr
17 #include "HsVersions.h"
21 import HsBinds ( eqHsSig, hsSigDoc )
25 import RnTypes ( rnHsSigType, rnHsType, rnPat )
26 import RnExpr ( rnMatch, rnGRHSs, checkPrecMatch )
27 import RnEnv ( bindLocatedLocalsRn, lookupBndrRn, lookupInstDeclBndr,
28 lookupSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
30 warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
32 import CmdLineOpts ( DynFlag(..) )
33 import Digraph ( SCC(..), stronglyConnComp )
34 import Name ( Name, nameOccName, nameSrcLoc )
36 import RdrName ( RdrName, rdrNameOcc )
37 import BasicTypes ( RecFlag(..), TopLevelFlag(..), isTopLevel )
38 import List ( unzip4 )
42 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
43 -- place and can be used when complaining.
45 The code tree received by the function @rnBinds@ contains definitions
46 in where-clauses which are all apparently mutually recursive, but which may
47 not really depend upon each other. For example, in the top level program
52 the definitions of @a@ and @y@ do not depend on each other at all.
53 Unfortunately, the typechecker cannot always check such definitions.
54 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
55 definitions. In Proceedings of the International Symposium on Programming,
56 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
57 However, the typechecker usually can check definitions in which only the
58 strongly connected components have been collected into recursive bindings.
59 This is precisely what the function @rnBinds@ does.
61 ToDo: deal with case where a single monobinds binds the same variable
64 The vertag tag is a unique @Int@; the tags only need to be unique
65 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
66 (heavy monad machinery not needed).
69 %************************************************************************
71 %* naming conventions *
73 %************************************************************************
75 \subsection[name-conventions]{Name conventions}
77 The basic algorithm involves walking over the tree and returning a tuple
78 containing the new tree plus its free variables. Some functions, such
79 as those walking polymorphic bindings (HsBinds) and qualifier lists in
80 list comprehensions (@Quals@), return the variables bound in local
81 environments. These are then used to calculate the free variables of the
82 expression evaluated in these environments.
84 Conventions for variable names are as follows:
87 new code is given a prime to distinguish it from the old.
90 a set of variables defined in @Exp@ is written @dvExp@
93 a set of variables free in @Exp@ is written @fvExp@
96 %************************************************************************
98 %* analysing polymorphic bindings (HsBinds, Bind, MonoBinds) *
100 %************************************************************************
102 \subsubsection[dep-HsBinds]{Polymorphic bindings}
104 Non-recursive expressions are reconstructed without any changes at top
105 level, although their component expressions may have to be altered.
106 However, non-recursive expressions are currently not expected as
107 \Haskell{} programs, and this code should not be executed.
109 Monomorphic bindings contain information that is returned in a tuple
110 (a @FlatMonoBinds@) containing:
114 a unique @Int@ that serves as the ``vertex tag'' for this binding.
117 the name of a function or the names in a pattern. These are a set
118 referred to as @dvLhs@, the defined variables of the left hand side.
121 the free variables of the body. These are referred to as @fvBody@.
124 the definition's actual code. This is referred to as just @code@.
127 The function @nonRecDvFv@ returns two sets of variables. The first is
128 the set of variables defined in the set of monomorphic bindings, while the
129 second is the set of free variables in those bindings.
131 The set of variables defined in a non-recursive binding is just the
132 union of all of them, as @union@ removes duplicates. However, the
133 free variables in each successive set of cumulative bindings is the
134 union of those in the previous set plus those of the newest binding after
135 the defined variables of the previous set have been removed.
137 @rnMethodBinds@ deals only with the declarations in class and
138 instance declarations. It expects only to see @FunMonoBind@s, and
139 it expects the global environment to contain bindings for the binders
140 (which are all class operations).
142 %************************************************************************
144 \subsubsection{ Top-level bindings}
146 %************************************************************************
148 @rnTopMonoBinds@ assumes that the environment already
149 contains bindings for the binders of this particular binding.
152 rnTopMonoBinds :: RdrNameMonoBinds
154 -> RnM (RenamedHsBinds, DefUses)
156 -- The binders of the binding are in scope already;
157 -- the top level scope resoluttion does that
159 rnTopMonoBinds mbinds sigs
160 = bindPatSigTyVars (collectSigTysFromMonoBinds mbinds) $ \ _ ->
161 -- Hmm; by analogy with Ids, this doesn't look right
162 -- Top-level bound type vars should really scope over
163 -- everything, but we only scope them over the other bindings
165 rnMonoBinds TopLevel mbinds sigs
169 %************************************************************************
173 %************************************************************************
176 rnMonoBindsAndThen :: RdrNameMonoBinds
178 -> (RenamedHsBinds -> RnM (result, FreeVars))
179 -> RnM (result, FreeVars)
181 rnMonoBindsAndThen mbinds sigs thing_inside -- Non-empty monobinds
182 = -- Extract all the binders in this group, and extend the
183 -- current scope, inventing new names for the new binders
184 -- This also checks that the names form a set
185 bindLocatedLocalsRn doc mbinders_w_srclocs $ \ _ ->
186 bindPatSigTyVarsFV (collectSigTysFromMonoBinds mbinds) $
188 -- Then install local fixity declarations
189 -- Notice that they scope over thing_inside too
190 bindLocalFixities [sig | FixSig sig <- sigs ] $
193 rnMonoBinds NotTopLevel mbinds sigs `thenM` \ (binds, bind_dus) ->
195 -- Now do the "thing inside"
196 thing_inside binds `thenM` \ (result,result_fvs) ->
198 -- Final error checking
200 all_uses = duUses bind_dus `plusFV` result_fvs
201 bndrs = duDefs bind_dus
202 real_uses = findUses bind_dus result_fvs
203 unused_bndrs = nameSetToList (bndrs `minusNameSet` all_uses)
205 warnUnusedLocalBinds unused_bndrs `thenM_`
207 returnM (result, all_uses `minusNameSet` bndrs)
208 -- It's important to return all the uses, not the 'real uses' used for
209 -- warning about unused bindings. Otherwise consider:
211 -- y = let p = x in 'x'
212 -- If we don't "see" the dependency of 'y' on 'x', we may put the
213 -- bindings in the wrong order, and the type checker will complain
214 -- that x isn't in scope
216 mbinders_w_srclocs = collectLocatedMonoBinders mbinds
217 doc = text "In the binding group for:"
218 <+> pprWithCommas ppr (map fst mbinders_w_srclocs)
222 %************************************************************************
224 \subsubsection{ MonoBinds -- the main work is done here}
226 %************************************************************************
228 @rnMonoBinds@ is used by {\em both} top-level and nested bindings.
229 It assumes that all variables bound in this group are already in scope.
230 This is done {\em either} by pass 3 (for the top-level bindings),
231 {\em or} by @rnMonoBinds@ (for the nested ones).
234 rnMonoBinds :: TopLevelFlag
237 -> RnM (RenamedHsBinds, DefUses)
239 -- Assumes the binders of the binding are in scope already
241 rnMonoBinds top_lvl mbinds sigs
242 = renameSigs sigs `thenM` \ siglist ->
244 -- Rename the bindings, returning a MonoBindsInfo
245 -- which is a list of indivisible vertices so far as
246 -- the strongly-connected-components (SCC) analysis is concerned
247 flattenMonoBinds siglist mbinds `thenM` \ mbinds_info ->
249 -- Do the SCC analysis
251 scc_result = rnSCC mbinds_info
252 (binds_s, bind_dus_s) = unzip (map reconstructCycle scc_result)
253 bind_dus = mkDUs bind_dus_s
254 final_binds = foldr ThenBinds EmptyBinds binds_s
255 binders = duDefs bind_dus
257 -- Check for duplicate or mis-placed signatures
258 checkSigs (okBindSig binders) siglist `thenM_`
260 -- Warn about missing signatures,
261 -- but only at top level, and not in interface mode
262 -- (The latter is important when renaming bindings from 'deriving' clauses.)
263 getModeRn `thenM` \ mode ->
264 doptM Opt_WarnMissingSigs `thenM` \ warn_missing_sigs ->
265 (if isTopLevel top_lvl &&
267 not (isInterfaceMode mode)
269 type_sig_vars = [n | Sig n _ _ <- siglist]
270 un_sigd_binders = filter (not . (`elem` type_sig_vars))
271 (nameSetToList binders)
273 mappM_ missingSigWarn un_sigd_binders
278 returnM (final_binds, bind_dus `plusDU` usesOnly (hsSigsFVs siglist))
281 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
282 unique ``vertex tags'' on its output; minor plumbing required.
285 flattenMonoBinds :: [RenamedSig] -- Signatures
287 -> RnM [FlatMonoBinds]
289 flattenMonoBinds sigs EmptyMonoBinds = returnM []
291 flattenMonoBinds sigs (AndMonoBinds bs1 bs2)
292 = flattenMonoBinds sigs bs1 `thenM` \ flat1 ->
293 flattenMonoBinds sigs bs2 `thenM` \ flat2 ->
294 returnM (flat1 ++ flat2)
296 flattenMonoBinds sigs (PatMonoBind pat grhss locn)
298 rnPat pat `thenM` \ (pat', pat_fvs) ->
300 -- Find which things are bound in this group
302 names_bound_here = mkNameSet (collectPatBinders pat')
304 sigsForMe names_bound_here sigs `thenM` \ sigs_for_me ->
305 rnGRHSs PatBindRhs grhss `thenM` \ (grhss', fvs) ->
307 [(names_bound_here, fvs `plusFV` pat_fvs,
308 PatMonoBind pat' grhss' locn, sigs_for_me
311 flattenMonoBinds sigs (FunMonoBind name inf matches locn)
313 lookupBndrRn name `thenM` \ new_name ->
315 names_bound_here = unitNameSet new_name
317 sigsForMe names_bound_here sigs `thenM` \ sigs_for_me ->
318 mapFvRn (rnMatch (FunRhs new_name)) matches `thenM` \ (new_matches, fvs) ->
319 mappM_ (checkPrecMatch inf new_name) new_matches `thenM_`
321 [(unitNameSet new_name, fvs,
322 FunMonoBind new_name inf new_matches locn, sigs_for_me
326 sigsForMe names_bound_here sigs
327 = foldlM check [] (filter (sigForThisGroup names_bound_here) sigs)
329 check sigs sig = case filter (eqHsSig sig) sigs of
330 [] -> returnM (sig:sigs)
331 other -> dupSigDeclErr sig `thenM_`
336 @rnMethodBinds@ is used for the method bindings of a class and an instance
337 declaration. Like @rnMonoBinds@ but without dependency analysis.
339 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
340 That's crucial when dealing with an instance decl:
342 instance Foo (T a) where
345 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
346 and unless @op@ occurs we won't treat the type signature of @op@ in the class
347 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
348 in many ways the @op@ in an instance decl is just like an occurrence, not
352 rnMethodBinds :: Name -- Class name
353 -> [Name] -- Names for generic type variables
355 -> RnM (RenamedMonoBinds, FreeVars)
357 rnMethodBinds cls gen_tyvars EmptyMonoBinds = returnM (EmptyMonoBinds, emptyFVs)
359 rnMethodBinds cls gen_tyvars (AndMonoBinds mb1 mb2)
360 = rnMethodBinds cls gen_tyvars mb1 `thenM` \ (mb1', fvs1) ->
361 rnMethodBinds cls gen_tyvars mb2 `thenM` \ (mb2', fvs2) ->
362 returnM (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
364 rnMethodBinds cls gen_tyvars (FunMonoBind name inf matches locn)
367 lookupInstDeclBndr cls name `thenM` \ sel_name ->
368 -- We use the selector name as the binder
370 mapFvRn (rn_match sel_name) matches `thenM` \ (new_matches, fvs) ->
371 mappM_ (checkPrecMatch inf sel_name) new_matches `thenM_`
372 returnM (FunMonoBind sel_name inf new_matches locn, fvs `addOneFV` sel_name)
374 -- Gruesome; bring into scope the correct members of the generic type variables
375 -- See comments in RnSource.rnSourceDecl(ClassDecl)
376 rn_match sel_name match@(Match (TypePat ty : _) _ _)
377 = extendTyVarEnvFVRn gen_tvs $
378 rnMatch (FunRhs sel_name) match
380 tvs = map rdrNameOcc (extractHsTyRdrNames ty)
381 gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
383 rn_match sel_name match = rnMatch (FunRhs sel_name) match
386 -- Can't handle method pattern-bindings which bind multiple methods.
387 rnMethodBinds cls gen_tyvars mbind@(PatMonoBind other_pat _ locn)
388 = addSrcLoc locn (addErr (methodBindErr mbind)) `thenM_`
389 returnM (EmptyMonoBinds, emptyFVs)
393 %************************************************************************
395 Strongly connected components
398 %************************************************************************
400 During analysis a @MonoBinds@ is flattened to a @FlatMonoBinds@.
401 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
402 a function binding, and has itself been dependency-analysed and
406 type FlatMonoBinds = (Defs, Uses, RenamedMonoBinds, [RenamedSig])
407 -- Signatures, if any, for this vertex
409 rnSCC :: [FlatMonoBinds] -> [SCC FlatMonoBinds]
410 rnSCC nodes = stronglyConnComp (mkEdges nodes)
414 mkEdges :: [FlatMonoBinds] -> [(FlatMonoBinds, VertexTag, [VertexTag])]
415 -- We keep the uses with the binding,
416 -- so we can track unused bindings better
418 = [ (thing, tag, dest_vertices uses)
419 | (thing@(_, uses, _, _), tag) <- tagged_nodes
422 tagged_nodes = nodes `zip` [0::VertexTag ..]
424 -- An edge (v,v') indicates that v depends on v'
425 dest_vertices uses = [ target_vertex
426 | ((defs, _, _, _), target_vertex) <- tagged_nodes,
427 defs `intersectsNameSet` uses
430 reconstructCycle :: SCC FlatMonoBinds -> (RenamedHsBinds, (Defs,Uses))
431 reconstructCycle (AcyclicSCC (defs, uses, binds, sigs))
432 = (MonoBind binds sigs NonRecursive, (defs, uses))
433 reconstructCycle (CyclicSCC cycle)
434 = (MonoBind this_gp_binds this_gp_sigs Recursive,
435 (unionManyNameSets defs_s, unionManyNameSets uses_s))
437 (defs_s, uses_s, binds_s, sigs_s) = unzip4 cycle
438 this_gp_binds = foldr1 AndMonoBinds binds_s
439 this_gp_sigs = foldr1 (++) sigs_s
443 %************************************************************************
445 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
447 %************************************************************************
449 @renameSigs@ checks for:
451 \item more than one sig for one thing;
452 \item signatures given for things not bound here;
453 \item with suitably flaggery, that all top-level things have type signatures.
456 At the moment we don't gather free-var info from the types in
457 signatures. We'd only need this if we wanted to report unused tyvars.
460 checkSigs :: (RenamedSig -> Bool) -- OK-sig predicbate
463 checkSigs ok_sig sigs
464 -- Check for (a) duplicate signatures
465 -- (b) signatures for things not in this group
466 -- Well, I can't see the check for (a)... ToDo!
467 = mappM_ unknownSigErr bad_sigs
469 bad_sigs = filter (not . ok_sig) sigs
471 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
472 -- because this won't work for:
473 -- instance Foo T where
476 -- We'll just rename the INLINE prag to refer to whatever other 'op'
477 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
478 -- Doesn't seem worth much trouble to sort this.
480 renameSigs :: [Sig RdrName] -> RnM [Sig Name]
481 renameSigs sigs = mappM renameSig (filter (not . isFixitySig) sigs)
482 -- Remove fixity sigs which have been dealt with already
484 renameSig :: Sig RdrName -> RnM (Sig Name)
485 -- ClassOpSig, FixitSig is renamed elsewhere.
486 renameSig (Sig v ty src_loc)
487 = addSrcLoc src_loc $
488 lookupSigOccRn v `thenM` \ new_v ->
489 rnHsSigType (quotes (ppr v)) ty `thenM` \ new_ty ->
490 returnM (Sig new_v new_ty src_loc)
492 renameSig (SpecInstSig ty src_loc)
493 = addSrcLoc src_loc $
494 rnHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
495 returnM (SpecInstSig new_ty src_loc)
497 renameSig (SpecSig v ty src_loc)
498 = addSrcLoc src_loc $
499 lookupSigOccRn v `thenM` \ new_v ->
500 rnHsSigType (quotes (ppr v)) ty `thenM` \ new_ty ->
501 returnM (SpecSig new_v new_ty src_loc)
503 renameSig (InlineSig b v p src_loc)
504 = addSrcLoc src_loc $
505 lookupSigOccRn v `thenM` \ new_v ->
506 returnM (InlineSig b new_v p src_loc)
510 %************************************************************************
512 \subsection{Error messages}
514 %************************************************************************
519 addErr (sep [ptext SLIT("Duplicate") <+> what_it_is <> colon,
522 (what_it_is, loc) = hsSigDoc sig
526 addErr (sep [ptext SLIT("Misplaced") <+> what_it_is <> colon,
529 (what_it_is, loc) = hsSigDoc sig
532 = addSrcLoc (nameSrcLoc var) $
533 addWarn (sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)])
536 = hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))