X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FFinder.lhs;h=d8a627167c2e3935451b96a113951d8a1b0a9753;hb=3deca8f44135bd1a146902f498189af00dd4d7b4;hp=17299fb194492508603eaf7bb6129bbbb271752c;hpb=f391c6e6b04055eac8bc878af31042e103387530;p=ghc-hetmet.git

diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs
index 17299fb..d8a6271 100644
--- a/compiler/main/Finder.lhs
+++ b/compiler/main/Finder.lhs
@@ -26,6 +26,8 @@ module Finder (
 
   ) where
 
+#include "HsVersions.h"
+
 import Module
 import HscTypes
 import Packages
@@ -34,8 +36,7 @@ import Util
 import PrelNames        ( gHC_PRIM )
 import DynFlags
 import Outputable
-import FiniteMap
-import LazyUniqFM
+import UniqFM
 import Maybes		( expectJust )
 import Exception        ( evaluate )
 
@@ -46,6 +47,7 @@ import System.Directory
 import System.FilePath
 import Control.Monad
 import System.Time	( ClockTime )
+import Data.List        ( partition )
 
 
 type FileExt = String	-- Filename extension
@@ -78,7 +80,7 @@ flushFinderCaches hsc_env = do
 
 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
 flushModLocationCache this_pkg ref = do
-  atomicModifyIORef ref $ \fm -> (filterFM is_ext fm, ())
+  atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
   _ <- evaluate =<< readIORef ref
   return ()
   where is_ext mod _ | modulePackageId mod /= this_pkg = True
@@ -90,7 +92,7 @@ addToFinderCache ref key val =
 
 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
 addToModLocationCache ref key val =
-  atomicModifyIORef ref $ \c -> (addToFM c key val, ())
+  atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
 
 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
 removeFromFinderCache ref key =
@@ -98,7 +100,7 @@ removeFromFinderCache ref key =
 
 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
 removeFromModLocationCache ref key =
-  atomicModifyIORef ref $ \c -> (delFromFM c key, ())
+  atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
 
 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
 lookupFinderCache ref key = do 
@@ -109,7 +111,7 @@ lookupModLocationCache :: IORef ModLocationCache -> Module
                        -> IO (Maybe ModLocation)
 lookupModLocationCache ref key = do
    c <- readIORef ref
-   return $! lookupFM c key
+   return $! lookupModuleEnv c key
 
 -- -----------------------------------------------------------------------------
 -- The two external entry points
@@ -132,7 +134,7 @@ findImportedModule hsc_env mod_name mb_pkg =
     pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
 
     unqual_import = home_import 
-			`orIfNotFound`
+                        `orIfNotFound`
 		      findExposedPackageModule hsc_env mod_name Nothing
 
 -- | Locate a specific 'Module'.  The purpose of this function is to
@@ -152,18 +154,21 @@ findExactModule hsc_env mod =
 -- Helpers
 
 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
-this `orIfNotFound` or_this = do
+orIfNotFound this or_this = do
   res <- this
   case res of
-    NotFound places1 _mb_pkg1 mod_hiddens1 pkg_hiddens1 -> do
-	res2 <- or_this
-	case res2 of
-	   NotFound places2 mb_pkg2 mod_hiddens2 pkg_hiddens2 -> 
-              return (NotFound (places1 ++ places2)
-                               mb_pkg2 -- snd arg is the package search
-                               (mod_hiddens1 ++ mod_hiddens2)
-                               (pkg_hiddens1 ++ pkg_hiddens2))
-	   _other -> return res2
+    NotFound { fr_paths = paths1, fr_mods_hidden = mh1
+             , fr_pkgs_hidden = ph1, fr_suggestions = s1 }
+     -> do res2 <- or_this
+           case res2 of
+             NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
+                      , fr_pkgs_hidden = ph2, fr_suggestions = s2 }
+              -> return (NotFound { fr_paths = paths1 ++ paths2
+                                  , fr_pkg = mb_pkg2 -- snd arg is the package search
+                                  , fr_mods_hidden = mh1 ++ mh2
+                                  , fr_pkgs_hidden = ph1 ++ ph2
+                                  , fr_suggestions = s1  ++ s2 })
+             _other -> return res2
     _other -> return res
 
 
@@ -184,36 +189,38 @@ findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
                          -> IO FindResult
 findExposedPackageModule hsc_env mod_name mb_pkg
         -- not found in any package:
-  | null found_exposed = return (NotFound [] Nothing mod_hiddens pkg_hiddens)
-        -- found in just one exposed package:
-  | [(pkg_conf, _)] <- found_exposed
-        = let pkgid = packageConfigId pkg_conf in
-          findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
-  | otherwise
-        = return (FoundMultiple (map (packageConfigId.fst) found_exposed))
-  where
-	dflags = hsc_dflags hsc_env
-        found = lookupModuleInAllPackages dflags mod_name
-
-        for_this_pkg = filter ((`matches` mb_pkg) . fst) found
-
-        found_exposed = [ (pkg_conf,exposed_mod) 
-                        | x@(pkg_conf,exposed_mod) <- for_this_pkg,
-                          is_exposed x ]
-
-        is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
-
-        mod_hiddens = [ packageConfigId pkg_conf
-                      | (pkg_conf,False) <- found ]
-
-        pkg_hiddens = [ packageConfigId pkg_conf
-                      | (pkg_conf,_) <- found, not (exposed pkg_conf) ]
-
-        _pkg_conf `matches` Nothing  = True
-        pkg_conf  `matches` Just pkg =
-           case packageName pkg_conf of 
-              PackageName n -> pkg == mkFastString n
-
+  = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name of
+       Left suggest -> return (NotFound { fr_paths = [], fr_pkg = Nothing
+                                        , fr_pkgs_hidden = [], fr_mods_hidden = []
+                                        , fr_suggestions = suggest })
+       Right found
+         | null found_exposed   -- Found, but with no exposed copies
+          -> return (NotFound { fr_paths = [], fr_pkg = Nothing
+                              , fr_pkgs_hidden = pkg_hiddens, fr_mods_hidden = mod_hiddens
+                              , fr_suggestions = [] })
+
+         | [(pkg_conf,_)] <- found_exposed     -- Found uniquely
+         -> let pkgid = packageConfigId pkg_conf in
+            findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
+
+         | otherwise           -- Found in more than one place
+         -> return (FoundMultiple (map (packageConfigId.fst) found_exposed))
+         where
+           for_this_pkg  = case mb_pkg of
+                             Nothing -> found
+                             Just p  -> filter ((`matches` p) . fst) found
+           found_exposed = filter is_exposed for_this_pkg
+           is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
+
+           mod_hiddens = [ packageConfigId pkg_conf
+                         | (pkg_conf,False) <- found ]
+
+           pkg_hiddens = [ packageConfigId pkg_conf
+                         | (pkg_conf,_) <- found, not (exposed pkg_conf) ]
+
+           pkg_conf  `matches` 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
@@ -363,8 +370,11 @@ searchPathExts paths mod exts
 	              file = base <.> ext
 		]
 
-    search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod))
-                        [] [])
+    search [] = return (NotFound { fr_paths = map fst to_search
+                                 , fr_pkg   = Just (modulePackageId mod)
+                                 , fr_mods_hidden = [], fr_pkgs_hidden = []
+                                 , fr_suggestions = [] })
+
     search ((file, mk_result) : rest) = do
       b <- doesFileExist file
       if b 
@@ -554,31 +564,36 @@ cantFindErr _ multiple_found _ mod_name (FoundMultiple pkgs)
 		hsep (map (text.packageIdString) pkgs)]
     )
 cantFindErr cannot_find _ dflags mod_name find_result
-  = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
-       2 more_info
+  = ptext cannot_find <+> quotes (ppr mod_name)
+    $$ more_info
   where
+    pkg_map :: PackageConfigMap
+    pkg_map = pkgIdMap (pkgState dflags)
+
     more_info
       = case find_result of
 	    NoPackage pkg
 		-> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+>
 		   ptext (sLit "was found")
 
-	    NotFound files mb_pkg mod_hiddens pkg_hiddens
+            NotFound { fr_paths = files, fr_pkg = mb_pkg
+                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
+                     , fr_suggestions = suggest }
 		| Just pkg <- mb_pkg, pkg /= thisPackage dflags
 		-> not_found_in_package pkg files
 
+                | not (null suggest)
+                -> pp_suggestions suggest $$ tried_these files
+
                 | null files && null mod_hiddens && null pkg_hiddens
-		-> 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.")
 
 		| otherwise
 		-> vcat (map pkg_hidden pkg_hiddens) $$
-                   vcat (map mod_hidden mod_hiddens) $$ 
+                   vcat (map mod_hidden mod_hiddens) $$
                    tried_these files
 
-	    NotFoundInPackage pkg
-		-> ptext (sLit "it is not in package") <+> quotes (ppr pkg)
-
-	    _ -> panic "cantFindErr"
+            _ -> panic "cantFindErr"
 
     build_tag = buildTag dflags
 
@@ -603,7 +618,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
         | verbosity dflags < 3 =
    	      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)
         
     pkg_hidden pkg =
         ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkg)
@@ -620,4 +635,23 @@ cantFindErr cannot_find _ dflags mod_name find_result
 
     mod_hidden pkg =
         ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
+
+    pp_suggestions :: [Module] -> SDoc
+    pp_suggestions sugs
+      | null sugs = empty
+      | otherwise = hang (ptext (sLit "Perhaps you meant"))
+                       2 (vcat [ vcat (map pp_exp exposed_sugs)
+                               , vcat (map pp_hid hidden_sugs) ])
+      where
+        (exposed_sugs, hidden_sugs) = partition from_exposed_pkg sugs
+
+    from_exposed_pkg m = case lookupPackage pkg_map (modulePackageId m) of
+                            Just pkg_config -> exposed pkg_config
+                            Nothing         -> WARN( True, ppr m ) -- Should not happen
+                                               False
+
+    pp_exp mod = ppr (moduleName mod)
+                 <+> parens (ptext (sLit "from") <+> ppr (modulePackageId mod))
+    pp_hid mod = ppr (moduleName mod)
+                 <+> parens (ptext (sLit "needs flag -package") <+> ppr (modulePackageId mod))
 \end{code}