Trim redundant import
[ghc-hetmet.git] / compiler / main / Finder.lhs
index b76bd97..4c6ae29 100644 (file)
@@ -25,8 +25,6 @@ module Finder (
 
   ) where
 
-#include "HsVersions.h"
-
 import Module
 import HscTypes
 import Packages
@@ -39,6 +37,7 @@ import FiniteMap
 import LazyUniqFM
 import Maybes          ( expectJust )
 
+import Distribution.Package hiding (PackageId)
 import Data.IORef      ( IORef, writeIORef, readIORef, modifyIORef )
 import Data.List
 import System.Directory
@@ -115,27 +114,20 @@ lookupModLocationCache ref key = do
 -- 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 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.
+    pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
 
-    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
@@ -178,8 +170,9 @@ homeSearchCache hsc_env mod_name do_this = do
           _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:
@@ -197,9 +190,19 @@ findExposedPackageModule hsc_env mod_name
   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
@@ -492,13 +495,13 @@ mkStubPaths dflags mod location
         stub_basename = stub_basename0 ++ "_stub"
 
         -- this is the filename we're going to use when
-        -- #including the stub_h file from the .hc file.
+        -- \#including the stub_h file from the .hc file.
         -- Without -stubdir, we just #include the basename
         -- (eg. for a module A.B, we #include "B_stub.h"),
         -- relying on the fact that we add an implicit -I flag
         -- for the directory in which the source file resides
         -- (see DriverPipeline.hs).  With -stubdir, we
-        -- #include "A/B.h", assuming that the user has added
+        -- \#include "A/B.h", assuming that the user has added
         -- -I<dir> along with -stubdir <dir>.
         include_basename
                 | Just _ <- stubdir = mod_basename 
@@ -535,15 +538,15 @@ findObjectLinkable mod obj_fn obj_time = do
 -- Error messages
 
 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
-cannotFindModule = cantFindErr SLIT("Could not find module")
+cannotFindModule = cantFindErr (sLit "Could not find module")
 
 cannotFindInterface  :: DynFlags -> ModuleName -> FindResult -> SDoc
-cannotFindInterface = cantFindErr SLIT("Failed to load interface for")
+cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
 
 cantFindErr :: LitString -> DynFlags -> ModuleName -> FindResult -> SDoc
 cantFindErr cannot_find _dflags mod_name (FoundMultiple pkgs)
   = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
-       sep [ptext SLIT("it was found in multiple packages:"),
+       sep [ptext (sLit "it was found in multiple packages:"),
                hsep (map (text.packageIdString) pkgs)]
     )
 cantFindErr cannot_find dflags mod_name find_result
@@ -553,34 +556,34 @@ cantFindErr cannot_find dflags mod_name find_result
     more_info
       = case find_result of
            PackageHidden pkg 
-               -> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
-                  <+> ptext SLIT("which is hidden")
+               -> ptext (sLit "it is a member of package") <+> ppr pkg <> comma
+                  <+> ptext (sLit "which is hidden")
 
            ModuleHidden pkg
-               -> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
+               -> ptext (sLit "it is hidden") <+> parens (ptext (sLit "in package")
                   <+> ppr pkg)
 
            NoPackage pkg
-               -> ptext SLIT("no package matching") <+> ppr pkg <+>
-                  ptext SLIT("was found")
+               -> ptext (sLit "no package matching") <+> ppr pkg <+>
+                  ptext (sLit "was found")
 
            NotFound files mb_pkg
                | null files
-               -> ptext SLIT("it is not a module in the current program, or in any known package.")
+               -> ptext (sLit "it is not a module in the current program, or in any known package.")
                | Just pkg <- mb_pkg, pkg /= thisPackage dflags, build_tag /= ""
                -> let 
                     build = if build_tag == "p" then "profiling" 
                                                 else "\"" ++ build_tag ++ "\""
                   in
-                  ptext SLIT("Perhaps you haven't installed the ") <> text build <>
-                  ptext SLIT(" libraries for package ") <> ppr pkg <> char '?' $$
+                  ptext (sLit "Perhaps you haven't installed the ") <> text build <>
+                  ptext (sLit " libraries for package ") <> ppr pkg <> char '?' $$
                   not_found files
 
                | otherwise
                -> not_found files
 
            NotFoundInPackage pkg
-               -> ptext SLIT("it is not in package") <+> ppr pkg
+               -> ptext (sLit "it is not in package") <+> ppr pkg
 
            _ -> panic "cantFindErr"
 
@@ -588,7 +591,7 @@ cantFindErr cannot_find dflags mod_name find_result
 
     not_found files
        | verbosity dflags < 3
-       = ptext SLIT("Use -v to see a list of the files searched for.")
+       = ptext (sLit "Use -v to see a list of the files searched for.")
        | otherwise 
-       = hang (ptext SLIT("locations searched:")) 2 (vcat (map text files))
+       = hang (ptext (sLit "locations searched:")) 2 (vcat (map text files))
 \end{code}