Commit 06575d67 authored by simonmar's avatar simonmar

[project @ 2002-10-17 14:26:16 by simonmar]

Finder overhaul.

The finder had got pretty complicated; this commit is mainly a
cleanup, with one new feature:

  - the finder has a cache (again).  The cache may be flushed by
    calling flushFinderCache, which actually only flushes home modules
    from the cache, because package modules are assumed not to move.
    This change is apropos of some other changes which will result in
    the finder being called more often, so we think a cache is going
    to be worthwhile.

Also a couple of bugs were fixed:

  - the field ml_hi_file in a ModLocation is now *always* the name
    of the .hi file.  If you need a .hi-boot file, you have to make
    it up by changing the suffix of ml_hi_file.  (DriverMkDepend and
    RnHiFiles do this).  This was the cause of a bug, but I can't
    remember the details.

  - The -odir flag now works in a more reasonable way: hierarchical
    modules get put in subdirectories of the -odir directory.  eg.
    if your module is A.B.C, and -odir D is specified, then the object
    will be D/A/B/C.o; previously it would have been D/C.o.
parent 7370adc0
...@@ -455,7 +455,7 @@ cmCompileExpr cmstate dflags expr ...@@ -455,7 +455,7 @@ cmCompileExpr cmstate dflags expr
cmUnload :: CmState -> DynFlags -> IO CmState cmUnload :: CmState -> DynFlags -> IO CmState
cmUnload state@CmState{ gmode=mode, pcs=pcs } dflags cmUnload state@CmState{ gmode=mode, pcs=pcs } dflags
= do -- Throw away the old home dir cache = do -- Throw away the old home dir cache
emptyHomeDirCache flushFinderCache
-- Unload everything the linker knows about -- Unload everything the linker knows about
cm_unload mode dflags [] cm_unload mode dflags []
...@@ -1224,12 +1224,12 @@ summariseFile file ...@@ -1224,12 +1224,12 @@ summariseFile file
= do hspp_fn <- preprocess file = do hspp_fn <- preprocess file
(srcimps,imps,mod_name) <- getImportsFromFile hspp_fn (srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
let (path, basename, _ext) = splitFilename3 file let (path, basename, ext) = splitFilename3 file
-- GHC.Prim doesn't exist physically, so don't go looking for it. -- GHC.Prim doesn't exist physically, so don't go looking for it.
the_imps = filter (/= gHC_PRIM_Name) imps the_imps = filter (/= gHC_PRIM_Name) imps
(mod, location) (mod, location) <- mkHomeModLocation mod_name True{-is a root-}
<- mkHomeModuleLocn mod_name (path ++ '/':basename) file path basename ext
src_timestamp src_timestamp
<- case ml_hs_file location of <- case ml_hs_file location of
......
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.104 2002/10/13 10:55:06 wolfgang Exp $ -- $Id: DriverFlags.hs,v 1.105 2002/10/17 14:26:17 simonmar Exp $
-- --
-- Driver flags -- Driver flags
-- --
...@@ -229,7 +229,7 @@ static_flags = ...@@ -229,7 +229,7 @@ static_flags =
------- Output Redirection ------------------------------------------ ------- Output Redirection ------------------------------------------
, ( "odir" , HasArg (writeIORef v_Output_dir . Just) ) , ( "odir" , HasArg (writeIORef v_Output_dir . Just) )
, ( "o" , SepArg (writeIORef v_Output_file . Just) ) , ( "o" , SepArg (writeIORef v_Output_file . Just) )
, ( "osuf" , HasArg (writeIORef v_Object_suf . Just) ) , ( "osuf" , HasArg (writeIORef v_Object_suf) )
, ( "hcsuf" , HasArg (writeIORef v_HC_suf . Just) ) , ( "hcsuf" , HasArg (writeIORef v_HC_suf . Just) )
, ( "hisuf" , HasArg (writeIORef v_Hi_suf) ) , ( "hisuf" , HasArg (writeIORef v_Hi_suf) )
, ( "hidir" , HasArg (writeIORef v_Hi_dir . Just) ) , ( "hidir" , HasArg (writeIORef v_Hi_dir . Just) )
......
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.24 2002/10/09 15:03:52 simonpj Exp $ -- $Id: DriverMkDepend.hs,v 1.25 2002/10/17 14:26:18 simonmar Exp $
-- --
-- GHC Driver -- GHC Driver
-- --
...@@ -12,13 +12,13 @@ module DriverMkDepend where ...@@ -12,13 +12,13 @@ module DriverMkDepend where
#include "HsVersions.h" #include "HsVersions.h"
import DriverState import DriverState
import DriverUtil ( add, softGetDirectoryContents ) import DriverUtil ( add, softGetDirectoryContents, replaceFilenameSuffix )
import DriverFlags import DriverFlags
import SysTools ( newTempName ) import SysTools ( newTempName )
import qualified SysTools import qualified SysTools
import Module ( ModuleName, ModLocation(..), import Module ( ModuleName, ModLocation(..),
moduleNameUserString, isHomeModule ) moduleNameUserString, isHomeModule )
import Finder ( findModuleDep ) import Finder ( findModule, hiBootExt, hiBootVerExt )
import Util ( global ) import Util ( global )
import Panic import Panic
...@@ -171,13 +171,33 @@ findDependency is_source src imp = do ...@@ -171,13 +171,33 @@ findDependency is_source src imp = do
if imp_mod `elem` excl_mods if imp_mod `elem` excl_mods
then return Nothing then return Nothing
else do else do
r <- findModuleDep imp is_source r <- findModule imp
case r of case r of
Just (mod,loc) Just (mod,loc)
| isHomeModule mod || include_prelude -- not in this package: we don't need a dependency
| not (isHomeModule mod) && not include_prelude
-> return Nothing
-- normal import: just depend on the .hi file
| not is_source
-> return (Just (ml_hi_file loc, not is_source)) -> return (Just (ml_hi_file loc, not is_source))
-- if it's a source import, we want to generate a dependency
-- on the .hi-boot file, not the .hi file
| otherwise | otherwise
-> return Nothing -> let hi_file = ml_hi_file loc
boot_hi_file = replaceFilenameSuffix hi_file hiBootExt
boot_ver_hi_file = replaceFilenameSuffix hi_file hiBootVerExt
in do
b <- doesFileExist boot_hi_file
if b
then return (Just (boot_hi_file, not is_source))
else do
b <- doesFileExist boot_ver_hi_file
if b
then return (Just (boot_ver_hi_file, not is_source))
else return (Just (hi_file, not is_source))
Nothing -> throwDyn (ProgramError Nothing -> throwDyn (ProgramError
(src ++ ": " ++ "can't locate import `" ++ imp_mod ++ "'" ++ (src ++ ": " ++ "can't locate import `" ++ imp_mod ++ "'" ++
if is_source then " (SOURCE import)" else "")) if is_source then " (SOURCE import)" else ""))
...@@ -461,9 +461,9 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix) ...@@ -461,9 +461,9 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix)
++ filename ++ "'" ++ show pipeline ++ show stop_phase))) ++ filename ++ "'" ++ show pipeline ++ show stop_phase)))
let let
-- .o and .hc suffixes can be overriden by command-line options: -- .o and .hc suffixes can be overriden by command-line options:
myPhaseInputExt Ln | Just s <- osuf = s
myPhaseInputExt HCc | Just s <- hcsuf = s myPhaseInputExt HCc | Just s <- hcsuf = s
myPhaseInputExt other = phaseInputExt other myPhaseInputExt Ln = osuf
myPhaseInputExt other = phaseInputExt other
annotatePipeline annotatePipeline
:: [Phase] -- raw pipeline :: [Phase] -- raw pipeline
...@@ -687,10 +687,7 @@ run_phase MkDependHS basename suff input_fn output_fn ...@@ -687,10 +687,7 @@ run_phase MkDependHS basename suff input_fn output_fn
deps_normals <- mapM (findDependency False orig_fn) import_normals deps_normals <- mapM (findDependency False orig_fn) import_normals
let deps = deps_sources ++ deps_normals let deps = deps_sources ++ deps_normals
osuf_opt <- readIORef v_Object_suf osuf <- readIORef v_Object_suf
let osuf = case osuf_opt of
Nothing -> phaseInputExt Ln
Just s -> s
extra_suffixes <- readIORef v_Dep_suffixes extra_suffixes <- readIORef v_Dep_suffixes
let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
...@@ -749,7 +746,7 @@ run_phase Hsc basename suff input_fn output_fn ...@@ -749,7 +746,7 @@ run_phase Hsc basename suff input_fn output_fn
-- we add the current directory (i.e. the directory in which -- we add the current directory (i.e. the directory in which
-- the .hs files resides) to the import path, since this is -- the .hs files resides) to the import path, since this is
-- what gcc does, and it's probably what you want. -- what gcc does, and it's probably what you want.
let current_dir = getdir basename let current_dir = directoryOf basename
paths <- readIORef v_Include_paths paths <- readIORef v_Include_paths
writeIORef v_Include_paths (current_dir : paths) writeIORef v_Include_paths (current_dir : paths)
...@@ -779,8 +776,8 @@ run_phase Hsc basename suff input_fn output_fn ...@@ -779,8 +776,8 @@ run_phase Hsc basename suff input_fn output_fn
getImportsFromFile input_fn getImportsFromFile input_fn
-- build a ModLocation to pass to hscMain. -- build a ModLocation to pass to hscMain.
(mod, location') let (path,file) = splitFilenameDir basename
<- mkHomeModuleLocn mod_name basename (basename ++ '.':suff) (mod, location') <- mkHomeModLocation mod_name True path file suff
-- take -ohi into account if present -- take -ohi into account if present
ohi <- readIORef v_Output_hi ohi <- readIORef v_Output_hi
...@@ -993,8 +990,9 @@ run_phase SplitAs basename _suff _input_fn output_fn ...@@ -993,8 +990,9 @@ run_phase SplitAs basename _suff _input_fn output_fn
let assemble_file n let assemble_file n
= do let input_s = split_s_prefix ++ "__" ++ show n ++ ".s" = do let input_s = split_s_prefix ++ "__" ++ show n ++ ".s"
let output_o = newdir real_odir let output_o = replaceFilenameDirectory
(basename ++ "__" ++ show n ++ ".o") (basename ++ "__" ++ show n ++ ".o")
real_odir
real_o <- osuf_ify output_o real_o <- osuf_ify output_o
SysTools.runAs (map SysTools.Option as_opts ++ SysTools.runAs (map SysTools.Option as_opts ++
[ SysTools.Option "-c" [ SysTools.Option "-c"
......
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.82 2002/09/13 15:02:34 simonpj Exp $ -- $Id: DriverState.hs,v 1.83 2002/10/17 14:26:18 simonmar Exp $
-- --
-- Settings for the driver -- Settings for the driver
-- --
...@@ -161,7 +161,7 @@ verifyOutputFiles = do ...@@ -161,7 +161,7 @@ verifyOutputFiles = do
show dir ++ " does not exist (used with " ++ show dir ++ " does not exist (used with " ++
show flg ++ " option.)")) show flg ++ " option.)"))
GLOBAL_VAR(v_Object_suf, Nothing, Maybe String) GLOBAL_VAR(v_Object_suf, phaseInputExt Ln, String)
GLOBAL_VAR(v_HC_suf, Nothing, Maybe String) GLOBAL_VAR(v_HC_suf, Nothing, Maybe String)
GLOBAL_VAR(v_Hi_dir, Nothing, Maybe String) GLOBAL_VAR(v_Hi_dir, Nothing, Maybe String)
GLOBAL_VAR(v_Hi_suf, "hi", String) GLOBAL_VAR(v_Hi_suf, "hi", String)
...@@ -173,14 +173,12 @@ odir_ify f = do ...@@ -173,14 +173,12 @@ odir_ify f = do
odir_opt <- readIORef v_Output_dir odir_opt <- readIORef v_Output_dir
case odir_opt of case odir_opt of
Nothing -> return f Nothing -> return f
Just d -> return (newdir d f) Just d -> return (replaceFilenameDirectory f d)
osuf_ify :: String -> IO String osuf_ify :: String -> IO String
osuf_ify f = do osuf_ify f = do
osuf_opt <- readIORef v_Object_suf osuf <- readIORef v_Object_suf
case osuf_opt of return (replaceFilenameSuffix f osuf)
Nothing -> return f
Just s -> return (newsuf s f)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Compiler optimisation options -- Compiler optimisation options
......
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- $Id: DriverUtil.hs,v 1.34 2002/09/13 15:02:34 simonpj Exp $ -- $Id: DriverUtil.hs,v 1.35 2002/10/17 14:26:18 simonmar Exp $
-- --
-- Utils for the driver -- Utils for the driver
-- --
...@@ -50,7 +50,7 @@ getOptionsFromSource file ...@@ -50,7 +50,7 @@ getOptionsFromSource file
| otherwise -> return [] | otherwise -> return []
matchOptions s matchOptions s
| Just s1 <- my_prefix_match "{-#" s, | Just s1 <- my_prefix_match "{-#" s, -- -}
Just s2 <- my_prefix_match "OPTIONS" (remove_spaces s1), Just s2 <- my_prefix_match "OPTIONS" (remove_spaces s1),
Just s3 <- my_prefix_match "}-#" (reverse s2) Just s3 <- my_prefix_match "}-#" (reverse s2)
= Just (reverse s3) = Just (reverse s3)
...@@ -72,8 +72,7 @@ softGetDirectoryContents d ...@@ -72,8 +72,7 @@ softGetDirectoryContents d
-- Verify that the 'dirname' portion of a FilePath exists. -- Verify that the 'dirname' portion of a FilePath exists.
-- --
doesDirNameExist :: FilePath -> IO Bool doesDirNameExist :: FilePath -> IO Bool
doesDirNameExist fpath = doesDirectoryExist (getdir fpath) doesDirNameExist fpath = doesDirectoryExist (directoryOf fpath)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Prefixing underscore to linker-level names -- Prefixing underscore to linker-level names
...@@ -148,6 +147,14 @@ splitFilename f = split_longest_prefix f (=='.') ...@@ -148,6 +147,14 @@ splitFilename f = split_longest_prefix f (=='.')
getFileSuffix :: String -> Suffix getFileSuffix :: String -> Suffix
getFileSuffix f = drop_longest_prefix f (=='.') getFileSuffix f = drop_longest_prefix f (=='.')
-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext")
splitFilenameDir :: String -> (String,String)
splitFilenameDir str
= let (dir, rest) = split_longest_prefix str isPathSeparator
real_dir | null dir = "."
| otherwise = dir
in (real_dir, rest)
-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext") -- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
splitFilename3 :: String -> (String,String,Suffix) splitFilename3 :: String -> (String,String,Suffix)
splitFilename3 str splitFilename3 str
...@@ -187,16 +194,17 @@ split_longest_prefix s pred ...@@ -187,16 +194,17 @@ split_longest_prefix s pred
(_:pre) -> (reverse pre, reverse suf) (_:pre) -> (reverse pre, reverse suf)
where (suf,pre) = break pred (reverse s) where (suf,pre) = break pred (reverse s)
newsuf :: String -> Suffix -> String replaceFilenameSuffix :: FilePath -> Suffix -> FilePath
newsuf suf s = remove_suffix '.' s ++ suf replaceFilenameSuffix s suf = remove_suffix '.' s ++ suf
-- getdir strips the filename off the input string, returning the directory. -- directoryOf strips the filename off the input string, returning
getdir :: String -> String -- the directory.
getdir s = if null dir then "." else init dir directoryOf :: FilePath -> String
where dir = take_longest_prefix s isPathSeparator directoryOf = fst . splitFilenameDir
newdir :: String -> String -> String replaceFilenameDirectory :: FilePath -> String -> FilePath
newdir dir s = dir ++ '/':drop_longest_prefix s isPathSeparator replaceFilenameDirectory s dir
= dir ++ '/':drop_longest_prefix s isPathSeparator
remove_spaces :: String -> String remove_spaces :: String -> String
remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
......
...@@ -6,154 +6,147 @@ ...@@ -6,154 +6,147 @@
\begin{code} \begin{code}
module Finder ( module Finder (
initFinder, -- :: [PackageConfig] -> IO (), initFinder, -- :: [PackageConfig] -> IO (),
flushFinderCache, -- :: IO ()
findModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation)) findModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation))
findModuleDep, -- :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation)) findPackageModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation))
findPackageModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation))
mkHomeModuleLocn, -- :: ModuleName -> String -> FilePath mkHomeModLocation, -- :: ModuleName -> String -> FilePath
-- -> IO ModLocation -- -> IO ModLocation
emptyHomeDirCache, -- :: IO ()
flushPackageCache -- :: [PackageConfig] -> IO () hiBootExt, -- :: String
hiBootVerExt, -- :: String
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
import Module ( Module, ModLocation(..), ModuleName, import Module
moduleNameUserString, mkHomeModule, mkPackageModule import UniqFM ( filterUFM )
)
import Packages ( PackageConfig(..) ) import Packages ( PackageConfig(..) )
import DriverPhases
import DriverState import DriverState
import DriverUtil import DriverUtil ( split_longest_prefix )
import FastString import FastString
import Config import Config
import Util
import DATA_IOREF ( readIORef ) import DATA_IOREF ( IORef, writeIORef, readIORef )
import List import List
import Directory import Directory
import IO import IO
import Monad import Monad
\end{code}
The Finder provides a thin filesystem abstraction to the rest of the -- -----------------------------------------------------------------------------
compiler. For a given module, it knows (a) whether the module lives -- The Finder
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.
It does *not* know which particular package a module lives in, because -- The Finder provides a thin filesystem abstraction to the rest of the
that information is only contained in the interface file. -- 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.
--
-- It does *not* know which particular package a module lives in, because
-- that information is only contained in the interface file.
\begin{code}
initFinder :: [PackageConfig] -> IO () initFinder :: [PackageConfig] -> IO ()
initFinder pkgs = return () initFinder pkgs = return ()
-- empty, and lazilly fill in the package cache -- -----------------------------------------------------------------------------
flushPackageCache :: [PackageConfig] -> IO () -- The finder's cache
flushPackageCache pkgs = return ()
GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv (Module,ModLocation))
emptyHomeDirCache :: IO ()
emptyHomeDirCache = return () -- 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)
addToFinderCache :: ModuleName -> (Module,ModLocation) -> IO ()
addToFinderCache mod_name stuff = do
fm <- readIORef finder_cache
writeIORef finder_cache (extendModuleEnvByName fm mod_name stuff)
lookupFinderCache :: ModuleName -> IO (Maybe (Module,ModLocation))
lookupFinderCache mod_name = do
fm <- readIORef finder_cache
return $! lookupModuleEnvByName fm mod_name
-- -----------------------------------------------------------------------------
-- Locating modules
-- This is the main interface to the finder, which maps ModuleNames to
-- Modules and ModLocations.
--
-- The Module contains one crucial bit of information about a module:
-- whether it lives in the current ("home") package or not (see Module
-- for more details).
--
-- The ModLocation contains the names of all the files associated with
-- that module: its source file, .hi file, object file, etc.
findModule :: ModuleName -> IO (Maybe (Module, ModLocation)) findModule :: ModuleName -> IO (Maybe (Module, ModLocation))
findModule name = findModuleDep name False findModule name = do
r <- lookupFinderCache name
findModuleDep :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation)) case r of
findModuleDep name is_source Just result -> return (Just result)
= do { j <- maybeHomeModule name is_source Nothing -> do
; case j of j <- maybeHomeModule name
Just home_module -> return (Just home_module) case j of
Nothing -> findPackageMod name False is_source Just home_module -> return (Just home_module)
} Nothing -> findPackageMod name
maybeHomeModule :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation)) findPackageModule :: ModuleName -> IO (Maybe (Module, ModLocation))
maybeHomeModule mod_name is_source = do findPackageModule name = do
r <- lookupFinderCache name
case r of
Just result -> return (Just result)
Nothing -> findPackageMod name
hiBootExt = "hi-boot"
hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion
maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModLocation))
maybeHomeModule mod_name = do
home_path <- readIORef v_Import_paths home_path <- readIORef v_Import_paths
hisuf <- readIORef v_Hi_suf hisuf <- readIORef v_Hi_suf
mode <- readIORef v_GhcMode mode <- readIORef v_GhcMode
let mod_str = moduleNameUserString mod_name let
basename = map (\c -> if c == '.' then '/' else c) mod_str source_exts =
[ ("hs", mkHomeModLocation mod_name False)
-- In compilation manager modes, we look for source files in the home , ("lhs", mkHomeModLocation mod_name False)
-- package because we can compile these automatically. In one-shot ]
-- compilation mode we look for .hi files only.
-- hi_exts = [ (hisuf, mkHiOnlyModLocation hisuf mod_name) ]
-- When generating dependencies, we're interested in either category.
-- boot_exts =
source_exts = [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name)
[ ("hs", \ fName path -> mkHomeModuleLocn mod_name path fName) , (hiBootExt, mkHiOnlyModLocation hisuf mod_name)
, ("lhs", \ fName path -> mkHomeModuleLocn mod_name path fName) ]
]
hi_exts = [ (hisuf, \ fName path -> mkHiOnlyModuleLocn mod_name fName) ] -- In compilation manager modes, we look for source files in the home
-- package because we can compile these automatically. In one-shot
std_exts -- compilation mode we look for .hi and .hi-boot files only.
| mode == DoMkDependHS = hi_exts ++ source_exts --
-- When generating dependencies, we're interested in either category.
--
exts
| mode == DoMkDependHS = hi_exts ++ source_exts ++ boot_exts
| isCompManagerMode mode = source_exts | isCompManagerMode mode = source_exts
| otherwise = hi_exts | otherwise {-one-shot-} = hi_exts ++ boot_exts
-- last chance: .hi-boot-<ver> and .hi-boot
hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion
boot_exts = searchPathExts home_path mod_name exts
[ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName)
, ("hi-boot", \ fName path -> mkHiOnlyModuleLocn mod_name fName)
]
searchPathExts home_path basename
(if is_source then boot_exts else (std_exts ++ boot_exts))
-- for SOURCE imports, check the hi-boot extensions
-- before the source/iface ones, to avoid
-- creating circ Makefile deps.
-- -----------------------------------------------------------------------------
-- Looking for a package module
mkHiOnlyModuleLocn mod_name hi_file = findPackageMod :: ModuleName -> IO (Maybe (Module, ModLocation))
return findPackageMod mod_name = do
( mkHomeModule mod_name mode <- readIORef v_GhcMode
, ModLocation{ ml_hspp_file = Nothing imp_dirs <- getPackageImportPath -- including the 'auto' ones
, ml_hs_file = Nothing
, ml_hi_file = hi_file
, ml_obj_file = Nothing
}
)
-- The .hi file always follows the module name, whereas the object
-- file may follow the name of the source file in the case where the
-- two differ (see summariseFile in compMan/CompManager.lhs).
mkHomeModuleLocn mod_name
basename -- everything but the extension
source_fn -- full path to the source (required)
= do
hisuf <- readIORef v_Hi_suf
hidir <- readIORef v_Hi_dir
-- take the *last* component of the module name (if a hierarchical name),
-- and append it to the directory to get the .hi file name.
let (_,mod_str) = split_longest_prefix (moduleNameUserString mod_name) (=='.')
hi_filename = mod_str ++ '.':hisuf
hi_path | Just d <- hidir = d
| otherwise = getdir basename
hi = hi_path ++ '/':hi_filename
-- figure out the .o file name. It also lives in the same dir
-- as the source, but can be overriden by a -odir flag.
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
return (mkHomeModule mod_name,
ModLocation{ ml_hspp_file = Nothing
, ml_hs_file = Just source_fn
, ml_hi_file = hi
, ml_obj_file = Just o_file