Skip to content

GitLab

GHC
GHC
Commit 7eb5e29b authored by Ian Lynagh's avatar Ian Lynagh
Browse files
Options

Use System.FilePath

parent b70f35af
Hide whitespace changes
Inline Side-by-side
Showing with 220 additions and 301 deletions
compiler/ghci/InteractiveUI.hs
View file @ 7eb5e29b
......@@ -264,7 +264,7 @@ findEditor = do
`IO.catch` \_ -> do
#if mingw32_HOST_OS
win <- System.Win32.getWindowsDirectory
return (win `joinFileName` "notepad.exe")
return (win </> "notepad.exe")
#else
return ""
#endif
......
compiler/ghci/Linker.lhs
View file @ 7eb5e29b
......@@ -73,6 +73,7 @@ import Data.IORef
import Data.List
import Foreign
import System.FilePath
import System.IO
import System.Directory
......@@ -657,7 +658,7 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
return lnk
adjust_ul osuf (DotO file) = do
let new_file = replaceFilenameSuffix file osuf
let new_file = replaceExtension file osuf
ok <- doesFileExist new_file
if (not ok)
then dieWith span $
......@@ -1080,8 +1081,8 @@ locateOneObj dirs lib
Just lib_path -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
Nothing -> return (DLL lib) }} -- We assume
where
mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion)
mk_obj_path dir = dir </> lib <.> "o"
mk_dyn_lib_path dir = dir </> mkSOName (lib ++ "-ghc" ++ cProjectVersion)
#else
-- When the GHC package was compiled as dynamic library (=__PIC__ set),
-- we search for .so libraries first.
......@@ -1096,8 +1097,8 @@ locateOneObj dirs lib
Just obj_path -> return (Object obj_path)
Nothing -> return (DLL lib) }} -- We assume
where
mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion)
mk_obj_path dir = dir </> (lib <.> "o")
mk_dyn_lib_path dir = dir </> mkSOName (lib ++ "-ghc" ++ cProjectVersion)
#endif
-- ----------------------------------------------------------------------------
......@@ -1112,16 +1113,16 @@ loadDynamic paths rootname
-- Tried all our known library paths, so let
-- dlopen() search its own builtin paths now.
where
mk_dll_path dir = dir `joinFileName` mkSOName rootname
mk_dll_path dir = dir </> mkSOName rootname
#if defined(darwin_TARGET_OS)
mkSOName root = ("lib" ++ root) `joinFileExt` "dylib"
mkSOName root = ("lib" ++ root) <.> "dylib"
#elif defined(mingw32_TARGET_OS)
-- Win32 DLLs have no .dll extension here, because addDLL tries
-- both foo.dll and foo.drv
mkSOName root = root
#else
mkSOName root = ("lib" ++ root) `joinFileExt` "so"
mkSOName root = ("lib" ++ root) <.> "so"
#endif
-- Darwin / MacOS X only: load a framework
......@@ -1141,7 +1142,7 @@ loadFramework extraPaths rootname
-- Tried all our known library paths, but dlopen()
-- has no built-in paths for frameworks: give up
where
mk_fwk dir = dir `joinFileName` (rootname ++ ".framework/" ++ rootname)
mk_fwk dir = dir </> (rootname ++ ".framework/" ++ rootname)
-- sorry for the hardcoded paths, I hope they won't change anytime soon:
defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
#endif
......
compiler/iface/MkIface.lhs
View file @ 7eb5e29b
......@@ -233,6 +233,7 @@ import ListSetOps
import Control.Monad
import Data.List
import Data.IORef
import System.FilePath
\end{code}
......@@ -465,7 +466,7 @@ mkIface_ hsc_env maybe_old_iface
-----------------------------
writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
writeIfaceFile dflags location new_iface
= do createDirectoryHierarchy (directoryOf hi_file_path)
= do createDirectoryHierarchy (takeDirectory hi_file_path)
writeBinIface dflags hi_file_path new_iface
where hi_file_path = ml_hi_file location
......
compiler/main/CodeOutput.lhs
View file @ 7eb5e29b
......@@ -39,6 +39,7 @@ import Distribution.Package ( showPackageId )
import Directory ( doesFileExist )
import Monad ( when )
import IO
import System.FilePath
\end{code}
%************************************************************************
......@@ -235,7 +236,7 @@ outputForeignStubs dflags mod location stubs
stub_h_output_w = showSDoc stub_h_output_d
-- in
createDirectoryHierarchy (directoryOf stub_c)
createDirectoryHierarchy (takeDirectory stub_c)
dumpIfSet_dyn dflags Opt_D_dump_foreign
"Foreign export header file" stub_h_output_d
......
compiler/main/DriverMkDepend.hs
View file @ 7eb5e29b
......@@ -22,7 +22,7 @@ module DriverMkDepend (
import qualified GHC
import GHC ( Session, ModSummary(..) )
import DynFlags
import Util ( escapeSpaces, splitFilename, joinFileExt )
import Util ( escapeSpaces )
import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
import SysTools ( newTempName )
import qualified SysTools
......@@ -42,6 +42,7 @@ import Data.IORef ( IORef, readIORef, writeIORef )
import Control.Exception
import System.Exit ( ExitCode(..), exitWith )
import System.Directory
import System.FilePath
import System.IO
import SYSTEM_IO_ERROR ( isEOFError )
import Control.Monad ( when )
......@@ -272,9 +273,9 @@ insertSuffixes
-- Lots of other things will break first!
insertSuffixes file_name extras
= file_name : [ basename `joinFileExt` (extra ++ "_" ++ suffix) | extra <- extras ]
= file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ]
where
(basename, suffix) = splitFilename file_name
(basename, suffix) = splitExtension file_name
-----------------------------------------------------------------
......
compiler/main/DriverPhases.hs
View file @ 7eb5e29b
......@@ -40,8 +40,8 @@ module DriverPhases (
isSourceFilename -- :: FilePath -> Bool
) where
import Util ( suffixOf )
import Panic ( panic )
import System.FilePath
-----------------------------------------------------------------------------
-- Phases
......@@ -220,17 +220,18 @@ isCishSuffix s = s `elem` cish_suffixes
isExtCoreSuffix s = s `elem` extcoreish_suffixes
isObjectSuffix s = s `elem` objish_suffixes
isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
isDynLibSuffix s = s `elem` dynlib_suffixes
isDynLibSuffix s = s `elem` dynlib_suffixes
isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff
isHaskellishFilename f = isHaskellishSuffix (suffixOf f)
isHaskellSrcFilename f = isHaskellSrcSuffix (suffixOf f)
isCishFilename f = isCishSuffix (suffixOf f)
isExtCoreFilename f = isExtCoreSuffix (suffixOf f)
isObjectFilename f = isObjectSuffix (suffixOf f)
isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (suffixOf f)
isDynLibFilename f = isDynLibSuffix (suffixOf f)
isSourceFilename f = isSourceSuffix (suffixOf f)
-- takeExtension return .foo, so we drop 1 to get rid of the .
isHaskellishFilename f = isHaskellishSuffix (drop 1 $ takeExtension f)
isHaskellSrcFilename f = isHaskellSrcSuffix (drop 1 $ takeExtension f)
isCishFilename f = isCishSuffix (drop 1 $ takeExtension f)
isExtCoreFilename f = isExtCoreSuffix (drop 1 $ takeExtension f)
isObjectFilename f = isObjectSuffix (drop 1 $ takeExtension f)
isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)
isDynLibFilename f = isDynLibSuffix (drop 1 $ takeExtension f)
isSourceFilename f = isSourceSuffix (drop 1 $ takeExtension f)
compiler/main/DriverPipeline.hs
View file @ 7eb5e29b
......@@ -50,6 +50,7 @@ import Control.Exception as Exception
import Data.IORef ( readIORef, writeIORef, IORef )
import GHC.Exts ( Int(..) )
import System.Directory
import System.FilePath
import System.IO
import SYSTEM_IO_ERROR as IO
import Control.Monad
......@@ -57,6 +58,7 @@ import Data.List ( isSuffixOf )
import Data.Maybe
import System.Exit
import System.Environment
import System.FilePath
-- ---------------------------------------------------------------------------
-- Pre-process
......@@ -103,12 +105,14 @@ compile hsc_env summary mod_index nmods mb_old_iface maybe_old_linkable
debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
let (basename, _) = splitFilename input_fn
let basename = dropExtension input_fn
-- We add the directory in which the .hs files resides) to the import path.
-- This is needed when we try to compile the .hc file later, if it
-- imports a _stub.h file that we created here.
let current_dir = directoryOf basename
let current_dir = case takeDirectory basename of
"" -> "." -- XXX Hack
d -> d
old_paths = includePaths dflags0
dflags = dflags0 { includePaths = current_dir : old_paths }
......@@ -227,8 +231,8 @@ compile hsc_env summary mod_index nmods mb_old_iface maybe_old_linkable
compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath
compileStub dflags mod location = do
let (o_base, o_ext) = splitFilename (ml_obj_file location)
stub_o = o_base ++ "_stub" `joinFileExt` o_ext
let (o_base, o_ext) = splitExtension (ml_obj_file location)
stub_o = (o_base ++ "_stub") <.> o_ext
-- compile the _stub.c file w/ gcc
let (stub_c,_,_) = mkStubPaths dflags (moduleName mod) location
......@@ -420,7 +424,8 @@ runPipeline
runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
= do
let
(input_basename, suffix) = splitFilename input_fn
(input_basename, suffix) = splitExtension input_fn
suffix' = drop 1 suffix -- strip off the .
basename | Just b <- mb_basename = b
| otherwise = input_basename
......@@ -428,7 +433,7 @@ runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
-- If we were given a -x flag, then use that phase to start from
start_phase = fromMaybe (startPhase suffix) mb_phase
start_phase = fromMaybe (startPhase suffix') mb_phase
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
......@@ -449,7 +454,7 @@ runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
-- Execute the pipeline...
(dflags', output_fn, maybe_loc) <-
pipeLoop dflags start_phase stop_phase input_fn
basename suffix get_output_fn maybe_loc
basename suffix' get_output_fn maybe_loc
-- Sometimes, a compilation phase doesn't actually generate any output
-- (eg. the CPP phase when -fcpp is not turned on). If we end on this
......@@ -538,11 +543,11 @@ getOutputFilename stop_phase output basename
| StopLn <- next_phase = return odir_persistent
| otherwise = return persistent
persistent = basename `joinFileExt` suffix
persistent = basename <.> suffix
odir_persistent
| Just loc <- maybe_location = ml_obj_file loc
| Just d <- odir = d `joinFileName` persistent
| Just d <- odir = d </> persistent
| otherwise = persistent
......@@ -599,7 +604,7 @@ runPhase (Unlit sf) _stop dflags _basename _suff input_fn get_output_fn maybe_lo
runPhase (Cpp sf) _stop dflags0 basename suff input_fn get_output_fn maybe_loc
= do src_opts <- getOptionsFromFile input_fn
(dflags,unhandled_flags) <- parseDynamicFlags dflags0 (map unLoc src_opts)
checkProcessArgsResult unhandled_flags (basename `joinFileExt` suff)
checkProcessArgsResult unhandled_flags (basename <.> suff)
if not (dopt Opt_Cpp dflags) then
-- no need to preprocess CPP, just pass input file along
......@@ -620,7 +625,7 @@ runPhase (HsPp sf) _stop dflags basename suff input_fn get_output_fn maybe_loc
return (Hsc sf, dflags, maybe_loc, input_fn)
else do
let hspp_opts = getOpts dflags opt_F
let orig_fn = basename `joinFileExt` suff
let orig_fn = basename <.> suff
output_fn <- get_output_fn dflags (Hsc sf) maybe_loc
SysTools.runPp dflags
( [ SysTools.Option orig_fn
......@@ -642,7 +647,9 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
-- we add the current directory (i.e. the directory in which
-- the .hs files resides) to the include path, since this is
-- what gcc does, and it's probably what you want.
let current_dir = directoryOf basename
let current_dir = case takeDirectory basename of
"" -> "." -- XXX Hack
d -> d
paths = includePaths dflags0
dflags = dflags0 { includePaths = current_dir : paths }
......@@ -655,7 +662,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
; return (Nothing, mkModuleName m, [], []) }
_ -> do { buf <- hGetStringBuffer input_fn
; (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename `joinFileExt` suff)
; (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
; return (Just buf, mod_name, imps, src_imps) }
-- Build a ModLocation to pass to hscMain.
......@@ -699,7 +706,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
-- changed (which the compiler itself figures out).
-- Setting source_unchanged to False tells the compiler that M.o is out of
-- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
src_timestamp <- getModificationTime (basename `joinFileExt` suff)
src_timestamp <- getModificationTime (basename <.> suff)
let force_recomp = dopt Opt_ForceRecomp dflags
source_unchanged <-
......@@ -970,7 +977,7 @@ runPhase As _stop dflags _basename _suff input_fn get_output_fn maybe_loc
-- we create directories for the object file, because it
-- might be a hierarchical module.
createDirectoryHierarchy (directoryOf output_fn)
createDirectoryHierarchy (takeDirectory output_fn)
SysTools.runAs dflags
(map SysTools.Option as_opts
......@@ -995,62 +1002,60 @@ runPhase As _stop dflags _basename _suff input_fn get_output_fn maybe_loc
runPhase SplitAs _stop dflags _basename _suff _input_fn get_output_fn maybe_loc
= do
output_fn <- get_output_fn dflags StopLn maybe_loc
let (base_o, _) = splitFilename output_fn
split_odir = base_o ++ "_split"
osuf = objectSuf dflags
createDirectoryHierarchy split_odir
-- remove M_split/ *.o, because we're going to archive M_split/ *.o
-- later and we don't want to pick up any old objects.
fs <- getDirectoryContents split_odir
mapM_ removeFile $ map (split_odir `joinFileName`)
$ filter (osuf `isSuffixOf`) fs
let as_opts = getOpts dflags opt_a
(split_s_prefix, n) <- readIORef v_Split_info
let split_s n = split_s_prefix ++ "__" ++ show n `joinFileExt` "s"
split_obj n = split_odir `joinFileName`
filenameOf base_o ++ "__" ++ show n
`joinFileExt` osuf
let assemble_file n
= SysTools.runAs dflags
(map SysTools.Option as_opts ++
[ SysTools.Option "-c"
, SysTools.Option "-o"
, SysTools.FileOption "" (split_obj n)
, SysTools.FileOption "" (split_s n)
])
mapM_ assemble_file [1..n]
-- and join the split objects into a single object file:
let ld_r args = SysTools.runLink dflags ([
SysTools.Option "-nostdlib",
SysTools.Option "-nodefaultlibs",
SysTools.Option "-Wl,-r",
SysTools.Option ld_x_flag,
SysTools.Option "-o",
SysTools.FileOption "" output_fn ] ++ args)
= do
output_fn <- get_output_fn dflags StopLn maybe_loc
let base_o = dropExtension output_fn
split_odir = base_o ++ "_split"
osuf = objectSuf dflags
createDirectoryHierarchy split_odir
-- remove M_split/ *.o, because we're going to archive M_split/ *.o
-- later and we don't want to pick up any old objects.
fs <- getDirectoryContents split_odir
mapM_ removeFile $ map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
let as_opts = getOpts dflags opt_a
(split_s_prefix, n) <- readIORef v_Split_info
let split_s n = split_s_prefix ++ "__" ++ show n <.> "s"
split_obj n = split_odir </>
takeFileName base_o ++ "__" ++ show n <.> osuf
let assemble_file n
= SysTools.runAs dflags
(map SysTools.Option as_opts ++
[ SysTools.Option "-c"
, SysTools.Option "-o"
, SysTools.FileOption "" (split_obj n)
, SysTools.FileOption "" (split_s n)
])
mapM_ assemble_file [1..n]
-- and join the split objects into a single object file:
let ld_r args = SysTools.runLink dflags ([
SysTools.Option "-nostdlib",
SysTools.Option "-nodefaultlibs",
SysTools.Option "-Wl,-r",
SysTools.Option ld_x_flag,
SysTools.Option "-o",
SysTools.FileOption "" output_fn ] ++ args)
ld_x_flag | null cLD_X = ""
| otherwise = "-Wl,-x"
| otherwise = "-Wl,-x"
if cLdIsGNULd == "YES"
then do
let script = split_odir `joinFileName` "ld.script"
writeFile script $
"INPUT(" ++ unwords (map split_obj [1..n]) ++ ")"
ld_r [SysTools.FileOption "" script]
else do
ld_r (map (SysTools.FileOption "" . split_obj) [1..n])
if cLdIsGNULd == "YES"
then do
let script = split_odir </> "ld.script"
writeFile script $
"INPUT(" ++ unwords (map split_obj [1..n]) ++ ")"
ld_r [SysTools.FileOption "" script]
else do
ld_r (map (SysTools.FileOption "" . split_obj) [1..n])
return (StopLn, dflags, maybe_loc, output_fn)
return (StopLn, dflags, maybe_loc, output_fn)
-- warning suppression
runPhase other _stop _dflags _basename _suff _input_fn _get_output_fn _maybe_loc =
......@@ -1279,10 +1284,10 @@ linkBinary dflags o_files dep_packages = do
exeFileName :: DynFlags -> FilePath
exeFileName dflags
| Just s <- outputFile dflags =
| Just s <- outputFile dflags =
#if defined(mingw32_HOST_OS)
if null (suffixOf s)
then s `joinFileExt` "exe"
if null (takeExtension s)
then s <.> "exe"
else s
#else
s
......@@ -1305,14 +1310,14 @@ maybeCreateManifest _ _ = do
maybeCreateManifest dflags exe_filename = do
if not (dopt Opt_GenManifest dflags) then return [] else do
let manifest_filename = exe_filename `joinFileExt` "manifest"
let manifest_filename = exe_filename <.> "manifest"
writeFile manifest_filename $
"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
" <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
" <assemblyIdentity version=\"1.0.0.0\"\n"++
" processorArchitecture=\"X86\"\n"++
" name=\"" ++ basenameOf exe_filename ++ "\"\n"++
" name=\"" ++ dropExtension exe_filename ++ "\"\n"++
" type=\"win32\"/>\n\n"++
" <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
" <security>\n"++
......@@ -1433,7 +1438,7 @@ linkDynLib dflags o_files dep_packages = do
++ map SysTools.Option (
md_c_flags
++ o_files
++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.3", "-install_name " ++ (pwd `joinFileName` output_fn) ]
++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.3", "-install_name " ++ (pwd </> output_fn) ]
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
......
compiler/main/DynFlags.hs
View file @ 7eb5e29b
......@@ -93,6 +93,7 @@ import Util ( split )
#endif
import Data.Char
import System.FilePath
import System.IO ( hPutStrLn, stderr )
-- -----------------------------------------------------------------------------
......@@ -1573,32 +1574,28 @@ setTmpDir :: FilePath -> DynFlags -> DynFlags
setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
where
#if !defined(mingw32_HOST_OS)
canonicalise p = normalisePath p
canonicalise p = normalise p
#else
-- Canonicalisation of temp path under win32 is a bit more
-- involved: (a) strip trailing slash,
-- (b) normalise slashes
-- (c) just in case, if there is a prefix /cygdrive/x/, change to x:
--
canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
-- if we're operating under cygwin, and TMP/TEMP is of
-- the form "/cygdrive/drive/path", translate this to
-- "drive:/path" (as GHC isn't a cygwin app and doesn't
-- understand /cygdrive paths.)
xltCygdrive path
| "/cygdrive/" `isPrefixOf` path =
case drop (length "/cygdrive/") path of
drive:xs@('/':_) -> drive:':':xs
_ -> path
| otherwise = path
-- strip the trailing backslash (awful, but we only do this once).
removeTrailingSlash path =
case last path of
'/' -> init path
'\\' -> init path
_ -> path
-- Canonicalisation of temp path under win32 is a bit more
-- involved: (a) strip trailing slash,
-- (b) normalise slashes
-- (c) just in case, if there is a prefix /cygdrive/x/, change to x:
canonicalise path = removeTrailingSlash $ normalise $ xltCygdrive path
-- if we're operating under cygwin, and TMP/TEMP is of
-- the form "/cygdrive/drive/path", translate this to
-- "drive:/path" (as GHC isn't a cygwin app and doesn't
-- understand /cygdrive paths.)
cygdrivePrefix = [pathSeparator] ++ "/cygdrive/" ++ [pathSeparator]
xltCygdrive path = case maybePrefixMatch cygdrivePrefix path of
Just (drive:sep:xs))
| isPathSeparator sep -> drive:':':pathSeparator:xs
_ -> path
-- strip the trailing backslash (awful, but we only do this once).
removeTrailingSlash path
| isPathSeparator (last path) = init path
| othwerwise = path
#endif
-----------------------------------------------------------------------------
......
compiler/main/Finder.lhs
View file @ 7eb5e29b
......@@ -42,6 +42,7 @@ import Maybes ( expectJust )
import Data.IORef ( IORef, writeIORef, readIORef, modifyIORef )
import Data.List
import System.Directory
import System.FilePath
import System.IO
import Control.Monad
import System.Time ( ClockTime )
......@@ -346,8 +347,8 @@ searchPathExts paths mod exts
| path <- paths,
(ext,fn) <- exts,
let base | path == "." = basename
| otherwise = path `joinFileName` basename
file = base `joinFileExt` ext
| otherwise = path </> basename
file = base <.> ext
]
search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
......@@ -360,7 +361,7 @@ searchPathExts paths mod exts
mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
-> FilePath -> BaseName -> IO ModLocation
mkHomeModLocationSearched dflags mod suff path basename = do
mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
mkHomeModLocation2 dflags mod (path </> basename) suff
-- -----------------------------------------------------------------------------
-- Constructing a home module location
......@@ -397,7 +398,7 @@ mkHomeModLocationSearched dflags mod suff path basename = do
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
mkHomeModLocation dflags mod src_filename = do
let (basename,extension) = splitFilename src_filename
let (basename,extension) = splitExtension src_filename
mkHomeModLocation2 dflags mod basename extension
mkHomeModLocation2 :: DynFlags
......@@ -411,17 +412,17 @@ mkHomeModLocation2 dflags mod src_basename ext = do
obj_fn <- mkObjPath dflags src_basename mod_basename
hi_fn <- mkHiPath dflags src_basename mod_basename
return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext),
return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
ml_hi_file = hi_fn,
ml_obj_file = obj_fn })
mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
-> IO ModLocation
mkHiOnlyModLocation dflags hisuf path basename
= do let full_basename = path `joinFileName` basename
= do let full_basename = path </> basename
obj_fn <- mkObjPath dflags full_basename basename
return ModLocation{ ml_hs_file = Nothing,
ml_hi_file = full_basename `joinFileExt` 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
......@@ -441,10 +442,10 @@ mkObjPath dflags basename mod_basename
odir = objectDir dflags
osuf = objectSuf dflags
obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
obj_basename | Just dir <- odir = dir </> mod_basename
| otherwise = basename
return (obj_basename `joinFileExt` osuf)
return (obj_basename <.> osuf)
-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
......@@ -458,10 +459,10 @@ mkHiPath dflags basename mod_basename
hidir = hiDir dflags
hisuf = hiSuf dflags
hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
hi_basename | Just dir <- hidir = dir </> mod_basename
| otherwise = basename
return (hi_basename `joinFileExt` hisuf)
return (hi_basename <.> hisuf)
-- -----------------------------------------------------------------------------
......@@ -478,35 +479,35 @@ mkStubPaths
mkStubPaths dflags mod location
= let
stubdir = stubDir dflags
stubdir = stubDir dflags
mod_basename = moduleNameSlashes mod
mod_basename = dots_to_slashes (moduleNameString mod)
src_basename = basenameOf (expectJust "mkStubPaths"
(ml_hs_file location))
stub_basename0
| Just dir <- stubdir = dir `joinFileName` mod_basename
| otherwise = src_basename
stub_basename = stub_basename0 ++ "_stub"
-- this is the filename we're going to use when
-- #including the stub_h file from the .hc file.
-- Without -stubdir, we just #include the basename
-- (eg. for a module A.B, we #include "B_stub.h"),
-- relying on the fact that we add an implicit -I flag
-- for the directory in which the source file resides
-- (see DriverPipeline.hs). With -stubdir, we
-- #include "A/B.h", assuming that the user has added
-- -I<dir> along with -stubdir <dir>.
include_basename
| Just _ <- stubdir = mod_basename
| otherwise = filenameOf src_basename
stub_basename0
| Just dir <- stubdir = dir </> mod_basename
| otherwise = src_basename
stub_basename = stub_basename0 ++ "_stub"
-- this is the filename we're going to use when
-- #including the stub_h file from the .hc file.
-- Without -stubdir, we just #include the basename