Merge branch 'master' into type-nats
[ghc.git] / compiler / main / Finder.lhs
index cc19e31..5b1bae4 100644 (file)
@@ -26,24 +26,28 @@ module Finder (
 
   ) where
 
+#include "HsVersions.h"
+
 import Module
 import HscTypes
 import Packages
 import FastString
 import Util
 import PrelNames        ( gHC_PRIM )
-import DynFlags                ( DynFlags(..), isOneShot, GhcMode(..) )
+import DynFlags
 import Outputable
-import FiniteMap
-import LazyUniqFM
+import UniqFM
 import Maybes          ( expectJust )
+import Exception        ( evaluate )
 
+import Distribution.Text
 import Distribution.Package hiding (PackageId)
-import Data.IORef      ( IORef, writeIORef, readIORef, modifyIORef )
+import Data.IORef      ( IORef, writeIORef, readIORef, atomicModifyIORef )
 import System.Directory
 import System.FilePath
 import Control.Monad
 import System.Time     ( ClockTime )
+import Data.List        ( partition )
 
 
 type FileExt = String  -- Filename extension
@@ -66,6 +70,7 @@ type BaseName = String        -- Basename of file
 -- assumed to not move around during a session.
 flushFinderCaches :: HscEnv -> IO ()
 flushFinderCaches hsc_env = do
+  -- Ideally the update to both caches be a single atomic operation.
   writeIORef fc_ref emptyUFM
   flushModLocationCache this_pkg mlc_ref
  where
@@ -75,23 +80,27 @@ flushFinderCaches hsc_env = do
 
 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
 flushModLocationCache this_pkg ref = do
-  fm <- readIORef ref
-  writeIORef ref $! filterFM is_ext fm
+  atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
+  _ <- evaluate =<< readIORef ref
   return ()
   where is_ext mod _ | modulePackageId mod /= this_pkg = True
                     | otherwise = False
 
 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
-addToFinderCache       ref key val = modifyIORef ref $ \c -> addToUFM c key val
+addToFinderCache ref key val =
+  atomicModifyIORef ref $ \c -> (addToUFM c key val, ())
 
 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
-addToModLocationCache  ref key val = modifyIORef ref $ \c -> addToFM c key val
+addToModLocationCache ref key val =
+  atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
 
 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
-removeFromFinderCache      ref key = modifyIORef ref $ \c -> delFromUFM c key
+removeFromFinderCache ref key =
+  atomicModifyIORef ref $ \c -> (delFromUFM c key, ())
 
 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
-removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
+removeFromModLocationCache ref key =
+  atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
 
 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
 lookupFinderCache ref key = do 
@@ -102,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
@@ -125,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
@@ -145,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
 
 
@@ -177,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 = mkPackageId (package pkg_conf) in      
-          findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
-  | otherwise
-        = return (FoundMultiple (map (mkPackageId.package.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 = [ mkPackageId (package pkg_conf)
-                      | (pkg_conf,False) <- found ]
-
-        pkg_hiddens = [ mkPackageId (package 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 = mod_hiddens, fr_mods_hidden = pkg_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
@@ -356,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 
@@ -547,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
 
@@ -596,11 +618,40 @@ 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)
+        ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkg)
+        <> dot $$ cabal_pkg_hidden_hint pkg
+    cabal_pkg_hidden_hint pkg
+     | dopt Opt_BuildingCabalPackage dflags
+        = case simpleParse (packageIdString pkg) of
+          Just pid ->
+              ptext (sLit "Perhaps you need to add") <+>
+              quotes (text (display (pkgName pid))) <+>
+              ptext (sLit "to the build-depends in your .cabal file.")
+          Nothing -> empty
+     | otherwise = empty
 
     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}