X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=260ee075868a3b6b34b11295aba2e65a7bb8eb2d;hb=d8e8d85db6bf2b1fa0c0219f558507031dd59c26;hp=24936ec27eca8092e61f20eb0e45e3afbefc138c;hpb=162f1889be4817490f0cd3ebc6f3e051e44f0bc1;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
index 24936ec..260ee07 100644
--- a/ghc/compiler/main/Finder.lhs
+++ b/ghc/compiler/main/Finder.lhs
@@ -6,20 +6,16 @@
 \begin{code}
 module Finder (
     flushFinderCache,	-- :: IO ()
-
-    findModule,		-- :: ModuleName 
-			--   -> IO (Either [FilePath] (Module, ModLocation))
-
-    findPackageModule,  -- :: ModuleName
-			--   -> IO (Either [FilePath] (Module, ModLocation))
-
-    mkHomeModLocation,	-- :: ModuleName -> FilePath -> IO ModLocation
+    FindResult(..),
+    findModule,			-- :: ModuleName -> Bool -> IO FindResult
+    findPackageModule,  	-- :: ModuleName -> Bool -> IO FindResult
+    mkHomeModLocation,		-- :: ModuleName -> FilePath -> IO ModLocation
+    mkHomeModLocation2,		-- :: ModuleName -> FilePath -> String -> IO ModLocation
+    addHomeModuleToFinder, 	-- :: Module -> ModLocation -> IO ()
 
     findLinkable,	-- :: ModuleName -> ModLocation -> IO (Maybe Linkable)
 
-    hiBootExt,		-- :: String
-    hiBootVerExt,	-- :: String
-
+    cantFindError, 	-- :: DynFlags -> Module -> FindResult -> SDoc
   ) where
 
 #include "HsVersions.h"
@@ -27,52 +23,60 @@ module Finder (
 import Module
 import UniqFM		( filterUFM )
 import HscTypes		( Linkable(..), Unlinked(..) )
+import Packages
 import DriverState
 import DriverUtil
 import FastString
-import Config
 import Util
+import CmdLineOpts	( DynFlags(..) )
+import Outputable
 
 import DATA_IOREF	( IORef, writeIORef, readIORef )
 
-import List
-import Directory
-import IO
-import Monad
+import Data.List
+import System.Directory
+import System.IO
+import Control.Monad
+import Maybes		( MaybeErr(..) )
+import Data.Maybe	( isNothing )
+
+
+type FileExt = String	-- Filename extension
+type BaseName = String	-- Basename of file
 
 -- -----------------------------------------------------------------------------
 -- The Finder
 
--- The Finder provides a thin filesystem abstraction to the rest of the
--- compiler.  For a given module, it knows (a) whether the module lives
--- in the home package or in another package, so it can make a Module
--- from a ModuleName, and (b) where the source, interface, and object
--- files for a module live.
+-- The Finder provides a thin filesystem abstraction to the rest of
+-- the compiler.  For a given module, it can tell you where the
+-- source, interface, and object files for that module live.
 -- 
--- It does *not* know which particular package a module lives in, because
--- that information is only contained in the interface file.
+-- It does *not* know which particular package a module lives in.  Use
+-- Packages.moduleToPackageConfig for that.
 
 -- -----------------------------------------------------------------------------
 -- The finder's cache
 
-GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv (Module,ModLocation))
+GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv FinderCacheEntry)
+
+type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool))
 
 -- remove all the home modules from the cache; package modules are
 -- assumed to not move around during a session.
 flushFinderCache :: IO ()
 flushFinderCache = do
   fm <- readIORef finder_cache
-  writeIORef finder_cache (filterUFM (not . isHomeModule . fst) fm)
+  writeIORef finder_cache (filterUFM (\(loc,m) -> isNothing m) fm)
 
-addToFinderCache :: ModuleName -> (Module,ModLocation) -> IO ()
-addToFinderCache mod_name stuff = do
+addToFinderCache :: Module -> FinderCacheEntry -> IO ()
+addToFinderCache mod_name entry = do
   fm <- readIORef finder_cache
-  writeIORef finder_cache (extendModuleEnvByName fm mod_name stuff)
+  writeIORef finder_cache (extendModuleEnv fm mod_name entry)
 
-lookupFinderCache :: ModuleName -> IO (Maybe (Module,ModLocation))
+lookupFinderCache :: Module -> IO (Maybe FinderCacheEntry)
 lookupFinderCache mod_name = do
   fm <- readIORef finder_cache
-  return $! lookupModuleEnvByName fm mod_name
+  return $! lookupModuleEnv fm mod_name
 
 -- -----------------------------------------------------------------------------
 -- Locating modules
@@ -87,164 +91,203 @@ lookupFinderCache mod_name = do
 -- The ModLocation contains the names of all the files associated with
 -- that module: its source file, .hi file, object file, etc.
 
--- Returns: 
---	Right (Module, ModLocation)   if the module was found
---	Left [FilePath]		      if the module was not found, and here
---				 	is a list of all the places we looked
-findModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-findModule name = do
-  r <- lookupFinderCache name
-  case r of
-   Just result -> return (Right result)
-   Nothing -> do  
-       j <- maybeHomeModule name
-       case j of
-	 Right home_module -> return (Right home_module)
-	 Left home_files   -> do
-	    r <- findPackageMod name
-	    case r of
-		Right pkg_module -> return (Right pkg_module)
-		Left pkg_files   -> return (Left (home_files ++ pkg_files))
-
-findPackageModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-findPackageModule name = do
-  r <- lookupFinderCache name
-  case r of
-   Just result -> return (Right result)
-   Nothing     -> findPackageMod name
-
-hiBootExt = "hi-boot"
-hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion
-
-maybeHomeModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-maybeHomeModule mod_name = do
-   home_path <- readIORef v_Import_paths
+data FindResult
+  = Found ModLocation PackageIdH
+	-- the module was found
+  | PackageHidden PackageId
+	-- for an explicit source import: the package containing the module is
+	-- not exposed.
+  | ModuleHidden  PackageId
+	-- for an explicit source import: the package containing the module is
+	-- exposed, but the module itself is hidden.
+  | NotFound [FilePath]
+	-- the module was not found, the specified places were searched.
+
+type LocalFindResult = MaybeErr [FilePath] FinderCacheEntry
+	-- LocalFindResult is used for internal functions which 
+	-- return a more informative type; it's munged into
+	-- the external FindResult by 'cached'
+
+cached :: (DynFlags -> Module -> IO LocalFindResult)
+       -> DynFlags -> Module -> Bool -> IO FindResult
+cached wrapped_fn dflags name explicit 
+  = do	{ 	-- First try the cache
+	  mb_entry <- lookupFinderCache name
+	; case mb_entry of {
+	    Just old_entry -> return (found old_entry) ;
+	    Nothing    -> do
+
+	{ 	-- Now try the wrapped function
+	  mb_entry <- wrapped_fn dflags name
+	; case mb_entry of
+	    Failed paths  	-> return (NotFound paths)
+	    Succeeded new_entry -> do { addToFinderCache name new_entry
+			      	      ; return (found new_entry) }
+	}}} 
+  where
+	-- We've found the module, so the remaining question is
+	-- whether it's visible or not
+    found :: FinderCacheEntry -> FindResult
+    found (loc, Nothing)		= Found loc HomePackage
+    found (loc, Just (pkg, exposed_mod))
+	| explicit && not exposed_mod   = ModuleHidden pkg_name
+	| explicit && not (exposed pkg) = PackageHidden pkg_name
+	| otherwise			= Found loc (ExtPackage (mkPackageId (package pkg)))
+	where
+	  pkg_name = packageConfigId pkg
+
+addHomeModuleToFinder :: Module -> ModLocation -> IO ()
+addHomeModuleToFinder mod loc = addToFinderCache mod (loc, Nothing)
+
+
+-- -----------------------------------------------------------------------------
+-- 	The two external entry points
+
+
+findModule :: DynFlags -> Module -> Bool -> IO FindResult
+findModule = cached findModule' 
+  
+findPackageModule :: DynFlags -> Module -> Bool -> IO FindResult
+findPackageModule = cached findPackageModule'
+
+-- -----------------------------------------------------------------------------
+-- 	The internal workers
+
+findModule' :: DynFlags -> Module -> IO LocalFindResult
+-- Find home or package module
+findModule' dflags name = do
+    r <- findPackageModule' dflags name
+    case r of
+	Failed pkg_files -> do
+	   j <- findHomeModule' dflags name
+	   case j of
+		Failed home_files -> 
+			return (Failed (home_files ++ pkg_files))
+		other_result
+			-> return other_result
+	other_result
+		-> return other_result
+
+findHomeModule' :: DynFlags -> Module -> IO LocalFindResult
+findHomeModule' dflags mod = do
+   let home_path = importPaths dflags
    hisuf     <- readIORef v_Hi_suf
    mode      <- readIORef v_GhcMode
 
    let
      source_exts = 
-      [ ("hs",   mkHomeModLocationSearched mod_name)
-      , ("lhs",  mkHomeModLocationSearched mod_name)
+      [ ("hs",   mkHomeModLocationSearched mod "hs")
+      , ("lhs",  mkHomeModLocationSearched mod "lhs")
       ]
      
-     hi_exts = [ (hisuf,  mkHiOnlyModLocation hisuf mod_name) ]
+     hi_exts = [ (hisuf,  	 	mkHiOnlyModLocation hisuf)
+	       , (addBootSuffix hisuf,	mkHiOnlyModLocation hisuf)
+	       ]
      
-     boot_exts =
-       [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name)
-       , (hiBootExt,    mkHiOnlyModLocation hisuf mod_name)
-       ]
-
      	-- In compilation manager modes, we look for source files in the home
      	-- package because we can compile these automatically.  In one-shot
      	-- compilation mode we look for .hi and .hi-boot files only.
-     	--
-     	-- When generating dependencies, we're interested in either category.
-     	--
      exts
-         | mode == DoMkDependHS   = hi_exts ++ source_exts ++ boot_exts
+         | DoMkDependHS <- mode   = source_exts
          | isCompManagerMode mode = source_exts
-	 | otherwise {-one-shot-} = hi_exts ++ boot_exts
+	 | otherwise {-one-shot-} = hi_exts
 
-   searchPathExts home_path mod_name exts
+   searchPathExts home_path mod exts
    	
--- -----------------------------------------------------------------------------
--- Looking for a package module
-
-findPackageMod :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-findPackageMod mod_name = do
-  mode     <- readIORef v_GhcMode
-  imp_dirs <- getPackageImportPath -- including the 'auto' ones
-
-   -- hi-suffix for packages depends on the build tag.
-  package_hisuf <-
-	do tag <- readIORef v_Build_tag
-	   if null tag
-		then return "hi"
-		else return (tag ++ "_hi")
-
+findPackageModule' :: DynFlags -> Module -> IO LocalFindResult
+findPackageModule' dflags mod 
+  = case moduleToPackageConfig dflags mod of
+    	Nothing       -> return (Failed [])
+	Just pkg_info -> findPackageIface mod pkg_info
+
+findPackageIface :: Module -> (PackageConfig,Bool) -> IO LocalFindResult
+findPackageIface mod pkg_info@(pkg_conf, _) = do
+  mode <- readIORef v_GhcMode
+  tag  <- readIORef v_Build_tag
   let
+	   -- hi-suffix for packages depends on the build tag.
+     package_hisuf | null tag  = "hi"
+		   | otherwise = tag ++ "_hi"
      hi_exts =
-        [ (package_hisuf, mkPackageModLocation package_hisuf mod_name) ]
+        [ (package_hisuf, 
+	    mkPackageModLocation pkg_info package_hisuf) ]
 
      source_exts = 
-       [ ("hs",   mkPackageModLocation package_hisuf mod_name)
-       , ("lhs",  mkPackageModLocation package_hisuf mod_name)
+       [ ("hs",   mkPackageModLocation pkg_info package_hisuf)
+       , ("lhs",  mkPackageModLocation pkg_info package_hisuf)
        ]
-     
+
      -- mkdependHS needs to look for source files in packages too, so
      -- that we can make dependencies between package before they have
      -- been built.
      exts 
-      | mode == DoMkDependHS = hi_exts ++ source_exts
-      | otherwise = hi_exts
-
+      | DoMkDependHS <- mode = hi_exts ++ source_exts
+      | otherwise 	     = hi_exts
       -- we never look for a .hi-boot file in an external package;
       -- .hi-boot files only make sense for the home package.
-  searchPathExts imp_dirs mod_name exts
+
+  searchPathExts (importDirs pkg_conf) mod exts
 
 -- -----------------------------------------------------------------------------
 -- General path searching
 
 searchPathExts
   :: [FilePath]		-- paths to search
-  -> ModuleName		-- module name
+  -> Module		-- module name
   -> [ (
-	String,						-- suffix
-	String -> String -> String -> IO (Module, ModLocation)  -- action
+	FileExt,				     -- suffix
+	FilePath -> BaseName -> IO FinderCacheEntry  -- action
        )
      ] 
-  -> IO (Either [FilePath] (Module, ModLocation))
+  -> IO LocalFindResult
+
+searchPathExts paths mod exts 
+   = do result <- search to_search
+{-
+	hPutStrLn stderr (showSDoc $
+		vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
+		    , nest 2 (vcat (map text paths))
+		    , case result of
+			Succeeded (loc, p) -> text "Found" <+> ppr loc
+			Failed fs	   -> text "not found"])
+-}	
+	return result
 
-searchPathExts path mod_name exts = search to_search
   where
-    basename = dots_to_slashes (moduleNameUserString mod_name)
+    basename = dots_to_slashes (moduleUserString mod)
 
-    to_search :: [(FilePath, IO (Module,ModLocation))]
-    to_search = [ (file, fn p basename ext)
-		| p <- path, 
+    to_search :: [(FilePath, IO FinderCacheEntry)]
+    to_search = [ (file, fn path basename)
+		| path <- paths, 
 		  (ext,fn) <- exts,
-		  let base | p == "."  = basename
-	     	           | otherwise = p ++ '/':basename
+		  let base | path == "." = basename
+	     	           | otherwise   = path ++ '/':basename
 	              file = base ++ '.':ext
 		]
 
-    search [] = return (Left (map fst to_search))
-    search ((file, result) : rest) = do
+    search [] = return (Failed (map fst to_search))
+    search ((file, mk_result) : rest) = do
       b <- doesFileExist file
       if b 
-	then Right `liftM` result
+	then do { res <- mk_result; return (Succeeded res) }
 	else search rest
 
--- -----------------------------------------------------------------------------
--- Building ModLocations
+mkHomeModLocationSearched :: Module -> FileExt
+		          -> FilePath -> BaseName -> IO FinderCacheEntry
+mkHomeModLocationSearched mod suff path basename = do
+   loc <- mkHomeModLocation2 mod (path ++ '/':basename) suff
+   return (loc, Nothing)
 
-mkHiOnlyModLocation hisuf mod_name path basename _ext = do
-  -- basename == dots_to_slashes (moduleNameUserString mod_name)
+mkHiOnlyModLocation :: FileExt -> FilePath -> BaseName -> IO FinderCacheEntry
+mkHiOnlyModLocation hisuf path basename = do
   loc <- hiOnlyModLocation path basename hisuf
-  let result = (mkHomeModule mod_name, loc)
-  addToFinderCache mod_name result
-  return result
+  return (loc, Nothing)
 
-mkPackageModLocation hisuf mod_name path basename _ext = do
-  -- basename == dots_to_slashes (moduleNameUserString mod_name)
+mkPackageModLocation :: (PackageConfig, Bool) -> FileExt
+		     -> FilePath -> BaseName -> IO FinderCacheEntry
+mkPackageModLocation pkg_info hisuf path basename = do
   loc <- hiOnlyModLocation path basename hisuf
-  let result = (mkPackageModule mod_name, loc)
-  addToFinderCache mod_name result
-  return result
-
-hiOnlyModLocation path basename hisuf 
- = do let full_basename = path++'/':basename
-      obj_fn <- mkObjPath full_basename basename
-      return ModLocation{ ml_hspp_file = Nothing,
- 	        	     ml_hs_file   = Nothing,
- 	        	     ml_hi_file   = full_basename ++ '.':hisuf,
-		 		-- Remove the .hi-boot suffix from
-		 		-- hi_file, if it had one.  We always
-		 		-- want the name of the real .hi file
-		 		-- in the ml_hi_file field.
-	   	             ml_obj_file  = obj_fn
-                  }
+  return (loc, Just pkg_info)
 
 -- -----------------------------------------------------------------------------
 -- Constructing a home module location
@@ -265,7 +308,7 @@ hiOnlyModLocation path basename hisuf
 --
 -- Parameters are:
 --
--- mod_name
+-- mod
 --      The name of the module
 --
 -- path
@@ -273,34 +316,43 @@ hiOnlyModLocation path basename hisuf
 --      (b) and (c): "."
 --
 -- src_basename
---      (a): dots_to_slashes (moduleNameUserString mod_name)
+--      (a): dots_to_slashes (moduleNameUserString mod)
 --      (b) and (c): The filename of the source file, minus its extension
 --
 -- ext
 --	The filename extension of the source file (usually "hs" or "lhs").
 
-mkHomeModLocation mod_name src_filename = do
+mkHomeModLocation :: Module -> FilePath -> IO ModLocation
+mkHomeModLocation mod src_filename = do
    let (basename,extension) = splitFilename src_filename
-   mkHomeModLocation' mod_name basename extension
+   mkHomeModLocation2 mod basename extension
 
-mkHomeModLocationSearched mod_name path basename ext =
-   mkHomeModLocation' mod_name (path ++ '/':basename) ext
-
-mkHomeModLocation' mod_name src_basename ext = do
-   let mod_basename = dots_to_slashes (moduleNameUserString mod_name)
+mkHomeModLocation2 :: Module	
+		   -> FilePath 	-- Of source module, without suffix
+		   -> String 	-- Suffix
+		   -> IO ModLocation
+mkHomeModLocation2 mod src_basename ext = do
+   let mod_basename = dots_to_slashes (moduleUserString mod)
 
    obj_fn <- mkObjPath src_basename mod_basename
    hi_fn  <- mkHiPath  src_basename mod_basename
 
-   let result = ( mkHomeModule mod_name,
-           	   ModLocation{ ml_hspp_file = Nothing,
-	   		        ml_hs_file   = Just (src_basename ++ '.':ext),
-			        ml_hi_file   = hi_fn,
-			        ml_obj_file  = obj_fn
-		       })
+   return (ModLocation{ ml_hs_file   = Just (src_basename ++ '.':ext),
+			ml_hi_file   = hi_fn,
+			ml_obj_file  = obj_fn })
 
-   addToFinderCache mod_name result
-   return result
+hiOnlyModLocation :: FilePath -> String -> Suffix -> IO ModLocation
+hiOnlyModLocation path basename hisuf 
+ = do let full_basename = path++'/':basename
+      obj_fn <- mkObjPath full_basename basename
+      return ModLocation{    ml_hs_file   = Nothing,
+ 	        	     ml_hi_file   = full_basename ++ '.':hisuf,
+		 		-- Remove the .hi-boot suffix from
+		 		-- hi_file, if it had one.  We always
+		 		-- want the name of the real .hi file
+		 		-- in the ml_hi_file field.
+	   	             ml_obj_file  = obj_fn
+                  }
 
 -- | Constructs the filename of a .o file for a given source file.
 -- Does /not/ check whether the .o file exists
@@ -332,11 +384,12 @@ mkHiPath basename mod_basename
 
         return (hi_basename ++ '.':hisuf)
 
+
 -- -----------------------------------------------------------------------------
 -- findLinkable isn't related to the other stuff in here, 
 -- but there's no other obvious place for it
 
-findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable)
+findLinkable :: Module -> ModLocation -> IO (Maybe Linkable)
 findLinkable mod locn
    = do let obj_fn = ml_obj_file locn
 	obj_exist <- doesFileExist obj_fn
@@ -356,4 +409,33 @@ findLinkable mod locn
 
 dots_to_slashes = map (\c -> if c == '.' then '/' else c)
 
+
+-- -----------------------------------------------------------------------------
+-- Error messages
+
+cantFindError :: DynFlags -> Module -> FindResult -> SDoc
+cantFindError dflags mod_name find_result
+  = hang (ptext SLIT("Could not find module") <+> quotes (ppr mod_name) <> colon)
+       2 more_info
+  where
+    more_info
+      = case find_result of
+	    PackageHidden pkg 
+		-> 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")
+		   <+> ppr pkg)
+
+	    NotFound files
+		| null files
+		-> ptext SLIT("it is not a module in the current program, or in any known package.")
+		| 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))
+
+	    Found _ _ -> panic "cantFindErr"
 \end{code}