import CmdLineOpts ( DynFlag(..) )
import HsSyn ( HsDecl(..), IE(..), ieName, ImportDecl(..),
- ForeignDecl(..),
+ ForeignDecl(..), HsGroup(..),
collectLocatedHsBinders, tyClDeclNames
)
import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, RdrNameHsDecl )
moduleNameUserString,
unitModuleEnvByName, lookupModuleEnvByName,
moduleEnvElts )
-import Name ( Name, nameSrcLoc, nameOccName, nameModule )
+import Name ( Name, nameSrcLoc, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
import OccName ( OccName, dataName, isTcOcc )
Deprecations(..), ModIface(..),
GlobalRdrElt(..), unQualInScope, isLocalGRE
)
-import RdrName ( rdrNameOcc, setRdrNameSpace, emptyRdrEnv, foldRdrEnv, isQual )
-import SrcLoc ( noSrcLoc )
+import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
+ emptyRdrEnv, foldRdrEnv, isQual )
import Outputable
import Maybes ( maybeToBool, catMaybes )
import ListSetOps ( removeDups )
-- If there's an error in loadInterface, (e.g. interface
-- file not found) we get lots of spurious errors from 'filterImports'
- recoverM (returnM Nothing)
- (loadInterface doc imp_mod_name (ImportByUser is_boot) `thenM` \ iface ->
- returnM (Just iface)) `thenM` \ mb_iface ->
+ tryM (loadInterface doc imp_mod_name (ImportByUser is_boot)) `thenM` \ mb_iface ->
case mb_iface of {
- Nothing -> returnM (emptyRdrEnv, emptyImportAvails ) ;
- Just iface ->
+ Left exn -> returnM (emptyRdrEnv, emptyImportAvails ) ;
+ Right iface ->
let
imp_mod = mi_module iface
Complain about duplicate bindings
\begin{code}
-importsFromLocalDecls :: [RdrNameHsDecl]
+importsFromLocalDecls :: HsGroup RdrName
-> TcRn m (GlobalRdrEnv, ImportAvails)
-importsFromLocalDecls decls
- = getModule `thenM` \ this_mod ->
- mappM (getLocalDeclBinders this_mod) decls `thenM` \ avails_s ->
+importsFromLocalDecls group
+ = getModule `thenM` \ this_mod ->
+ getLocalDeclBinders this_mod group `thenM` \ avails ->
-- The avails that are returned don't include the "system" names
let
- avails = concat avails_s
-
all_names :: [Name] -- All the defns; no dups eliminated
all_names = [name | avail <- avails, name <- availNames avail]
*** See "THE NAMING STORY" in HsDecls ****
\begin{code}
-getLocalDeclBinders :: Module -> RdrNameHsDecl -> TcRn m [AvailInfo]
-getLocalDeclBinders mod (TyClD tycl_decl)
+getLocalDeclBinders :: Module -> HsGroup RdrName -> TcRn m [AvailInfo]
+getLocalDeclBinders mod (HsGroup {hs_valds = val_decls,
+ hs_tyclds = tycl_decls,
+ hs_fords = foreign_decls })
= -- For type and class decls, we generate Global names, with
-- no export indicator. They need to be global because they get
-- permanently bound into the TyCons and Classes. They don't need
-- an export indicator because they are all implicitly exported.
- mapM new (tyClDeclNames tycl_decl) `thenM` \ names@(main_name:_) ->
- returnM [AvailTC main_name names]
- where
- new (nm,loc) = newTopBinder mod nm loc
-getLocalDeclBinders mod (ValD binds)
- = mappM new (collectLocatedHsBinders binds) `thenM` \ avails ->
- returnM avails
+ mappM new_tc tycl_decls `thenM` \ tc_avails ->
+ mappM new_bndr (for_hs_bndrs ++ val_hs_bndrs) `thenM` \ simple_bndrs ->
+
+ returnM (tc_avails ++ map Avail simple_bndrs)
where
- new (rdr_name, loc) = newTopBinder mod rdr_name loc `thenM` \ name ->
- returnM (Avail name)
-
-getLocalDeclBinders mod (ForD (ForeignImport nm _ _ _ loc))
- = newTopBinder mod nm loc `thenM` \ name ->
- returnM [Avail name]
-getLocalDeclBinders mod (ForD _)
- = returnM []
-
-getLocalDeclBinders mod (FixD _) = returnM []
-getLocalDeclBinders mod (DeprecD _) = returnM []
-getLocalDeclBinders mod (DefD _) = returnM []
-getLocalDeclBinders mod (InstD _) = returnM []
-getLocalDeclBinders mod (RuleD _) = returnM []
+ new_bndr (rdr_name,loc) = newTopBinder mod rdr_name loc
+
+ val_hs_bndrs = collectLocatedHsBinders val_decls
+ for_hs_bndrs = [(nm,loc) | ForeignImport nm _ _ _ loc <- foreign_decls]
+
+ new_tc tc_decl = mappM new_bndr (tyClDeclNames tc_decl) `thenM` \ names@(main_name:_) ->
+ returnM (AvailTC main_name names)
\end{code}
(defined_and_used, defined_but_not_used) = partition used defined_names
used gre = gre_name gre `elemNameSet` really_used_names
- -- Filter out the ones only defined implicitly
+ -- Filter out the ones that are
+ -- (a) defined in this module, and
+ -- (b) not defined by a 'deriving' clause
+ -- The latter have an Internal Name, so we can filter them out easily
bad_locals :: [GlobalRdrElt]
- bad_locals = filter isLocalGRE defined_but_not_used
+ bad_locals = filter is_bad defined_but_not_used
+
+ is_bad :: GlobalRdrElt -> Bool
+ is_bad gre = isLocalGRE gre && isExternalName (gre_name gre)
bad_imports :: [GlobalRdrElt]
bad_imports = filter bad_imp defined_but_not_used