data ImportDecl name
= ImportDecl (Located ModuleName) -- module name
+ (Maybe FastString) -- package qualifier
Bool -- True <=> {-# SOURCE #-} import
Bool -- True => qualified
(Maybe ModuleName) -- as Module
\begin{code}
instance (Outputable name) => Outputable (ImportDecl name) where
- ppr (ImportDecl mod from qual as spec)
+ ppr (ImportDecl mod pkg from qual as spec)
= hang (hsep [ptext (sLit "import"), ppr_imp from,
- pp_qual qual, ppr mod, pp_as as])
+ pp_qual qual, pp_pkg pkg, ppr mod, pp_as as])
4 (pp_spec spec)
where
+ pp_pkg Nothing = empty
+ pp_pkg (Just p) = doubleQuotes (ftext p)
+
pp_qual False = empty
pp_qual True = ptext (sLit "qualified")
= ptext (sLit "hiding") <+> parens (interpp'SP spec)
ideclName :: ImportDecl name -> Located ModuleName
-ideclName (ImportDecl mod_nm _ _ _ _) = mod_nm
+ideclName (ImportDecl mod_nm _ _ _ _ _) = mod_nm
\end{code}
%************************************************************************
\begin{code}
-- | Load the interface corresponding to an @import@ directive in
-- source code. On a failure, fail in the monad with an error message.
-loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
-loadSrcInterface doc mod want_boot = do
+loadSrcInterface :: SDoc
+ -> ModuleName
+ -> IsBootInterface -- {-# SOURCE #-} ?
+ -> Maybe FastString -- "package", if any
+ -> RnM ModIface
+
+loadSrcInterface doc mod want_boot maybe_pkg = do
-- We must first find which Module this import refers to. This involves
-- calling the Finder, which as a side effect will search the filesystem
-- and create a ModLocation. If successful, loadIface will read the
-- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search.
hsc_env <- getTopEnv
- res <- liftIO $ findImportedModule hsc_env mod Nothing
+ res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
case res of
Found _ mod -> do
mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
| Opt_RankNTypes
| Opt_ImpredicativeTypes
| Opt_TypeOperators
+ | Opt_PackageImports
| Opt_PrintExplicitForalls
( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, const Supported ),
( "OverlappingInstances", Opt_OverlappingInstances, const Supported ),
( "UndecidableInstances", Opt_UndecidableInstances, const Supported ),
- ( "IncoherentInstances", Opt_IncoherentInstances, const Supported )
+ ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ),
+ ( "PackageImports", Opt_PackageImports, const Supported )
]
impliedFlags :: [(DynFlag, [DynFlag])]
import LazyUniqFM
import Maybes ( expectJust )
+import Distribution.Package
import Data.IORef ( IORef, writeIORef, readIORef, modifyIORef )
import Data.List
import System.Directory
-- packages to find the module, if a package is specified then only
-- that package is searched for the module.
-findImportedModule :: HscEnv -> ModuleName -> Maybe PackageId -> IO FindResult
-findImportedModule hsc_env mod_name mb_pkgid =
- case mb_pkgid of
- Nothing -> unqual_import
- Just pkg | pkg == this_pkg -> home_import
- | otherwise -> pkg_import pkg
+findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
+findImportedModule hsc_env mod_name mb_pkg =
+ case mb_pkg of
+ Nothing -> unqual_import
+ Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
+ | otherwise -> pkg_import
where
- dflags = hsc_dflags hsc_env
- this_pkg = thisPackage dflags
+ home_import = findHomeModule hsc_env mod_name
- home_import = findHomeModule hsc_env mod_name
+ pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
- pkg_import pkg = findPackageModule hsc_env (mkModule pkg mod_name)
- -- ToDo: this isn't quite right, the module we want
- -- might actually be in another package, but re-exposed
- -- ToDo: should return NotFoundInPackage if
- -- the module isn't exposed by the package.
-
- unqual_import = home_import
+ unqual_import = home_import
`orIfNotFound`
- findExposedPackageModule hsc_env mod_name
+ findExposedPackageModule hsc_env mod_name Nothing
-- | Locate a specific 'Module'. The purpose of this function is to
-- create a 'ModLocation' for a given 'Module', that is to find out
_other -> return ()
return result
-findExposedPackageModule :: HscEnv -> ModuleName -> IO FindResult
-findExposedPackageModule hsc_env mod_name
+findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
+ -> IO FindResult
+findExposedPackageModule hsc_env mod_name mb_pkg
-- not found in any package:
| null found = return (NotFound [] Nothing)
-- found in just one exposed package:
where
dflags = hsc_dflags hsc_env
found = lookupModuleInAllPackages dflags mod_name
- found_exposed = filter is_exposed found
+
+ found_exposed = [ (pkg_conf,exposed_mod)
+ | x@(pkg_conf,exposed_mod) <- found,
+ is_exposed x,
+ pkg_conf `matches` mb_pkg ]
+
is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
+ _pkg_conf `matches` Nothing = True
+ pkg_conf `matches` Just pkg =
+ case packageName pkg_conf of
+ PackageName n -> pkg == mkFastString n
+
modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
modLocationCache hsc_env mod do_this = do
-- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
-- filesystem and package database to find the corresponding 'Module',
-- using the algorithm that is used for an @import@ declaration.
-findModule :: Session -> ModuleName -> Maybe PackageId -> IO Module
+findModule :: Session -> ModuleName -> Maybe FastString -> IO Module
findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
let
dflags = hsc_dflags hsc_env
let
main_loc = mkSrcLoc (mkFastString source_filename) 1 0
mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
- (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
- source_imps = map getImpMod src_idecls
+ imps' = filter isHomeImp (map unLoc imps)
+ (src_idecls, ord_idecls) = partition isSourceIdecl imps'
+ source_imps = map getImpMod src_idecls
ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc)
(map getImpMod ord_idecls)
-- GHC.Prim doesn't exist physically, so don't go looking for it.
parseError :: SrcSpan -> Message -> a
parseError span err = throwErrMsg $ mkPlainErrMsg span err
+-- we aren't interested in package imports here, filter them out
+isHomeImp :: ImportDecl name -> Bool
+isHomeImp (ImportDecl _ (Just p) _ _ _ _) = p == fsLit "this"
+isHomeImp (ImportDecl _ Nothing _ _ _ _) = True
+
isSourceIdecl :: ImportDecl name -> Bool
-isSourceIdecl (ImportDecl _ s _ _ _) = s
+isSourceIdecl (ImportDecl _ _ s _ _ _) = s
getImpMod :: ImportDecl name -> Located ModuleName
-getImpMod (ImportDecl located_mod _ _ _ _) = located_mod
+getImpMod (ImportDecl located_mod _ _ _ _ _) = located_mod
--------------------------------------------------------------
-- Get options
sig_info (InlineSig _ _) = (0,0,0,1)
sig_info _ = (0,0,0,0)
- import_info (L _ (ImportDecl _ _ qual as spec))
+ import_info (L _ (ImportDecl _ _ _ qual as spec))
= add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec)
qual_info False = 0
qual_info True = 1
-> IO (Maybe (PackageIdentifier, PackageId))
findWiredInPackage pkgs wired_pkg =
let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] in
- case filter exposed all_ps of
- [] -> case all_ps of
- [] -> notfound
- many -> pick (head (sortByVersion many))
- many -> pick (head (sortByVersion many))
+ case all_ps of
+ [] -> notfound
+ many -> pick (head (sortByVersion many))
where
suffixes = snd wired_pkg
notfound = do
let
wired_in_ids = catMaybes mb_wired_in_ids
- deleteOtherWiredInPackages pkgs = filterOut bad pkgs
- where bad p = any (p `matches`) wired_in_pkgids
- && package p `notElem` map fst wired_in_ids
+ -- this is old: we used to assume that if there were
+ -- multiple versions of wired-in packages installed that
+ -- they were mutually exclusive. Now we're assuming that
+ -- you have one "main" version of each wired-in package
+ -- (the latest version), and the others are backward-compat
+ -- wrappers that depend on this one. e.g. base-4.0 is the
+ -- latest, base-3.0 is a compat wrapper depending on base-4.0.
+ {-
+ deleteOtherWiredInPackages pkgs = filterOut bad pkgs
+ where bad p = any (p `matches`) wired_in_pkgids
+ && package p `notElem` map fst wired_in_ids
+ -}
updateWiredInDependencies pkgs = map upd_pkg pkgs
where upd_pkg p = p{ package = upd_pid (package p),
((x, y):_) -> x{ pkgName = PackageName (packageIdString y),
pkgVersion = Version [] [] }
- pkgs1 = deleteOtherWiredInPackages pkgs
+ -- pkgs1 = deleteOtherWiredInPackages pkgs
- pkgs2 = updateWiredInDependencies pkgs1
+ pkgs2 = updateWiredInDependencies pkgs
preload1 = map upd_pid preload
| {- empty -} { [] }
importdecl :: { LImportDecl RdrName }
- : 'import' maybe_src optqualified modid maybeas maybeimpspec
- { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
+ : 'import' maybe_src optqualified maybe_pkg modid maybeas maybeimpspec
+ { L (comb4 $1 $5 $6 $7) (ImportDecl $5 $4 $2 $3 (unLoc $6) (unLoc $7)) }
maybe_src :: { IsBootInterface }
: '{-# SOURCE' '#-}' { True }
| {- empty -} { False }
+maybe_pkg :: { Maybe FastString }
+ : STRING { Just (getSTRING $1) }
+ | {- empty -} { Nothing }
+
optqualified :: { Bool }
: 'qualified' { True }
| {- empty -} { False }
| Just (mod,occ) <- isQual_maybe rdr_name
-- Note: we want to behave as we would for a source file import here,
-- and respect hiddenness of modules/packages, hence loadSrcInterface.
- = loadSrcInterface doc mod False `thenM` \ iface ->
+ = loadSrcInterface doc mod False Nothing `thenM` \ iface ->
case [ (mod,occ) |
(mod,avails) <- mi_exports iface,
implicit_prelude <- doptM Opt_ImplicitPrelude
let prel_imports = mkPrelImports this_mod implicit_prelude imports
(source, ordinary) = partition is_source_import imports
- is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
+ is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
ifOptM Opt_WarnImplicitPrelude (
when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
| otherwise = [preludeImportDecl]
where
explicit_prelude_import
- = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- import_decls,
+ = notNull [ () | L _ (ImportDecl mod Nothing _ _ _ _) <- import_decls,
unLoc mod == pRELUDE_NAME ]
preludeImportDecl :: LImportDecl RdrName
preludeImportDecl
= L loc $
ImportDecl (L loc pRELUDE_NAME)
+ Nothing {- no specific package -}
False {- Not a boot interface -}
False {- Not qualified -}
Nothing {- No "as" -}
-> LImportDecl RdrName
-> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
-rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
+rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
qual_only as_mod imp_details))
=
setSrcSpan loc $ do
+ when (isJust mb_pkg) $ do
+ pkg_imports <- doptM Opt_PackageImports
+ when (not pkg_imports) $ addErr packageImportErr
+
-- If there's an error in loadInterface, (e.g. interface
-- file not found) we get lots of spurious errors from 'filterImports'
let
imp_mod_name = unLoc loc_imp_mod_name
doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
- iface <- loadSrcInterface doc imp_mod_name want_boot
+ iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
-- Compiler sanity check: if the import didn't say
-- {-# SOURCE #-} we should not get a hi-boot file
_ -> return ()
)
- let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot
+ let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
qual_only as_mod new_imp_details)
return (new_imp_decl, gbl_env, imports, mi_hpc iface)
implicitPreludeWarn :: SDoc
implicitPreludeWarn
= ptext (sLit "Module `Prelude' implicitly imported")
+
+packageImportErr :: SDoc
+packageImportErr
+ = ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports")
\end{code}
<entry>dynamic</entry>
<entry><option>-XNoFunctionalDependencies</option></entry>
</row>
+ <row>
+ <entry><option>-XPackageImports</option></entry>
+ <entry>Enable <link linkend="package-imports">package-qualified imports</link>.</entry>
+ <entry>dynamic</entry>
+ <entry><option>-XNoPackageImports</option></entry>
+ </row>
</tbody>
</tgroup>
</informaltable>
</para>
</sect2>
+<sect2 id="package-imports">
+ <title>Package-qualified imports</title>
+
+ <para>With the <option>-XPackageImports</option> flag, GHC allows
+ import declarations to be qualified by the package name that the
+ module is intended to be imported from. For example:</para>
+
+<programlisting>
+import "network" Network.Socket
+</programlisting>
+
+ <para>would import the module <literal>Network.Socket</literal> from
+ the package <literal>network</literal> (any version). This may
+ be used to disambiguate an import when the same module is
+ available from multiple packages, or is present in both the
+ current package being built and an external package.</para>
+
+ <para>Note: you probably don't need to use this feature, it was
+ added mainly so that we can build backwards-compatible versions of
+ packages when APIs change. It can lead to fragile dependencies in
+ the common case: modules occasionally move from one package to
+ another, rendering any package-qualified imports broken.</para>
+</sect2>
</sect1>
projects / ghc-hetmet.git / commitdiff