rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS, -- or these for local bindings
rnMethodBinds, renameSigs, mkSigTvFn,
rnMatchGroup, rnGRHSs,
- makeMiniFixityEnv
+ makeMiniFixityEnv, MiniFixityEnv
) where
-#include "HsVersions.h"
-
import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
import HsSyn
NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker,
patSigErr)
-import RnEnv ( lookupLocatedBndrRn,
- lookupInstDeclBndr, newIPNameRn,
- lookupLocatedSigOccRn, bindPatSigTyVarsFV,
- bindLocalFixities, bindSigTyVarsFV,
- warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
- bindLocatedLocalsFV, bindLocalNames, bindLocalNamesFV,
- bindLocalNamesFV_WithFixities,
- bindLocatedLocalsRn,
- checkDupAndShadowedRdrNames
- )
+import RnEnv
import DynFlags ( DynFlag(..) )
import HscTypes (FixItem(..))
import Name
import NameEnv
-import UniqFM
+import LazyUniqFM
import NameSet
import PrelNames ( isUnboundName )
import RdrName ( RdrName, rdrNameOcc )
import Digraph ( SCC(..), stronglyConnComp )
import Bag
import Outputable
+import FastString
import Maybes ( orElse )
import Util ( filterOut )
import Monad ( foldM, unless )
\begin{code}
-- for top-level bindings, we need to make top-level names,
-- so we have a different entry point than for local bindings
-rnTopBindsLHS :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
+rnTopBindsLHS :: MiniFixityEnv
-> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName)
rnTopBindsLHS fix_env binds =
rnTopBinds :: HsValBinds RdrName
-> RnM (HsValBinds Name, DefUses)
rnTopBinds b =
- do nl <- rnTopBindsLHS emptyUFM b
+ do nl <- rnTopBindsLHS emptyFsEnv b
let bound_names = map unLoc (collectHsValBinders nl)
bindLocalNames bound_names $ rnTopBindsRHS bound_names nl
\begin{code}
-- wrapper for local binds
-- creates the documentation info and calls the helper below
-rnValBindsLHS :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
+rnValBindsLHS :: MiniFixityEnv
-> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName)
rnValBindsLHS fix_env binds =
-- just so we don't forget to do it somewhere
rnValBindsLHSFromDoc_Local :: [Located RdrName] -- RdrNames of the LHS (so we don't have to gather them twice)
-> SDoc -- doc string for dup names and shadowing
- -> UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
+ -> MiniFixityEnv
-> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName)
rnValBindsRHSGen trim bound_names binds@(ValBindsIn mbinds sigs) = do
-- rename the sigs
+ env <- getGblEnv
+ traceRn (ptext (sLit "Rename sigs") <+> ppr (tcg_rdr_env env))
sigs' <- rename_sigs sigs
-- rename the RHSes
binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
check_sigs (okBindSig (duDefs anal_dus)) sigs'
return (valbind', valbind'_dus)
--- wrapper for local binds
+-- Wrapper for local binds
--
--- the *client* of this function is responsible for checking for unused binders;
+-- The *client* of this function is responsible for checking for unused binders;
-- it doesn't (and can't: we don't have the thing inside the binds) happen here
--
--- the client is also responsible for bringing the fixities into scope
+-- The client is also responsible for bringing the fixities into scope
rnValBindsRHS :: [Name] -- names bound by the LHSes
-> HsValBindsLR Name RdrName
-> RnM (HsValBinds Name, DefUses)
rnValBindsAndThen :: HsValBinds RdrName
-> (HsValBinds Name -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
-rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside =
- let
- (original_bndrs, doc) = bindersAndDoc binds
+rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
+ = do { let (original_bndrs, doc) = bindersAndDoc binds
+
+ -- (A) Create the local fixity environment
+ ; new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs]
- in do
- -- (A) create the local fixity environment
- new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs]
+ -- (B) Rename the LHSes
+ ; new_lhs <- rnValBindsLHSFromDoc_Local original_bndrs doc new_fixities binds
+ ; let bound_names = map unLoc $ collectHsValBinders new_lhs
- -- (B) rename the LHSes
- new_lhs <- rnValBindsLHSFromDoc_Local original_bndrs doc new_fixities binds
- let bound_names = map unLoc $ collectHsValBinders new_lhs
+ -- ...and bring them (and their fixities) into scope
+ ; bindLocalNamesFV_WithFixities bound_names new_fixities $ do
- -- and bring them (and their fixities) into scope
- bindLocalNamesFV_WithFixities bound_names new_fixities $
- warnUnusedLocalBinds bound_names $ do
+ { -- (C) Do the RHS and thing inside
+ (binds', dus) <- rnValBindsRHS bound_names new_lhs
+ ; (result, result_fvs) <- thing_inside binds'
- -- (C) do the RHS and thing inside
- (binds', dus) <- rnValBindsRHS bound_names new_lhs
- (result, result_fvs) <- thing_inside binds'
+ -- Report unused bindings based on the (accurate)
+ -- findUses. E.g.
+ -- let x = x in 3
+ -- should report 'x' unused
+ ; let real_uses = findUses dus result_fvs
+ ; warnUnusedLocalBinds bound_names real_uses
- let
- -- the variables used in the val binds are:
- -- (1) the uses of the binds
+ ; let
+ -- The variables "used" in the val binds are:
+ -- (1) the uses of the binds (duUses)
-- (2) the FVs of the thing-inside
- all_uses = (duUses dus) `plusFV` result_fvs
- -- duUses: It's important to return all the uses. Otherwise consider:
+ all_uses = duUses dus `plusFV` result_fvs
+ -- Note [Unused binding hack]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
+ -- Note that *in contrast* to the above reporting of
+ -- unused bindings, (1) above uses duUses to return *all*
+ -- the uses, even if the binding is unused. Otherwise consider:
-- x = 3
-- y = let p = x in 'x' -- NB: p not used
-- If we don't "see" the dependency of 'y' on 'x', we may put the
-- bindings in the wrong order, and the type checker will complain
-- that x isn't in scope
+ --
+ -- But note that this means we won't report 'x' as unused,
+ -- whereas we would if we had { x = 3; p = x; y = 'x' }
- return (result,
- -- the bound names are pruned out of all_uses
- -- by the bindLocalNamesFV call above
- all_uses)
+ ; return (result, all_uses) }}
+ -- The bound names are pruned out of all_uses
+ -- by the bindLocalNamesFV call above
+
-- Process the fixity declarations, making a FastString -> (Located Fixity) map
-- Checks for duplicates, but not that only locally defined things are fixed.
-- Note: for local fixity declarations, duplicates would also be checked in
-- check_sigs below. But we also use this function at the top level.
-makeMiniFixityEnv :: [LFixitySig RdrName]
- -> RnM (UniqFM (Located Fixity)) -- key is the FastString of the OccName
- -- of the fixity declaration it came from
-
-makeMiniFixityEnv decls = foldlM add_one emptyUFM decls
+
+makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
+
+makeMiniFixityEnv decls = foldlM add_one emptyFsEnv decls
where
add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
{ -- this fixity decl is a duplicate iff
-- the ReaderName's OccName's FastString is already in the env
-- (we only need to check the local fix_env because
-- definitions of non-local will be caught elsewhere)
- let {occ = rdrNameOcc name;
- curKey = occNameFS occ;
- fix_item = L loc fixity};
+ let { fs = occNameFS (rdrNameOcc name)
+ ; fix_item = L loc fixity };
- case lookupUFM env curKey of
- Nothing -> return $ addToUFM env curKey fix_item
+ case lookupFsEnv env fs of
+ Nothing -> return $ extendFsEnv env fs fix_item
Just (L loc' _) -> do
{ setSrcSpan loc $
- addLocErr (L name_loc name) (dupFixityDecl loc')
+ addLocErr (L name_loc name) (dupFixityDecl loc')
; return env}
}
(nameEnvElts env)
dupFixityDecl loc rdr_name
- = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
- ptext SLIT("also at ") <+> ppr loc]
+ = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name),
+ ptext (sLit "also at ") <+> ppr loc]
---------------------
\begin{code}
dupSigDeclErr sigs@(L loc sig : _)
= addErrAt loc $
- vcat [ptext SLIT("Duplicate") <+> what_it_is <> colon,
+ vcat [ptext (sLit "Duplicate") <+> what_it_is <> colon,
nest 2 (vcat (map ppr_sig sigs))]
where
what_it_is = hsSigDoc sig
unknownSigErr (L loc sig)
= do { mod <- getModule
; addErrAt loc $
- vcat [sep [ptext SLIT("Misplaced") <+> what_it_is <> colon, ppr sig],
+ vcat [sep [ptext (sLit "Misplaced") <+> what_it_is <> colon, ppr sig],
extra_stuff mod sig] }
where
what_it_is = hsSigDoc sig
extra_stuff mod (TypeSig (L _ n) _)
| nameIsLocalOrFrom mod n
- = ptext SLIT("The type signature must be given where")
- <+> quotes (ppr n) <+> ptext SLIT("is declared")
+ = ptext (sLit "The type signature must be given where")
+ <+> quotes (ppr n) <+> ptext (sLit "is declared")
| otherwise
- = ptext SLIT("You cannot give a type signature for an imported value")
+ = ptext (sLit "You cannot give a type signature for an imported value")
extra_stuff mod other = empty
methodBindErr mbind
- = hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
+ = hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
2 (ppr mbind)
bindsInHsBootFile mbinds
- = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))
+ = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
2 (ppr mbinds)
nonStdGuardErr guards
- = hang (ptext SLIT("accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
+ = hang (ptext (sLit "accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
4 (interpp'SP guards)
\end{code}