[project @ 2002-10-13 10:55:06 by wolfgang]

[ghc-hetmet.git] / ghc / compiler / main / Finder.lhs

diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
index de9b760..f8f2a71 100644 (file)
--- a/ghc/compiler/main/Finder.lhs
+++ b/ghc/compiler/main/Finder.lhs
@@ -6,27 +6,29 @@
 \begin{code}
 module Finder (
     initFinder,        -- :: [PackageConfig] -> IO (), 
-    findModule,                -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
-    findModuleDep,     -- :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation))
-    findPackageModule, -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
+    findModule,                -- :: ModuleName -> IO (Maybe (Module, ModLocation))
+    findModuleDep,     -- :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation))
+    findPackageModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation))
     mkHomeModuleLocn,  -- :: ModuleName -> String -> FilePath 
-                       --      -> IO ModuleLocation
+                       --      -> IO ModLocation
     emptyHomeDirCache, -- :: IO ()
     flushPackageCache   -- :: [PackageConfig] -> IO ()
   ) where
 
 #include "HsVersions.h"
 
-import HscTypes                ( ModuleLocation(..) )
+import Module          ( Module, ModLocation(..), ModuleName,
+                         moduleNameUserString, mkHomeModule, mkPackageModule
+                       )
 import Packages                ( PackageConfig(..) )
 import DriverPhases
 import DriverState
 import DriverUtil
-import Module
 import FastString
 import Config
 
-import IOExts
+import DATA_IOREF      ( readIORef )
+
 import List
 import Directory
 import IO
@@ -53,18 +55,18 @@ flushPackageCache pkgs = return ()
 emptyHomeDirCache :: IO ()
 emptyHomeDirCache = return ()
 
-findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
+findModule :: ModuleName -> IO (Maybe (Module, ModLocation))
 findModule name = findModuleDep name False
 
-findModuleDep :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation))
+findModuleDep :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation))
 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 :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation))
 maybeHomeModule mod_name is_source = do
    home_path <- readIORef v_Import_paths
    hisuf     <- readIORef v_Hi_suf
@@ -99,15 +101,16 @@ maybeHomeModule mod_name is_source = do
        ]
 
    searchPathExts home_path basename
-       (if is_source then (boot_exts++std_exts) else std_exts ++ boot_exts)
+       (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
    ( mkHomeModule mod_name
-   , ModuleLocation{ ml_hspp_file = Nothing
+   , ModLocation{ ml_hspp_file = Nothing
                   , ml_hs_file   = Nothing
                   , ml_hi_file   = hi_file
                   , ml_obj_file  = Nothing
@@ -139,7 +142,7 @@ mkHomeModuleLocn mod_name
    o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
 
    return (mkHomeModule mod_name,
-           ModuleLocation{ ml_hspp_file = Nothing
+           ModLocation{ ml_hspp_file = Nothing
                         , ml_hs_file   = Just source_fn
                         , ml_hi_file   = hi
                         , ml_obj_file  = Just o_file
@@ -147,8 +150,9 @@ mkHomeModuleLocn mod_name
 
 findPackageMod :: ModuleName
               -> Bool
-              -> IO (Maybe (Module, ModuleLocation))
-findPackageMod mod_name hiOnly = do
+              -> Bool
+              -> IO (Maybe (Module, ModLocation))
+findPackageMod mod_name hiOnly is_source = do
   pkgs <- getPackageInfo
 
    -- hi-suffix for packages depends on the build tag.
@@ -163,48 +167,49 @@ findPackageMod mod_name hiOnly = do
 
       retPackageModule mod_name mbFName path =
         return ( mkPackageModule mod_name
-               , ModuleLocation{ ml_hspp_file = Nothing
+               , ModLocation{ ml_hspp_file = Nothing
                               , ml_hs_file   = mbFName
                               , ml_hi_file   = path ++ '.':package_hisuf
                               , ml_obj_file  = Nothing
                               })
 
+       -- last chance: .hi-boot-<ver> 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,\ fName path -> retPackageModule mod_name Nothing path) :
-         -- can packages contain hi-boots?
-        (if hiOnly then [] else
-         [ ("hs",  \ fName path -> retPackageModule mod_name (Just fName) path)
-         , ("lhs", \ fName path -> retPackageModule mod_name (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 :: ModuleName -> IO (Maybe (Module, ModLocation))
+findPackageModule mod_name = findPackageMod mod_name True False
 
 searchPathExts :: [FilePath]
               -> String
-              -> [(String, FilePath -> String -> IO (Module, ModuleLocation))] 
-              -> IO (Maybe (Module, ModuleLocation))
-searchPathExts path basename exts = search exts
+              -> [(String, FilePath -> String -> IO (Module, ModLocation))] 
+              -> IO (Maybe (Module, ModLocation))
+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.<ext>" all the time
-         Just "."  -> fmap Just (f fName basename)
-         Just path -> fmap Just (f (path ++ '/':fName)
-                                         (path ++ '/':basename))
-         Nothing   -> search xs
-
-findOnPath :: [String] -> String -> IO (Maybe FilePath)
-findOnPath path s = loop path
- where
-  loop [] = return Nothing
-  loop (d:ds) = do
-    let file = d ++ '/':s
-    b <- doesFileExist file
-    if b then return (Just 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}