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).
14 rnLocalBindsAndThen, rnValBindsAndThen, rnValBinds, trimWith,
15 rnMethodBinds, renameSigs,
19 #include "HsVersions.h"
21 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
24 import HsBinds ( hsSigDoc, eqHsSig )
28 import RnTypes ( rnHsSigType, rnLHsType, rnHsTypeFVs,
29 rnLPat, rnPatsAndThen, patSigErr, checkPrecMatch )
30 import RnEnv ( bindLocatedLocalsRn, lookupLocatedBndrRn,
31 lookupLocatedInstDeclBndr, newIPNameRn,
32 lookupLocatedSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
33 bindLocalFixities, bindSigTyVarsFV,
34 warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
36 import DynFlags ( DynFlag(..) )
37 import Name ( Name, nameOccName, nameSrcLoc )
40 import PrelNames ( isUnboundName )
41 import RdrName ( RdrName, rdrNameOcc )
42 import SrcLoc ( mkSrcSpan, Located(..), unLoc )
43 import ListSetOps ( findDupsEq )
46 import Maybes ( orElse )
47 import Monad ( foldM )
50 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
51 -- place and can be used when complaining.
53 The code tree received by the function @rnBinds@ contains definitions
54 in where-clauses which are all apparently mutually recursive, but which may
55 not really depend upon each other. For example, in the top level program
60 the definitions of @a@ and @y@ do not depend on each other at all.
61 Unfortunately, the typechecker cannot always check such definitions.
62 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
63 definitions. In Proceedings of the International Symposium on Programming,
64 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
65 However, the typechecker usually can check definitions in which only the
66 strongly connected components have been collected into recursive bindings.
67 This is precisely what the function @rnBinds@ does.
69 ToDo: deal with case where a single monobinds binds the same variable
72 The vertag tag is a unique @Int@; the tags only need to be unique
73 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
74 (heavy monad machinery not needed).
77 %************************************************************************
79 %* naming conventions *
81 %************************************************************************
83 \subsection[name-conventions]{Name conventions}
85 The basic algorithm involves walking over the tree and returning a tuple
86 containing the new tree plus its free variables. Some functions, such
87 as those walking polymorphic bindings (HsBinds) and qualifier lists in
88 list comprehensions (@Quals@), return the variables bound in local
89 environments. These are then used to calculate the free variables of the
90 expression evaluated in these environments.
92 Conventions for variable names are as follows:
95 new code is given a prime to distinguish it from the old.
98 a set of variables defined in @Exp@ is written @dvExp@
101 a set of variables free in @Exp@ is written @fvExp@
104 %************************************************************************
106 %* analysing polymorphic bindings (HsBindGroup, HsBind)
108 %************************************************************************
110 \subsubsection[dep-HsBinds]{Polymorphic bindings}
112 Non-recursive expressions are reconstructed without any changes at top
113 level, although their component expressions may have to be altered.
114 However, non-recursive expressions are currently not expected as
115 \Haskell{} programs, and this code should not be executed.
117 Monomorphic bindings contain information that is returned in a tuple
118 (a @FlatMonoBinds@) containing:
122 a unique @Int@ that serves as the ``vertex tag'' for this binding.
125 the name of a function or the names in a pattern. These are a set
126 referred to as @dvLhs@, the defined variables of the left hand side.
129 the free variables of the body. These are referred to as @fvBody@.
132 the definition's actual code. This is referred to as just @code@.
135 The function @nonRecDvFv@ returns two sets of variables. The first is
136 the set of variables defined in the set of monomorphic bindings, while the
137 second is the set of free variables in those bindings.
139 The set of variables defined in a non-recursive binding is just the
140 union of all of them, as @union@ removes duplicates. However, the
141 free variables in each successive set of cumulative bindings is the
142 union of those in the previous set plus those of the newest binding after
143 the defined variables of the previous set have been removed.
145 @rnMethodBinds@ deals only with the declarations in class and
146 instance declarations. It expects only to see @FunMonoBind@s, and
147 it expects the global environment to contain bindings for the binders
148 (which are all class operations).
150 %************************************************************************
152 \subsubsection{ Top-level bindings}
154 %************************************************************************
156 @rnTopMonoBinds@ assumes that the environment already
157 contains bindings for the binders of this particular binding.
160 rnTopBinds :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
162 -- The binders of the binding are in scope already;
163 -- the top level scope resolution does that
166 = do { is_boot <- tcIsHsBoot
167 ; if is_boot then rnTopBindsBoot binds
168 else rnTopBindsSrc binds }
170 rnTopBindsBoot :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
171 -- A hs-boot file has no bindings.
172 -- Return a single HsBindGroup with empty binds and renamed signatures
173 rnTopBindsBoot (ValBindsIn mbinds sigs)
174 = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
175 ; sigs' <- renameSigs okHsBootSig sigs
176 ; return (ValBindsIn emptyLHsBinds sigs', usesOnly (hsSigsFVs sigs')) }
178 rnTopBindsSrc :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
179 rnTopBindsSrc binds@(ValBindsIn mbinds _)
180 = bindPatSigTyVars (collectSigTysFromHsBinds (bagToList mbinds)) $ \ _ ->
181 -- Hmm; by analogy with Ids, this doesn't look right
182 -- Top-level bound type vars should really scope over
183 -- everything, but we only scope them over the other bindings
185 do { (binds', dus) <- rnValBinds noTrim binds
187 -- Warn about missing signatures,
188 ; let { ValBindsIn _ sigs' = binds'
189 ; ty_sig_vars = mkNameSet [ unLoc n | L _ (Sig n _) <- sigs']
190 ; un_sigd_bndrs = duDefs dus `minusNameSet` ty_sig_vars }
192 ; warn_missing_sigs <- doptM Opt_WarnMissingSigs
193 ; ifM (warn_missing_sigs)
194 (mappM_ missingSigWarn (nameSetToList un_sigd_bndrs))
196 ; return (binds', dus)
202 %*********************************************************
206 %*********************************************************
210 :: HsLocalBinds RdrName
211 -> (HsLocalBinds Name -> RnM (result, FreeVars))
212 -> RnM (result, FreeVars)
213 -- This version (a) assumes that the binding vars are not already in scope
214 -- (b) removes the binders from the free vars of the thing inside
215 -- The parser doesn't produce ThenBinds
216 rnLocalBindsAndThen EmptyLocalBinds thing_inside
217 = thing_inside EmptyLocalBinds
219 rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
220 = rnValBindsAndThen val_binds $ \ val_binds' ->
221 thing_inside (HsValBinds val_binds')
223 rnLocalBindsAndThen (HsIPBinds binds) thing_inside
224 = rnIPBinds binds `thenM` \ (binds',fv_binds) ->
225 thing_inside (HsIPBinds binds') `thenM` \ (thing, fvs_thing) ->
226 returnM (thing, fvs_thing `plusFV` fv_binds)
229 rnIPBinds (IPBinds ip_binds _no_dict_binds)
230 = do { (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
231 ; return (IPBinds ip_binds' emptyLHsBinds, plusFVs fvs_s) }
233 rnIPBind (IPBind n expr)
234 = newIPNameRn n `thenM` \ name ->
235 rnLExpr expr `thenM` \ (expr',fvExpr) ->
236 return (IPBind name expr', fvExpr)
240 %************************************************************************
244 %************************************************************************
247 rnValBindsAndThen :: HsValBinds RdrName
248 -> (HsValBinds Name -> RnM (result, FreeVars))
249 -> RnM (result, FreeVars)
251 rnValBindsAndThen binds@(ValBindsIn mbinds sigs) thing_inside
252 = -- Extract all the binders in this group, and extend the
253 -- current scope, inventing new names for the new binders
254 -- This also checks that the names form a set
255 bindLocatedLocalsRn doc mbinders_w_srclocs $ \ bndrs ->
256 bindPatSigTyVarsFV (collectSigTysFromHsBinds (bagToList mbinds)) $
258 -- Then install local fixity declarations
259 -- Notice that they scope over thing_inside too
260 bindLocalFixities [sig | L _ (FixSig sig) <- sigs ] $
263 rnValBinds (trimWith bndrs) binds `thenM` \ (binds, bind_dus) ->
265 -- Now do the "thing inside"
266 thing_inside binds `thenM` \ (result,result_fvs) ->
268 -- Final error checking
270 all_uses = duUses bind_dus `plusFV` result_fvs
271 unused_bndrs = [ b | b <- bndrs, not (b `elemNameSet` all_uses)]
273 warnUnusedLocalBinds unused_bndrs `thenM_`
275 returnM (result, delListFromNameSet all_uses bndrs)
276 -- duUses: It's important to return all the uses, not the 'real uses'
277 -- used for warning about unused bindings. Otherwise consider:
279 -- y = let p = x in 'x' -- NB: p not used
280 -- If we don't "see" the dependency of 'y' on 'x', we may put the
281 -- bindings in the wrong order, and the type checker will complain
282 -- that x isn't in scope
284 mbinders_w_srclocs = collectHsBindLocatedBinders mbinds
285 doc = text "In the binding group for:"
286 <+> pprWithCommas ppr (map unLoc mbinders_w_srclocs)
288 ---------------------
289 rnValBinds :: (FreeVars -> FreeVars)
290 -> HsValBinds RdrName
291 -> RnM (HsValBinds Name, DefUses)
292 -- Assumes the binders of the binding are in scope already
294 rnValBinds trim (ValBindsIn mbinds sigs)
295 = do { sigs' <- rename_sigs sigs
297 ; let { rn_bind = wrapLocFstM (rnBind sig_fn trim)
298 ; sig_fn = mkSigTvFn sigs' }
300 ; (mbinds', du_bag) <- mapAndUnzipBagM rn_bind mbinds
302 ; let defs, uses :: NameSet
303 (defs, uses) = foldrBag plus (emptyNameSet, emptyNameSet) du_bag
304 plus (ds1,us1) (ds2,us2) = (ds1 `unionNameSets` ds2,
305 us1 `unionNameSets` us2)
307 ; check_sigs (okBindSig defs) sigs'
309 ; traceRn (text "rnValBind" <+> (ppr defs $$ ppr uses))
310 ; return (ValBindsIn mbinds' sigs',
311 [(Just defs, uses `plusFV` hsSigsFVs sigs')]) }
313 ---------------------
314 -- Bind the top-level forall'd type variables in the sigs.
317 -- The 'a' scopes over the rhs
319 -- NB: there'll usually be just one (for a function binding)
320 -- but if there are many, one may shadow the rest; too bad!
321 -- e.g x :: [a] -> [a]
324 -- In e, 'a' will be in scope, and it'll be the one from 'y'!
326 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
327 -- Return a lookup function that maps an Id Name to the names
328 -- of the type variables that should scope over its body..
330 = \n -> lookupNameEnv env n `orElse` []
332 env :: NameEnv [Name]
333 env = mkNameEnv [ (name, map hsLTyVarName ltvs)
334 | L _ (Sig (L _ name)
335 (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
336 -- Note the pattern-match on "Explicit"; we only bind
337 -- type variables from signatures with an explicit top-level for-all
339 -- The trimming function trims the free vars we attach to a
340 -- binding so that it stays reasonably small
341 noTrim :: FreeVars -> FreeVars
342 noTrim fvs = fvs -- Used at top level
344 trimWith :: [Name] -> FreeVars -> FreeVars
345 -- Nested bindings; trim by intersection with the names bound here
346 trimWith bndrs = intersectNameSet (mkNameSet bndrs)
348 ---------------------
349 rnBind :: (Name -> [Name]) -- Signature tyvar function
350 -> (FreeVars -> FreeVars) -- Trimming function for rhs free vars
352 -> RnM (HsBind Name, (Defs, Uses))
353 rnBind sig_fn trim (PatBind pat grhss ty _)
354 = do { (pat', pat_fvs) <- rnLPat pat
356 ; let bndrs = collectPatBinders pat'
358 ; (grhss', fvs) <- bindSigTyVarsFV (concatMap sig_fn bndrs) $
359 rnGRHSs PatBindRhs grhss
361 ; return (PatBind pat' grhss' ty (trim fvs),
362 (mkNameSet bndrs, pat_fvs `plusFV` fvs)) }
364 rnBind sig_fn trim (FunBind name inf matches _)
365 = do { new_name <- lookupLocatedBndrRn name
366 ; let { plain_name = unLoc new_name
367 ; bndrs = unitNameSet plain_name }
369 ; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
370 rnMatchGroup (FunRhs plain_name) matches
372 ; checkPrecMatch inf plain_name matches'
374 ; return (FunBind new_name inf matches' (trim fvs),
380 @rnMethodBinds@ is used for the method bindings of a class and an instance
381 declaration. Like @rnBinds@ but without dependency analysis.
383 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
384 That's crucial when dealing with an instance decl:
386 instance Foo (T a) where
389 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
390 and unless @op@ occurs we won't treat the type signature of @op@ in the class
391 decl for @Foo@ as a source of instance-decl gates. But we should! Indeed,
392 in many ways the @op@ in an instance decl is just like an occurrence, not
396 rnMethodBinds :: Name -- Class name
397 -> [Name] -- Names for generic type variables
399 -> RnM (LHsBinds Name, FreeVars)
401 rnMethodBinds cls gen_tyvars binds
402 = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
403 where do_one (binds,fvs) bind = do
404 (bind', fvs_bind) <- rnMethodBind cls gen_tyvars bind
405 return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
407 rnMethodBind cls gen_tyvars (L loc (FunBind name inf (MatchGroup matches _) _))
409 lookupLocatedInstDeclBndr cls name `thenM` \ sel_name ->
410 let plain_name = unLoc sel_name in
411 -- We use the selector name as the binder
413 mapFvRn (rn_match plain_name) matches `thenM` \ (new_matches, fvs) ->
415 new_group = MatchGroup new_matches placeHolderType
417 checkPrecMatch inf plain_name new_group `thenM_`
418 returnM (unitBag (L loc (FunBind sel_name inf new_group fvs)), fvs `addOneFV` plain_name)
419 -- The 'fvs' field isn't used for method binds
421 -- Truly gruesome; bring into scope the correct members of the generic
422 -- type variables. See comments in RnSource.rnSourceDecl(ClassDecl)
423 rn_match sel_name match@(L _ (Match (L _ (TypePat ty) : _) _ _))
424 = extendTyVarEnvFVRn gen_tvs $
425 rnMatch (FunRhs sel_name) match
427 tvs = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
428 gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
430 rn_match sel_name match = rnMatch (FunRhs sel_name) match
433 -- Can't handle method pattern-bindings which bind multiple methods.
434 rnMethodBind cls gen_tyvars mbind@(L loc (PatBind other_pat _ _ _))
435 = addLocErr mbind methodBindErr `thenM_`
436 returnM (emptyBag, emptyFVs)
440 %************************************************************************
442 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
444 %************************************************************************
446 @renameSigs@ checks for:
448 \item more than one sig for one thing;
449 \item signatures given for things not bound here;
450 \item with suitably flaggery, that all top-level things have type signatures.
453 At the moment we don't gather free-var info from the types in
454 signatures. We'd only need this if we wanted to report unused tyvars.
457 renameSigs :: (LSig Name -> Bool) -> [LSig RdrName] -> RnM [LSig Name]
458 -- Renames the signatures and performs error checks
459 renameSigs ok_sig sigs
460 = do { sigs' <- rename_sigs sigs
461 ; check_sigs ok_sig sigs'
464 ----------------------
465 rename_sigs :: [LSig RdrName] -> RnM [LSig Name]
466 rename_sigs sigs = mappM (wrapLocM renameSig)
467 (filter (not . isFixityLSig) sigs)
468 -- Remove fixity sigs which have been dealt with already
470 ----------------------
471 check_sigs :: (LSig Name -> Bool) -> [LSig Name] -> RnM ()
472 -- Used for class and instance decls, as well as regular bindings
473 check_sigs ok_sig sigs
474 -- Check for (a) duplicate signatures
475 -- (b) signatures for things not in this group
476 = do { mappM_ unknownSigErr (filter bad sigs)
477 ; mappM_ dupSigDeclErr (findDupsEq eqHsSig sigs) }
479 bad sig = not (ok_sig sig) &&
481 Just n | isUnboundName n -> False
482 -- Don't complain about an unbound name again
484 -- We use lookupLocatedSigOccRn in the signatures, which is a little bit unsatisfactory
485 -- because this won't work for:
486 -- instance Foo T where
489 -- We'll just rename the INLINE prag to refer to whatever other 'op'
490 -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
491 -- Doesn't seem worth much trouble to sort this.
493 renameSig :: Sig RdrName -> RnM (Sig Name)
494 -- FixitSig is renamed elsewhere.
496 = lookupLocatedSigOccRn v `thenM` \ new_v ->
497 rnHsSigType (quotes (ppr v)) ty `thenM` \ new_ty ->
498 returnM (Sig new_v new_ty)
500 renameSig (SpecInstSig ty)
501 = rnLHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
502 returnM (SpecInstSig new_ty)
504 renameSig (SpecSig v ty)
505 = lookupLocatedSigOccRn v `thenM` \ new_v ->
506 rnHsSigType (quotes (ppr v)) ty `thenM` \ new_ty ->
507 returnM (SpecSig new_v new_ty)
509 renameSig (InlineSig b v p)
510 = lookupLocatedSigOccRn v `thenM` \ new_v ->
511 returnM (InlineSig b new_v p)
515 ************************************************************************
519 ************************************************************************
522 rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
523 rnMatchGroup ctxt (MatchGroup ms _)
524 = mapFvRn (rnMatch ctxt) ms `thenM` \ (new_ms, ms_fvs) ->
525 returnM (MatchGroup new_ms placeHolderType, ms_fvs)
527 rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
528 rnMatch ctxt = wrapLocFstM (rnMatch' ctxt)
530 rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
532 -- Deal with the rhs type signature
533 bindPatSigTyVarsFV rhs_sig_tys $
534 doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
535 (case maybe_rhs_sig of
536 Nothing -> returnM (Nothing, emptyFVs)
537 Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty `thenM` \ (ty', ty_fvs) ->
538 returnM (Just ty', ty_fvs)
539 | otherwise -> addLocErr ty patSigErr `thenM_`
540 returnM (Nothing, emptyFVs)
541 ) `thenM` \ (maybe_rhs_sig', ty_fvs) ->
543 -- Now the main event
544 rnPatsAndThen ctxt pats $ \ pats' ->
545 rnGRHSs ctxt grhss `thenM` \ (grhss', grhss_fvs) ->
547 returnM (Match pats' maybe_rhs_sig' grhss', grhss_fvs `plusFV` ty_fvs)
548 -- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
550 rhs_sig_tys = case maybe_rhs_sig of
553 doc_sig = text "In a result type-signature"
557 %************************************************************************
559 \subsubsection{Guarded right-hand sides (GRHSs)}
561 %************************************************************************
564 rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
566 rnGRHSs ctxt (GRHSs grhss binds)
567 = rnLocalBindsAndThen binds $ \ binds' ->
568 mapFvRn (rnGRHS ctxt) grhss `thenM` \ (grhss', fvGRHSs) ->
569 returnM (GRHSs grhss' binds', fvGRHSs)
571 rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
572 rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
574 rnGRHS' ctxt (GRHS guards rhs)
575 = do { opt_GlasgowExts <- doptM Opt_GlasgowExts
576 ; checkM (opt_GlasgowExts || is_standard_guard guards)
577 (addWarn (nonStdGuardErr guards))
579 ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
581 ; return (GRHS guards' rhs', fvs) }
583 -- Standard Haskell 1.4 guards are just a single boolean
584 -- expression, rather than a list of qualifiers as in the
586 is_standard_guard [] = True
587 is_standard_guard [L _ (ExprStmt _ _ _)] = True
588 is_standard_guard other = False
591 %************************************************************************
593 \subsection{Error messages}
595 %************************************************************************
598 dupSigDeclErr sigs@(L loc sig : _)
600 vcat [ptext SLIT("Duplicate") <+> what_it_is <> colon,
601 nest 2 (vcat (map ppr_sig sigs))]
603 what_it_is = hsSigDoc sig
604 ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
606 unknownSigErr (L loc sig)
608 sep [ptext SLIT("Misplaced") <+> what_it_is <> colon, ppr sig]
610 what_it_is = hsSigDoc sig
613 = addWarnAt (mkSrcSpan loc loc) $
614 sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
616 loc = nameSrcLoc var -- TODO: make a proper span
619 = hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
622 bindsInHsBootFile mbinds
623 = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))
628 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")