[project @ 2003-11-06 17:09:50 by simonpj]

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

diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
index 8564ef0..3137fa2 100644 (file)
--- a/ghc/compiler/main/Finder.lhs
+++ b/ghc/compiler/main/Finder.lhs
@@ -13,8 +13,7 @@ module Finder (
     findPackageModule,  -- :: ModuleName
                        --   -> IO (Either [FilePath] (Module, ModLocation))
 
-    mkHomeModLocation, -- :: ModuleName -> String -> FilePath 
-                       --      -> IO ModLocation
+    mkHomeModLocation, -- :: ModuleName -> FilePath -> IO ModLocation
 
     findLinkable,      -- :: ModuleName -> ModLocation -> IO (Maybe Linkable)
 
@@ -29,7 +28,7 @@ import Module
 import UniqFM          ( filterUFM )
 import HscTypes                ( Linkable(..), Unlinked(..) )
 import DriverState
-import DriverUtil      ( split_longest_prefix, splitFilename3 )
+import DriverUtil
 import FastString
 import Config
 import Util
@@ -121,8 +120,8 @@ maybeHomeModule mod_name = do
 
    let
      source_exts = 
-      [ ("hs",   mkHomeModLocation mod_name)
-      , ("lhs",  mkHomeModLocation mod_name)
+      [ ("hs",   mkHomeModLocationSearched mod_name)
+      , ("lhs",  mkHomeModLocationSearched mod_name)
       ]
      
      hi_exts = [ (hisuf,  mkHiOnlyModLocation hisuf mod_name) ]
@@ -231,16 +230,17 @@ mkPackageModLocation hisuf mod_name path basename _ext = do
   return result
 
 hiOnlyModLocation path basename hisuf 
- = do { obj_fn <- mkObjPath path basename ;
-        return (ModLocation{ ml_hspp_file = Nothing,
+ = 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   = path ++ '/':basename ++ '.':hisuf,
+                            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
-                 })}
+                  }
 
 -- -----------------------------------------------------------------------------
 -- Constructing a home module location
@@ -266,7 +266,7 @@ hiOnlyModLocation path basename hisuf
 --
 -- path
 --      (a): The search path component where the source file was found.
---      (b) and (c): Nothing
+--      (b) and (c): "."
 --
 -- src_basename
 --      (a): dots_to_slashes (moduleNameUserString mod_name)
@@ -275,44 +275,58 @@ hiOnlyModLocation path basename hisuf
 -- ext
 --     The filename extension of the source file (usually "hs" or "lhs").
 
-mkHomeModLocation mod_name path src_basename ext = do
-   hisuf  <- readIORef v_Hi_suf
-   hidir  <- readIORef v_Hi_dir
+mkHomeModLocation mod_name src_filename = do
+   let (basename,extension) = splitFilename src_filename
+   mkHomeModLocation' mod_name basename extension
 
-   let mod_basename = dots_to_slashes (moduleNameUserString mod_name)
-
-   obj_fn <- mkObjPath path mod_basename
+mkHomeModLocationSearched mod_name path basename ext =
+   mkHomeModLocation' mod_name (path ++ '/':basename) ext
 
-   let  -- hi filename, always follows the module name
-       hi_path | Just d <- hidir = d
-              | otherwise       = path
-
-       hi_fn = hi_path ++ '/':mod_basename ++ '.':hisuf
+mkHomeModLocation' mod_name src_basename ext = do
+   let mod_basename = dots_to_slashes (moduleNameUserString mod_name)
 
-       -- source filename
-       source_fn = path ++ '/':src_basename ++ '.':ext
+   obj_fn <- mkObjPath src_basename mod_basename
+   hi_fn  <- mkHiPath  src_basename mod_basename
 
-       result = ( mkHomeModule mod_name,
-                 ModLocation{ ml_hspp_file = Nothing,
-                              ml_hs_file   = Just source_fn,
-                              ml_hi_file   = hi_fn,
-                              ml_obj_file  = obj_fn,
+   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
                       })
 
    addToFinderCache mod_name result
    return result
 
-mkObjPath :: FilePath -> String -> IO FilePath
--- Construct the filename of a .o file.
--- Does *not* check whether the .o file exists
-mkObjPath path basename
+-- | Constructs the filename of a .o file for a given source file.
+-- Does /not/ check whether the .o file exists
+mkObjPath
+  :: FilePath          -- the filename of the source file, minus the extension
+  -> String            -- the module name with dots replaced by slashes
+  -> IO FilePath
+mkObjPath basename mod_basename
   = do  odir   <- readIORef v_Output_dir
        osuf   <- readIORef v_Object_suf
 
-       let obj_path | Just d <- odir = d
-                    | otherwise      = path
+       let obj_basename | Just dir <- odir = dir ++ '/':mod_basename
+                        | otherwise        = basename
+
+        return (obj_basename ++ '.':osuf)
+
+-- | Constructs the filename of a .hi file for a given source file.
+-- Does /not/ check whether the .hi file exists
+mkHiPath
+  :: FilePath          -- the filename of the source file, minus the extension
+  -> String            -- the module name with dots replaced by slashes
+  -> IO FilePath
+mkHiPath basename mod_basename
+  = do  hidir   <- readIORef v_Hi_dir
+       hisuf   <- readIORef v_Hi_suf
+
+       let hi_basename | Just dir <- hidir = dir ++ '/':mod_basename
+                       | otherwise         = basename
 
-        return (obj_path ++ '/':basename ++ '.':osuf)
+        return (hi_basename ++ '.':hisuf)
 
 -- -----------------------------------------------------------------------------
 -- findLinkable isn't related to the other stuff in here,