- lookupBndrRn,lookupTopBndrRn,
- lookupOccRn, lookupGlobalOccRn,
+ lookupLocatedBndrRn, lookupBndrRn,
+ lookupLocatedTopBndrRn, lookupTopBndrRn,
+ lookupLocatedOccRn, lookupOccRn,
+ lookupLocatedGlobalOccRn, lookupGlobalOccRn,
- lookupFixityRn, lookupSigOccRn, lookupInstDeclBndr,
+ lookupFixityRn, lookupLocatedSigOccRn,
+ lookupLocatedInstDeclBndr,
lookupSyntaxName, lookupSyntaxNames, lookupImportedName,
newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV,
lookupSyntaxName, lookupSyntaxNames, lookupImportedName,
newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV,
bindPatSigTyVars, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalFixities,
bindPatSigTyVars, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalFixities,
checkDupNames, mapFvRn,
warnUnusedMatches, warnUnusedModules, warnUnusedImports,
warnUnusedTopBinds, warnUnusedLocalBinds,
checkDupNames, mapFvRn,
warnUnusedMatches, warnUnusedModules, warnUnusedImports,
warnUnusedTopBinds, warnUnusedLocalBinds,
import LoadIface ( loadSrcInterface )
import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
import HsSyn
import LoadIface ( loadSrcInterface )
import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
import HsSyn
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
pprGlobalRdrEnv, lookupGRE_RdrName,
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
pprGlobalRdrEnv, lookupGRE_RdrName,
import Name ( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
nameSrcLoc, nameOccName, nameModuleName, nameParent )
import NameSet
import Name ( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
nameSrcLoc, nameOccName, nameModuleName, nameParent )
import NameSet
-import OccName ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
+import OccName ( tcName, isDataOcc, occNameFlavour, reportIfUnused,
+ isVarOcc )
import Module ( Module, ModuleName, moduleName, mkHomeModule )
import PrelNames ( mkUnboundName, rOOT_MAIN_Name, iNTERACTIVE )
import UniqSupply
import BasicTypes ( IPName, mapIPName )
import Module ( Module, ModuleName, moduleName, mkHomeModule )
import PrelNames ( mkUnboundName, rOOT_MAIN_Name, iNTERACTIVE )
import UniqSupply
import BasicTypes ( IPName, mapIPName )
-newTopSrcBinder :: Module -> Maybe Name -> (RdrName, SrcLoc) -> RnM Name
-newTopSrcBinder mod mb_parent (rdr_name, loc)
+newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
+newTopSrcBinder mod mb_parent (L loc rdr_name)
-- not from the environment. In principle, it'd be fine to have an
-- arbitrary mixture of external core definitions in a single module,
-- (apart from module-initialisation issues, perhaps).
-- not from the environment. In principle, it'd be fine to have an
-- arbitrary mixture of external core definitions in a single module,
-- (apart from module-initialisation issues, perhaps).
+lookupLocatedBndrRn :: Located RdrName -> RnM (Located Name)
+lookupLocatedBndrRn = wrapLocM lookupBndrRn
+
+lookupBndrRn :: RdrName -> RnM Name
+-- NOTE: assumes that the SrcSpan of the binder has already been addSrcSpan'd
lookupBndrRn rdr_name
= getLocalRdrEnv `thenM` \ local_env ->
case lookupLocalRdrEnv local_env rdr_name of
Just name -> returnM name
Nothing -> lookupTopBndrRn rdr_name
lookupBndrRn rdr_name
= getLocalRdrEnv `thenM` \ local_env ->
case lookupLocalRdrEnv local_env rdr_name of
Just name -> returnM name
Nothing -> lookupTopBndrRn rdr_name
lookupTopBndrRn :: RdrName -> RnM Name
-- Look up a top-level source-code binder. We may be looking up an unqualified 'f',
-- and there may be several imported 'f's too, which must not confuse us.
lookupTopBndrRn :: RdrName -> RnM Name
-- Look up a top-level source-code binder. We may be looking up an unqualified 'f',
-- and there may be several imported 'f's too, which must not confuse us.
-- This deals with the case of derived bindings, where
-- we don't bother to call newTopSrcBinder first
-- We assume there is no "parent" name
-- This deals with the case of derived bindings, where
-- we don't bother to call newTopSrcBinder first
-- We assume there is no "parent" name
- = getSrcLocM `thenM` \ loc ->
- newGlobalBinder (mkHomeModule (rdrNameModule rdr_name))
- (rdrNameOcc rdr_name) Nothing loc
+ = do
+ loc <- getSrcSpanM
+ newGlobalBinder (mkHomeModule (rdrNameModule rdr_name))
+ (rdrNameOcc rdr_name) Nothing (srcSpanStart loc)
-- The Haskell98 report does not stipulate this, but it will!
-- So we must treat the 'f' in the signature in the same way
-- as the binding occurrence of 'f', using lookupBndrRn
-- The Haskell98 report does not stipulate this, but it will!
-- So we must treat the 'f' in the signature in the same way
-- as the binding occurrence of 'f', using lookupBndrRn
-- lookupInstDeclBndr is used for the binders in an
-- instance declaration. Here we use the class name to
-- disambiguate.
-- lookupInstDeclBndr is used for the binders in an
-- instance declaration. Here we use the class name to
-- disambiguate.
lookupInstDeclBndr :: Name -> RdrName -> RnM Name
lookupInstDeclBndr cls_name rdr_name
| isUnqual rdr_name -- Find all the things the rdr-name maps to
lookupInstDeclBndr :: Name -> RdrName -> RnM Name
lookupInstDeclBndr cls_name rdr_name
| isUnqual rdr_name -- Find all the things the rdr-name maps to
lookupGlobalOccRn :: RdrName -> RnM Name
-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
-- environment. It's used only for
lookupGlobalOccRn :: RdrName -> RnM Name
-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
-- environment. It's used only for
-> (GlobalRdrEnv -> [GlobalRdrElt]) -- Lookup function
-> RnM (Maybe GlobalRdrElt)
-- Checks for exactly one match; reports deprecations
-> (GlobalRdrEnv -> [GlobalRdrElt]) -- Lookup function
-> RnM (Maybe GlobalRdrElt)
-- Checks for exactly one match; reports deprecations
-- Used for nested fixity decls
-- No need to worry about type constructors here,
-- Should check for duplicates but we don't
-- Used for nested fixity decls
-- No need to worry about type constructors here,
-- Should check for duplicates but we don't
- rn_sig (FixitySig v fix src_loc)
- = addSrcLoc src_loc $
- lookupSigOccRn v `thenM` \ new_v ->
- returnM (new_v, (FixItem (rdrNameOcc v) fix src_loc))
+ rn_sig (FixitySig lv@(L loc v) fix)
+ = addLocM lookupBndrRn lv `thenM` \ new_v ->
+ returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
-- Get the similarly named thing from the local environment
mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
-- Get the similarly named thing from the local environment
mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
newLocalsRn rdr_names_w_loc
= newUniqueSupply `thenM` \ us ->
returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
where
newLocalsRn rdr_names_w_loc
= newUniqueSupply `thenM` \ us ->
returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
where
| Just name <- isExact_maybe rdr_name = name
-- This happens in code generated by Template Haskell
| otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
-- We only bind unqualified names here
-- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
| Just name <- isExact_maybe rdr_name = name
-- This happens in code generated by Template Haskell
| otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
-- We only bind unqualified names here
-- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
-bindLocalsFV doc rdr_names enclosed_scope
- = bindLocalsRn doc rdr_names $ \ names ->
+bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
+ -> RnM (a, FreeVars)
+bindLocatedLocalsFV doc rdr_names enclosed_scope
+ = bindLocatedLocalsRn doc rdr_names $ \ names ->
enclosed_scope names `thenM` \ (thing, fvs) ->
returnM (thing, delListFromNameSet fvs names)
enclosed_scope names `thenM` \ (thing, fvs) ->
returnM (thing, delListFromNameSet fvs names)
= bindLocalNames tyvars enclosed_scope `thenM` \ (thing, fvs) ->
returnM (thing, delListFromNameSet fvs tyvars)
= bindLocalNames tyvars enclosed_scope `thenM` \ (thing, fvs) ->
returnM (thing, delListFromNameSet fvs tyvars)
- forall_tyvars = nub [ tv | ty <- tys,
- tv <- extractHsTyRdrTyVars ty,
- not (tv `elemLocalRdrEnv` name_env)
+ located_tyvars = nubBy eqLocated [ tv | ty <- tys,
+ tv <- extractHsTyRdrTyVars ty,
+ not (unLoc tv `elemLocalRdrEnv` name_env)
]
-- The 'nub' is important. For example:
-- f (x :: t) (y :: t) = ....
-- We don't want to complain about binding t twice!
]
-- The 'nub' is important. For example:
-- f (x :: t) (y :: t) = ....
-- We don't want to complain about binding t twice!
-> RnM ()
checkDupNames doc_str rdr_names_w_loc
= -- Check for duplicated names in a binding group
mappM_ (dupNamesErr doc_str) dups
where
-> RnM ()
checkDupNames doc_str rdr_names_w_loc
= -- Check for duplicated names in a binding group
mappM_ (dupNamesErr doc_str) dups
where
-warnUnusedGREs gres = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
-warnUnusedLocals names = warnUnusedBinds [(n,Nothing) | n<-names]
+warnUnusedGREs gres
+ = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
-warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
-warnUnusedBinds names
- = mappM_ warnUnusedGroup groups
- where
- -- Group by provenance
- groups = equivClasses cmp (filter reportable names)
- (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
-
- reportable (name,_) = reportIfUnused (nameOccName name)
+warnUnusedLocals names
+ = warnUnusedBinds [(n,Nothing) | n<-names]
-warnUnusedGroup :: [(Name,Maybe Provenance)] -> RnM ()
-warnUnusedGroup names
- = addSrcLoc def_loc $
- addWarn $
- sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))]
+warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
+warnUnusedName (name, prov)
+ = addWarnAt loc (sep [msg <> colon, nest 4 (ppr name)])
+ -- TODO should be a proper span
- (name1, prov1) = head names
- loc1 = nameSrcLoc name1
- (def_loc, msg) = case prov1 of
- Just (Imported is _) -> (is_loc imp_spec, imp_from (is_mod imp_spec))
- where
- imp_spec = head is
- other -> (loc1, unused_msg)
+ (loc,msg) = case prov of
+ Just (Imported is _) ->
+ ( is_loc (head is), imp_from (is_mod imp_spec) )
+ where
+ imp_spec = head is
+ other ->
+ ( srcLocSpan (nameSrcLoc name), unused_msg )
unused_msg = text "Defined but not used"
imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
unused_msg = text "Defined but not used"
imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
- = sep [text flavour <+> ptext SLIT("not in scope:"), quotes (ppr name)]
+ = sep [ptext SLIT("Not in scope:"),
+ if isVarOcc occ_name then quotes (ppr name)
+ else text (occNameFlavour occ_name)
+ <+> quotes (ppr name)]
unknownInstBndrErr cls op
= quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
unknownInstBndrErr cls op
= quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
= ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
-- The rdrNameOcc is because we don't want to print Prelude.(,)
= ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
-- The rdrNameOcc is because we don't want to print Prelude.(,)
-warnDeprec :: GlobalRdrElt -> RnM ()
-warnDeprec (GRE {gre_name = name, gre_deprec = Just txt})
- = ifOptM Opt_WarnDeprecations $
- addWarn (sep [ text (occNameFlavour (nameOccName name)) <+>
- quotes (ppr name) <+> text "is deprecated:",
- nest 4 (ppr txt) ])