1 -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow 2001
5 -- Access to system tools: gcc, cp, rm etc
7 -----------------------------------------------------------------------------
13 setPgm, -- String -> IO ()
14 -- Command-line override
17 getTopDir, -- IO String -- The value of $libdir
18 getPackageConfigPath, -- IO String -- Where package.conf is
20 -- Interface to system tools
21 runUnlit, runCpp, runCc, -- [Option] -> IO ()
22 runPp, -- [Option] -> IO ()
23 runMangle, runSplit, -- [Option] -> IO ()
24 runAs, runLink, -- [Option] -> IO ()
27 runIlx2il, runIlasm, -- [String] -> IO ()
31 touch, -- String -> String -> IO ()
32 copy, -- String -> String -> String -> IO ()
33 unDosifyPath, -- String -> String
35 -- Temporary-file management
38 cleanTempFiles, cleanTempFilesExcept, removeTmpFiles,
42 getProcessID, -- IO Int
43 system, -- String -> IO ExitCode
46 showGhcUsage, -- IO () Shows usage message and exits
47 getSysMan, -- IO String Parallel system only
56 import Panic ( progName, GhcException(..) )
57 import Util ( global, dropList )
58 import CmdLineOpts ( dynFlag, verbosity )
60 import Exception ( throwDyn )
61 #if __GLASGOW_HASKELL__ > 408
62 import qualified Exception ( catch )
64 import Exception ( catchAllIO )
67 import Directory ( doesFileExist, removeFile )
68 import IOExts ( IORef, readIORef, writeIORef )
69 import Monad ( when, unless )
70 import System ( ExitCode(..), exitWith, getEnv, system )
75 #include "../includes/config.h"
77 #ifndef mingw32_TARGET_OS
78 import qualified Posix
80 import List ( isPrefixOf )
85 #if __GLASGOW_HASKELL__ > 408
86 # if __GLASGOW_HASKELL__ >= 503
90 # ifdef mingw32_TARGET_OS
91 import SystemExts ( rawSystem )
94 import System ( system )
98 #include "HsVersions.h"
100 -- Make catch work on older GHCs
101 #if __GLASGOW_HASKELL__ > 408
102 myCatch = Exception.catch
110 The configuration story
111 ~~~~~~~~~~~~~~~~~~~~~~~
113 GHC needs various support files (library packages, RTS etc), plus
114 various auxiliary programs (cp, gcc, etc). It finds these in one
117 * When running as an *installed program*, GHC finds most of this support
118 stuff in the installed library tree. The path to this tree is passed
119 to GHC via the -B flag, and given to initSysTools .
121 * When running *in-place* in a build tree, GHC finds most of this support
122 stuff in the build tree. The path to the build tree is, again passed
125 GHC tells which of the two is the case by seeing whether package.conf
126 is in TopDir [installed] or in TopDir/ghc/driver [inplace] (what a hack).
129 SysTools.initSysProgs figures out exactly where all the auxiliary programs
130 are, and initialises mutable variables to make it easy to call them.
131 To to this, it makes use of definitions in Config.hs, which is a Haskell
132 file containing variables whose value is figured out by the build system.
134 Config.hs contains two sorts of things
136 cGCC, The *names* of the programs
139 etc They do *not* include paths
142 cUNLIT_DIR_REL The *path* to the directory containing unlit, split etc
143 cSPLIT_DIR_REL *relative* to the root of the build tree,
144 for use when running *in-place* in a build tree (only)
148 ---------------------------------------------
149 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
151 Another hair-brained scheme for simplifying the current tool location
152 nightmare in GHC: Simon originally suggested using another
153 configuration file along the lines of GCC's specs file - which is fine
154 except that it means adding code to read yet another configuration
155 file. What I didn't notice is that the current package.conf is
156 general enough to do this:
159 {name = "tools", import_dirs = [], source_dirs = [],
160 library_dirs = [], hs_libraries = [], extra_libraries = [],
161 include_dirs = [], c_includes = [], package_deps = [],
162 extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${libdir}/bin/unlit", ... etc.],
163 extra_cc_opts = [], extra_ld_opts = []}
165 Which would have the advantage that we get to collect together in one
166 place the path-specific package stuff with the path-specific tool
169 ---------------------------------------------
172 %************************************************************************
174 \subsection{Global variables to contain system programs}
176 %************************************************************************
178 All these pathnames are maintained IN THE NATIVE FORMAT OF THE HOST MACHINE.
179 (See remarks under pathnames below)
182 GLOBAL_VAR(v_Pgm_L, error "pgm_L", String) -- unlit
183 GLOBAL_VAR(v_Pgm_P, error "pgm_P", String) -- cpp
184 GLOBAL_VAR(v_Pgm_F, error "pgm_F", String) -- pp
185 GLOBAL_VAR(v_Pgm_c, error "pgm_c", String) -- gcc
186 GLOBAL_VAR(v_Pgm_m, error "pgm_m", String) -- asm code mangler
187 GLOBAL_VAR(v_Pgm_s, error "pgm_s", String) -- asm code splitter
188 GLOBAL_VAR(v_Pgm_a, error "pgm_a", String) -- as
190 GLOBAL_VAR(v_Pgm_I, error "pgm_I", String) -- ilx2il
191 GLOBAL_VAR(v_Pgm_i, error "pgm_i", String) -- ilasm
193 GLOBAL_VAR(v_Pgm_l, error "pgm_l", String) -- ld
194 GLOBAL_VAR(v_Pgm_MkDLL, error "pgm_dll", String) -- mkdll
196 GLOBAL_VAR(v_Pgm_T, error "pgm_T", String) -- touch
197 GLOBAL_VAR(v_Pgm_CP, error "pgm_CP", String) -- cp
199 GLOBAL_VAR(v_Path_package_config, error "path_package_config", String)
200 GLOBAL_VAR(v_Path_usage, error "ghc_usage.txt", String)
202 GLOBAL_VAR(v_TopDir, error "TopDir", String) -- -B<dir>
204 -- Parallel system only
205 GLOBAL_VAR(v_Pgm_sysman, error "pgm_sysman", String) -- system manager
207 -- ways to get at some of these variables from outside this module
208 getPackageConfigPath = readIORef v_Path_package_config
209 getTopDir = readIORef v_TopDir
213 %************************************************************************
215 \subsection{Initialisation}
217 %************************************************************************
220 initSysTools :: [String] -- Command-line arguments starting "-B"
222 -> IO () -- Set all the mutable variables above, holding
223 -- (a) the system programs
224 -- (b) the package-config file
225 -- (c) the GHC usage message
228 initSysTools minusB_args
229 = do { (am_installed, top_dir) <- findTopDir minusB_args
230 ; writeIORef v_TopDir top_dir
232 -- for "installed" this is the root of GHC's support files
233 -- for "in-place" it is the root of the build tree
234 -- NB: top_dir is assumed to be in standard Unix format '/' separated
236 ; let installed, installed_bin :: FilePath -> FilePath
237 installed_bin pgm = pgmPath top_dir pgm
238 installed file = pgmPath top_dir file
239 inplace dir pgm = pgmPath (top_dir `slash`
240 cPROJECT_DIR `slash` dir) pgm
243 | am_installed = installed "package.conf"
244 | otherwise = inplace cGHC_DRIVER_DIR_REL "package.conf.inplace"
247 | am_installed = installed "ghc-usage.txt"
248 | otherwise = inplace cGHC_DRIVER_DIR_REL "ghc-usage.txt"
250 -- For all systems, unlit, split, mangle are GHC utilities
251 -- architecture-specific stuff is done when building Config.hs
253 | am_installed = installed_bin cGHC_UNLIT_PGM
254 | otherwise = inplace cGHC_UNLIT_DIR_REL cGHC_UNLIT_PGM
256 -- split and mangle are Perl scripts
258 | am_installed = installed_bin cGHC_SPLIT_PGM
259 | otherwise = inplace cGHC_SPLIT_DIR_REL cGHC_SPLIT_PGM
262 | am_installed = installed_bin cGHC_MANGLER_PGM
263 | otherwise = inplace cGHC_MANGLER_DIR_REL cGHC_MANGLER_PGM
265 #ifndef mingw32_TARGET_OS
266 -- check whether TMPDIR is set in the environment
267 ; IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
272 -- On Win32, consult GetTempPath() for a temp dir.
273 -- => it first tries TMP, TEMP, then finally the
274 -- Windows directory(!). The directory is in short-path
275 -- form and *does* have a trailing backslash.
277 let len = (2048::Int)
278 buf <- mallocArray len
279 ret <- getTempPath len buf
282 -- failed, consult TEMP.
290 -- strip the trailing backslash (awful, but
291 -- we only do this once).
301 -- Check that the package config exists
302 ; config_exists <- doesFileExist pkgconfig_path
303 ; when (not config_exists) $
304 throwDyn (InstallationError
305 ("Can't find package.conf as " ++ pkgconfig_path))
307 #if defined(mingw32_TARGET_OS)
308 -- WINDOWS-SPECIFIC STUFF
309 -- On Windows, gcc and friends are distributed with GHC,
310 -- so when "installed" we look in TopDir/bin
311 -- When "in-place" we look wherever the build-time configure
313 -- When "install" we tell gcc where its specs file + exes are (-B)
314 -- and also some places to pick up include files. We need
315 -- to be careful to put all necessary exes in the -B place
316 -- (as, ld, cc1, etc) since if they don't get found there, gcc
317 -- then tries to run unadorned "as", "ld", etc, and will
318 -- pick up whatever happens to be lying around in the path,
319 -- possibly including those from a cygwin install on the target,
320 -- which is exactly what we're trying to avoid.
321 ; let gcc_path | am_installed = installed_bin ("gcc -B\"" ++ installed "gcc-lib/\"")
323 -- The trailing "/" is absolutely essential; gcc seems
324 -- to construct file names simply by concatenating to this
325 -- -B path with no extra slash
326 -- We use "/" rather than "\\" because otherwise "\\\" is mangled
327 -- later on; although gcc_path is in NATIVE format, gcc can cope
328 -- (see comments with declarations of global variables)
330 -- The quotes round the -B argument are in case TopDir has spaces in it
332 perl_path | am_installed = installed_bin cGHC_PERL
333 | otherwise = cGHC_PERL
335 -- 'touch' is a GHC util for Windows, and similarly unlit, mangle
336 ; let touch_path | am_installed = installed_bin cGHC_TOUCHY_PGM
337 | otherwise = inplace cGHC_TOUCHY_DIR_REL cGHC_TOUCHY_PGM
339 -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
340 -- a call to Perl to get the invocation of split and mangle
341 ; let split_path = perl_path ++ " \"" ++ split_script ++ "\""
342 mangle_path = perl_path ++ " \"" ++ mangle_script ++ "\""
344 ; let mkdll_path = cMKDLL
346 -- UNIX-SPECIFIC STUFF
347 -- On Unix, the "standard" tools are assumed to be
348 -- in the same place whether we are running "in-place" or "installed"
349 -- That place is wherever the build-time configure script found them.
350 ; let gcc_path = cGCC
352 mkdll_path = panic "Can't build DLLs on a non-Win32 system"
354 -- On Unix, scripts are invoked using the '#!' method. Binary
355 -- installations of GHC on Unix place the correct line on the front
356 -- of the script at installation time, so we don't want to wire-in
357 -- our knowledge of $(PERL) on the host system here.
358 ; let split_path = split_script
359 mangle_path = mangle_script
362 -- cpp is derived from gcc on all platforms
363 ; let cpp_path = gcc_path ++ " -E " ++ cRAWCPP_FLAGS
365 -- For all systems, copy and remove are provided by the host
366 -- system; architecture-specific stuff is done when building Config.hs
367 ; let cp_path = cGHC_CP
369 -- Other things being equal, as and ld are simply gcc
370 ; let as_path = gcc_path
374 -- ilx2il and ilasm are specified in Config.hs
375 ; let ilx2il_path = cILX2IL
379 -- Initialise the global vars
380 ; writeIORef v_Path_package_config pkgconfig_path
381 ; writeIORef v_Path_usage ghc_usage_msg_path
383 ; writeIORef v_Pgm_sysman (top_dir ++ "/ghc/rts/parallel/SysMan")
384 -- Hans: this isn't right in general, but you can
385 -- elaborate it in the same way as the others
387 ; writeIORef v_Pgm_L unlit_path
388 ; writeIORef v_Pgm_P cpp_path
389 ; writeIORef v_Pgm_F ""
390 ; writeIORef v_Pgm_c gcc_path
391 ; writeIORef v_Pgm_m mangle_path
392 ; writeIORef v_Pgm_s split_path
393 ; writeIORef v_Pgm_a as_path
395 ; writeIORef v_Pgm_I ilx2il_path
396 ; writeIORef v_Pgm_i ilasm_path
398 ; writeIORef v_Pgm_l ld_path
399 ; writeIORef v_Pgm_MkDLL mkdll_path
400 ; writeIORef v_Pgm_T touch_path
401 ; writeIORef v_Pgm_CP cp_path
406 #if defined(mingw32_TARGET_OS)
407 foreign import stdcall "GetTempPathA" unsafe getTempPath :: Int -> CString -> IO Int32
411 setPgm is called when a command-line option like
413 is used to override a particular program with a new one
416 setPgm :: String -> IO ()
417 -- The string is the flag, minus the '-pgm' prefix
418 -- So the first character says which program to override
420 setPgm ('P' : pgm) = writeIORef v_Pgm_P pgm
421 setPgm ('F' : pgm) = writeIORef v_Pgm_F pgm
422 setPgm ('c' : pgm) = writeIORef v_Pgm_c pgm
423 setPgm ('m' : pgm) = writeIORef v_Pgm_m pgm
424 setPgm ('s' : pgm) = writeIORef v_Pgm_s pgm
425 setPgm ('a' : pgm) = writeIORef v_Pgm_a pgm
426 setPgm ('l' : pgm) = writeIORef v_Pgm_l pgm
428 setPgm ('I' : pgm) = writeIORef v_Pgm_I pgm
429 setPgm ('i' : pgm) = writeIORef v_Pgm_i pgm
431 setPgm pgm = unknownFlagErr ("-pgm" ++ pgm)
437 -- for "installed" this is the root of GHC's support files
438 -- for "in-place" it is the root of the build tree
441 -- 1. Set proto_top_dir
442 -- a) look for (the last) -B flag, and use it
443 -- b) if there are no -B flags, get the directory
444 -- where GHC is running (only on Windows)
446 -- 2. If package.conf exists in proto_top_dir, we are running
447 -- installed; and TopDir = proto_top_dir
449 -- 3. Otherwise we are running in-place, so
450 -- proto_top_dir will be /...stuff.../ghc/compiler
451 -- Set TopDir to /...stuff..., which is the root of the build tree
453 -- This is very gruesome indeed
455 findTopDir :: [String]
456 -> IO (Bool, -- True <=> am installed, False <=> in-place
457 String) -- TopDir (in Unix format '/' separated)
460 = do { top_dir <- get_proto
461 -- Discover whether we're running in a build tree or in an installation,
462 -- by looking for the package configuration file.
463 ; am_installed <- doesFileExist (top_dir `slash` "package.conf")
465 ; return (am_installed, top_dir)
468 -- get_proto returns a Unix-format path (relying on getExecDir to do so too)
469 get_proto | not (null minusbs)
470 = return (unDosifyPath (drop 2 (last minusbs))) -- 2 for "-B"
472 = do { maybe_exec_dir <- getExecDir -- Get directory of executable
473 ; case maybe_exec_dir of -- (only works on Windows;
474 -- returns Nothing on Unix)
475 Nothing -> throwDyn (InstallationError "missing -B<dir> option")
476 Just dir -> return dir
481 %************************************************************************
483 \subsection{Command-line options}
485 %************************************************************************
487 When invoking external tools as part of the compilation pipeline, we
488 pass these a sequence of options on the command-line. Rather than
489 just using a list of Strings, we use a type that allows us to distinguish
490 between filepaths and 'other stuff'. [The reason being, of course, that
491 this type gives us a handle on transforming filenames, and filenames only,
492 to whatever format they're expected to be on a particular platform.]
496 = FileOption -- an entry that _contains_ filename(s) / filepaths.
497 String -- a non-filepath prefix that shouldn't be transformed (e.g., "/out="
498 String -- the filepath/filename portion
501 showOptions :: [Option] -> String
502 showOptions ls = unwords (map (quote.showOpt) ls)
504 showOpt (FileOption pre f) = pre ++ dosifyPath f
505 showOpt (Option s) = s
507 #if defined(mingw32_TARGET_OS)
509 quote s = "\"" ++ s ++ "\""
517 %************************************************************************
519 \subsection{Running an external program}
521 %************************************************************************
525 runUnlit :: [Option] -> IO ()
526 runUnlit args = do p <- readIORef v_Pgm_L
527 runSomething "Literate pre-processor" p args
529 runCpp :: [Option] -> IO ()
530 runCpp args = do p <- readIORef v_Pgm_P
531 runSomething "C pre-processor" p args
533 runPp :: [Option] -> IO ()
534 runPp args = do p <- readIORef v_Pgm_F
535 runSomething "Haskell pre-processor" p args
537 runCc :: [Option] -> IO ()
538 runCc args = do p <- readIORef v_Pgm_c
539 runSomething "C Compiler" p args
541 runMangle :: [Option] -> IO ()
542 runMangle args = do p <- readIORef v_Pgm_m
543 runSomething "Mangler" p args
545 runSplit :: [Option] -> IO ()
546 runSplit args = do p <- readIORef v_Pgm_s
547 runSomething "Splitter" p args
549 runAs :: [Option] -> IO ()
550 runAs args = do p <- readIORef v_Pgm_a
551 runSomething "Assembler" p args
553 runLink :: [Option] -> IO ()
554 runLink args = do p <- readIORef v_Pgm_l
555 runSomething "Linker" p args
558 runIlx2il :: [Option] -> IO ()
559 runIlx2il args = do p <- readIORef v_Pgm_I
560 runSomething "Ilx2Il" p args
562 runIlasm :: [Option] -> IO ()
563 runIlasm args = do p <- readIORef v_Pgm_i
564 runSomething "Ilasm" p args
567 runMkDLL :: [Option] -> IO ()
568 runMkDLL args = do p <- readIORef v_Pgm_MkDLL
569 runSomething "Make DLL" p args
571 touch :: String -> String -> IO ()
572 touch purpose arg = do p <- readIORef v_Pgm_T
573 runSomething purpose p [FileOption "" arg]
575 copy :: String -> String -> String -> IO ()
576 copy purpose from to = do
577 verb <- dynFlag verbosity
578 when (verb >= 2) $ hPutStrLn stderr ("*** " ++ purpose)
580 h <- openFile to WriteMode
581 ls <- readFile from -- inefficient, but it'll do for now.
582 -- ToDo: speed up via slurping.
588 getSysMan :: IO String -- How to invoke the system manager
589 -- (parallel system only)
590 getSysMan = readIORef v_Pgm_sysman
593 %************************************************************************
595 \subsection{GHC Usage message}
597 %************************************************************************
599 Show the usage message and exit
602 showGhcUsage = do { usage_path <- readIORef v_Path_usage
603 ; usage <- readFile usage_path
605 ; exitWith ExitSuccess }
608 dump ('$':'$':s) = hPutStr stderr progName >> dump s
609 dump (c:s) = hPutChar stderr c >> dump s
613 %************************************************************************
615 \subsection{Managing temporary files
617 %************************************************************************
620 GLOBAL_VAR(v_FilesToClean, [], [String] )
621 GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String )
622 -- v_TmpDir has no closing '/'
626 setTmpDir dir = writeIORef v_TmpDir dir
628 cleanTempFiles :: Int -> IO ()
629 cleanTempFiles verb = do fs <- readIORef v_FilesToClean
630 removeTmpFiles verb fs
632 cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
633 cleanTempFilesExcept verb dont_delete
634 = do fs <- readIORef v_FilesToClean
635 let leftovers = filter (`notElem` dont_delete) fs
636 removeTmpFiles verb leftovers
637 writeIORef v_FilesToClean dont_delete
640 -- find a temporary name that doesn't already exist.
641 newTempName :: Suffix -> IO FilePath
643 = do x <- getProcessID
644 tmp_dir <- readIORef v_TmpDir
645 findTempName tmp_dir x
647 findTempName tmp_dir x
648 = do let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
649 b <- doesFileExist filename
650 if b then findTempName tmp_dir (x+1)
651 else do add v_FilesToClean filename -- clean it up later
654 addFilesToClean :: [FilePath] -> IO ()
655 -- May include wildcards [used by DriverPipeline.run_phase SplitMangle]
656 addFilesToClean files = mapM_ (add v_FilesToClean) files
658 removeTmpFiles :: Int -> [FilePath] -> IO ()
659 removeTmpFiles verb fs
660 = traceCmd "Deleting temp files"
661 ("Deleting: " ++ unwords fs)
664 rm f = removeFile f `myCatch`
667 hPutStrLn stderr ("Warning: deleting non-existent " ++ f)
673 %************************************************************************
675 \subsection{Running a program}
677 %************************************************************************
680 GLOBAL_VAR(v_Dry_run, False, Bool)
683 setDryRun = writeIORef v_Dry_run True
685 -----------------------------------------------------------------------------
686 -- Running an external program
688 runSomething :: String -- For -v message
689 -> String -- Command name (possibly a full path)
690 -- assumed already dos-ified
691 -> [Option] -- Arguments
692 -- runSomething will dos-ify them
695 runSomething phase_name pgm args
696 = traceCmd phase_name cmd_line $
698 #ifndef mingw32_TARGET_OS
699 exit_code <- system cmd_line
701 exit_code <- rawSystem cmd_line
703 ; if exit_code /= ExitSuccess
704 then throwDyn (PhaseFailed phase_name exit_code)
708 cmd_line = pgm ++ ' ':showOptions args -- unwords (pgm : dosifyPaths (map quote args))
709 -- The pgm is already in native format (appropriate dir separators)
710 #if defined(mingw32_TARGET_OS)
712 quote s = "\"" ++ s ++ "\""
717 traceCmd :: String -> String -> IO () -> IO ()
718 -- a) trace the command (at two levels of verbosity)
719 -- b) don't do it at all if dry-run is set
720 traceCmd phase_name cmd_line action
721 = do { verb <- dynFlag verbosity
722 ; when (verb >= 2) $ hPutStrLn stderr ("*** " ++ phase_name)
723 ; when (verb >= 3) $ hPutStrLn stderr cmd_line
727 ; n <- readIORef v_Dry_run
731 ; action `myCatch` handle_exn verb
734 handle_exn verb exn = do { when (verb >= 2) (hPutStr stderr "\n")
735 ; when (verb >= 3) (hPutStrLn stderr ("Failed: " ++ cmd_line))
736 ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
740 %************************************************************************
742 \subsection{Path names}
744 %************************************************************************
746 We maintain path names in Unix form ('/'-separated) right until
747 the last moment. On Windows we dos-ify them just before passing them
748 to the Windows command.
750 The alternative, of using '/' consistently on Unix and '\' on Windows,
751 proved quite awkward. There were a lot more calls to dosifyPath,
752 and even on Windows we might invoke a unix-like utility (eg 'sh'), which
753 interpreted a command line 'foo\baz' as 'foobaz'.
756 -----------------------------------------------------------------------------
757 -- Convert filepath into MSDOS form.
759 dosifyPaths :: [String] -> [String]
760 -- dosifyPaths does two things
761 -- a) change '/' to '\'
762 -- b) remove initial '/cygdrive/'
764 unDosifyPath :: String -> String
765 -- Just change '\' to '/'
767 pgmPath :: String -- Directory string in Unix format
768 -> String -- Program name with no directory separators
770 -> String -- Program invocation string in native format
774 #if defined(mingw32_TARGET_OS)
776 --------------------- Windows version ------------------
777 dosifyPaths xs = map dosifyPath xs
779 unDosifyPath xs = subst '\\' '/' xs
781 pgmPath dir pgm = dosifyPath dir ++ '\\' : pgm
784 = subst '/' '\\' real_stuff
786 -- fully convince myself that /cygdrive/ prefixes cannot
787 -- really appear here.
788 cygdrive_prefix = "/cygdrive/"
791 | cygdrive_prefix `isPrefixOf` stuff = dropList cygdrive_prefix stuff
796 --------------------- Unix version ---------------------
799 pgmPath dir pgm = dir ++ '/' : pgm
800 dosifyPath stuff = stuff
801 --------------------------------------------------------
804 subst a b ls = map (\ x -> if x == a then b else x) ls
808 -----------------------------------------------------------------------------
809 Path name construction
812 slash :: String -> String -> String
813 absPath, relPath :: [String] -> String
816 relPath xs = foldr1 slash xs
818 absPath xs = "" `slash` relPath xs
820 slash s1 s2 = s1 ++ ('/' : s2)
824 %************************************************************************
826 \subsection{Support code}
828 %************************************************************************
831 -----------------------------------------------------------------------------
832 -- Define getExecDir :: IO (Maybe String)
834 #if defined(mingw32_TARGET_OS)
835 getExecDir :: IO (Maybe String)
836 getExecDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
837 buf <- mallocArray len
838 ret <- getModuleFileName nullAddr buf len
839 if ret == 0 then free buf >> return Nothing
840 else do s <- peekCString buf
842 return (Just (reverse (dropList "/bin/ghc.exe" (reverse (unDosifyPath s)))))
845 foreign import stdcall "GetModuleFileNameA" unsafe getModuleFileName :: Addr -> CString -> Int -> IO Int32
847 getExecDir :: IO (Maybe String) = do return Nothing
850 #ifdef mingw32_TARGET_OS
851 foreign import "_getpid" unsafe getProcessID :: IO Int -- relies on Int == Int32 on Windows
853 getProcessID :: IO Int
854 getProcessID = Posix.getProcessID
857 #if defined(mingw32_TARGET_OS) && (__GLASGOW_HASKELL__ <= 408)
858 rawSystem :: String -> IO ExitCode
859 rawSystem cmd = system cmd
860 -- mingw only: if you try to build a stage2 compiler with a stage1
861 -- that has been bootstrapped with 4.08 (or earlier), this will run
862 -- into problems with limits on command-line lengths with the std.
863 -- Win32 command interpreters. So don't this - use 5.00 or later
864 -- to compile up the GHC sources.