X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=a71060945887f803363156b7e1d3a108f8f37d1c;hb=ce9687a5f450014c5596b32de8e8a7b99b6389e8;hp=83cf28c8f04ad9c48e369b2c17a843cc3b18c07d;hpb=c34157eadadf46a81b0ab7943da28748921b30ba;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 83cf28c..a710609 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -26,7 +26,8 @@ import Module import FastString import Config -import IOExts +import DATA_IOREF ( readIORef ) + import List import Directory import IO @@ -34,9 +35,13 @@ import Monad \end{code} The Finder provides a thin filesystem abstraction to the rest of the -compiler. For a given module, it knows (a) which package the module -lives in, so it can make a Module from a ModuleName, and (b) where the -source, interface, and object files for a module live. +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 () @@ -57,40 +62,49 @@ findModuleDep name is_source = do { j <- maybeHomeModule name is_source ; case j of Just home_module -> return (Just home_module) - Nothing -> findPackageMod name False + Nothing -> findPackageMod name False is_source } maybeHomeModule :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation)) maybeHomeModule mod_name is_source = do home_path <- readIORef v_Import_paths hisuf <- readIORef v_Hi_suf + mode <- readIORef v_GhcMode let mod_str = moduleNameUserString mod_name basename = map (\c -> if c == '.' then '/' else c) mod_str - std_exts = - [ ("hs", \ _ fName path -> mkHomeModuleLocn mod_name path fName) - , ("lhs", \ _ fName path -> mkHomeModuleLocn mod_name path fName) - , (hisuf, \ _ fName path -> mkHiOnlyModuleLocn mod_name fName) - ] - -- look for the .hi file last, because if there's a source file about - -- we want to find it. + -- 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 files only. + -- + -- When generating dependencies, we're interested in either category. + -- + source_exts = + [ ("hs", \ fName path -> mkHomeModuleLocn mod_name path fName) + , ("lhs", \ fName path -> mkHomeModuleLocn mod_name path fName) + ] + hi_exts = [ (hisuf, \ fName path -> mkHiOnlyModuleLocn mod_name fName) ] + + std_exts + | mode == DoMkDependHS = hi_exts ++ source_exts + | isCompManagerMode mode = source_exts + | otherwise = hi_exts -- last chance: .hi-boot- and .hi-boot hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion boot_exts = - [ (hi_boot_ver, \ _ fName path -> mkHiOnlyModuleLocn mod_name fName) - , ("hi-boot", \ _ fName path -> mkHiOnlyModuleLocn mod_name fName) + [ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName) + , ("hi-boot", \ fName path -> mkHiOnlyModuleLocn mod_name fName) ] - searchPathExts - (map ((,) undefined) home_path) - basename - (if is_source then (boot_exts++std_exts) else std_exts ++ boot_exts) + 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. + mkHiOnlyModuleLocn mod_name hi_file = return @@ -135,8 +149,9 @@ mkHomeModuleLocn mod_name findPackageMod :: ModuleName -> Bool + -> Bool -> IO (Maybe (Module, ModuleLocation)) -findPackageMod mod_name hiOnly = do +findPackageMod mod_name hiOnly is_source = do pkgs <- getPackageInfo -- hi-suffix for packages depends on the build tag. @@ -145,54 +160,55 @@ findPackageMod mod_name hiOnly = do if null tag then return "hi" else return (tag ++ "_hi") - let imp_dirs = concatMap (\ pkg -> map ((,) pkg) (import_dirs pkg)) pkgs + let imp_dirs = concatMap import_dirs pkgs mod_str = moduleNameUserString mod_name basename = map (\c -> if c == '.' then '/' else c) mod_str - mkPackageModule mod_name pkg mbFName path = - return ( mkModule mod_name (mkFastString (name pkg)) + retPackageModule mod_name mbFName path = + return ( mkPackageModule mod_name , ModuleLocation{ ml_hspp_file = Nothing , ml_hs_file = mbFName , ml_hi_file = path ++ '.':package_hisuf , ml_obj_file = Nothing }) + -- last chance: .hi-boot- and .hi-boot + hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion + + boot_exts = + [ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName) + , ("hi-boot", \ fName path -> mkHiOnlyModuleLocn mod_name fName) + ] + searchPathExts imp_dirs basename - ((package_hisuf,\ pkg fName path -> mkPackageModule mod_name pkg Nothing path) : - -- can packages contain hi-boots? - (if hiOnly then [] else - [ ("hs", \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path) - , ("lhs", \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path) - ])) + (if is_source then boot_exts else + ((package_hisuf,\ fName path -> retPackageModule mod_name Nothing path) : + (if hiOnly then [] else + [ ("hs", \ fName path -> retPackageModule mod_name (Just fName) path) + , ("lhs", \ fName path -> retPackageModule mod_name (Just fName) path) + ]))) where findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation)) -findPackageModule mod_name = findPackageMod mod_name True +findPackageModule mod_name = findPackageMod mod_name True False -searchPathExts :: [(a, FilePath)] +searchPathExts :: [FilePath] -> String - -> [(String, a -> FilePath -> String -> IO (Module, ModuleLocation))] + -> [(String, FilePath -> String -> IO (Module, ModuleLocation))] -> IO (Maybe (Module, ModuleLocation)) -searchPathExts path basename exts = search exts +searchPathExts path basename exts = search path where - search [] = return Nothing - search ((x,f):xs) = do - let fName = (basename ++ '.':x) - found <- findOnPath path fName - case found of - -- special case to avoid getting "./foo." all the time - Just (v,".") -> fmap Just (f v fName basename) - Just (v,path) -> fmap Just (f v (path ++ '/':fName) - (path ++ '/':basename)) - Nothing -> search xs - -findOnPath :: [(a,String)] -> String -> IO (Maybe (a, FilePath)) -findOnPath path s = loop path - where - loop [] = return Nothing - loop ((a,d):ds) = do - let file = d ++ '/':s - b <- doesFileExist file - if b then return (Just (a,d)) else loop ds + search [] = return Nothing + search (p:ps) = loop exts + where + base | p == "." = basename + | otherwise = p ++ '/':basename + + loop [] = search ps + loop ((ext,fn):exts) = do + let file = base ++ '.':ext + b <- doesFileExist file + if b then Just `liftM` fn file base + else loop exts \end{code}