Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
7eb5e29b
Commit
7eb5e29b
authored
Jan 12, 2008
by
Ian Lynagh
Browse files
Use System.FilePath
parent
b70f35af
Changes
14
Hide whitespace changes
Inline
Side-by-side
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 = replace
FilenameSuffix
file osuf
let new_file = replace
Extension
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 (
d
irectory
Of
hi_file_path)
= do createDirectoryHierarchy (
takeD
irectory 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 (
d
irectory
Of
stub_c)
createDirectoryHierarchy (
takeD
irectory 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
)
=
split
Filename
file_name
(
basename
,
suffix
)
=
split
Extension
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
)
=
split
Filename
(
ml_obj_file
location
)
stub_o
=
o_base
++
"_stub"
`
joinFileExt
`
o_ext
let
(
o_base
,
o_ext
)
=
split
Extension
(
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
(
d
irectory
Of
output_fn
)
createDirectoryHierarchy
(
takeD
irectory
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
=
normalise
Path
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) = split
Filename
src_filename
let (basename,extension) = split
Extension
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 = moduleNameS
lashes
mod
mod_basename =
dots_to_slashes (
moduleNameS
tring
mod
)
src_basename = basenameOf (expectJust "mkStubPaths"
(ml_hs_file location))