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 )
84 #if __GLASGOW_HASKELL__ > 408
85 # if __GLASGOW_HASKELL__ >= 503
89 # ifdef mingw32_TARGET_OS
90 import SystemExts ( rawSystem )
93 import System ( system )
97 #include "HsVersions.h"
99 -- Make catch work on older GHCs
100 #if __GLASGOW_HASKELL__ > 408
101 myCatch = Exception.catch
109 The configuration story
110 ~~~~~~~~~~~~~~~~~~~~~~~
112 GHC needs various support files (library packages, RTS etc), plus
113 various auxiliary programs (cp, gcc, etc). It finds these in one
116 * When running as an *installed program*, GHC finds most of this support
117 stuff in the installed library tree. The path to this tree is passed
118 to GHC via the -B flag, and given to initSysTools .
120 * When running *in-place* in a build tree, GHC finds most of this support
121 stuff in the build tree. The path to the build tree is, again passed
124 GHC tells which of the two is the case by seeing whether package.conf
125 is in TopDir [installed] or in TopDir/ghc/driver [inplace] (what a hack).
128 SysTools.initSysProgs figures out exactly where all the auxiliary programs
129 are, and initialises mutable variables to make it easy to call them.
130 To to this, it makes use of definitions in Config.hs, which is a Haskell
131 file containing variables whose value is figured out by the build system.
133 Config.hs contains two sorts of things
135 cGCC, The *names* of the programs
138 etc They do *not* include paths
141 cUNLIT_DIR_REL The *path* to the directory containing unlit, split etc
142 cSPLIT_DIR_REL *relative* to the root of the build tree,
143 for use when running *in-place* in a build tree (only)
147 ---------------------------------------------
148 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
150 Another hair-brained scheme for simplifying the current tool location
151 nightmare in GHC: Simon originally suggested using another
152 configuration file along the lines of GCC's specs file - which is fine
153 except that it means adding code to read yet another configuration
154 file. What I didn't notice is that the current package.conf is
155 general enough to do this:
158 {name = "tools", import_dirs = [], source_dirs = [],
159 library_dirs = [], hs_libraries = [], extra_libraries = [],
160 include_dirs = [], c_includes = [], package_deps = [],
161 extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${libdir}/bin/unlit", ... etc.],
162 extra_cc_opts = [], extra_ld_opts = []}
164 Which would have the advantage that we get to collect together in one
165 place the path-specific package stuff with the path-specific tool
168 ---------------------------------------------
171 %************************************************************************
173 \subsection{Global variables to contain system programs}
175 %************************************************************************
177 All these pathnames are maintained IN THE NATIVE FORMAT OF THE HOST MACHINE.
178 (See remarks under pathnames below)
181 GLOBAL_VAR(v_Pgm_L, error "pgm_L", String) -- unlit
182 GLOBAL_VAR(v_Pgm_P, error "pgm_P", String) -- cpp
183 GLOBAL_VAR(v_Pgm_F, error "pgm_F", String) -- pp
184 GLOBAL_VAR(v_Pgm_c, error "pgm_c", String) -- gcc
185 GLOBAL_VAR(v_Pgm_m, error "pgm_m", String) -- asm code mangler
186 GLOBAL_VAR(v_Pgm_s, error "pgm_s", String) -- asm code splitter
187 GLOBAL_VAR(v_Pgm_a, error "pgm_a", String) -- as
189 GLOBAL_VAR(v_Pgm_I, error "pgm_I", String) -- ilx2il
190 GLOBAL_VAR(v_Pgm_i, error "pgm_i", String) -- ilasm
192 GLOBAL_VAR(v_Pgm_l, error "pgm_l", String) -- ld
193 GLOBAL_VAR(v_Pgm_MkDLL, error "pgm_dll", String) -- mkdll
195 GLOBAL_VAR(v_Pgm_T, error "pgm_T", String) -- touch
196 GLOBAL_VAR(v_Pgm_CP, error "pgm_CP", String) -- cp
198 GLOBAL_VAR(v_Path_package_config, error "path_package_config", String)
199 GLOBAL_VAR(v_Path_usage, error "ghc_usage.txt", String)
201 GLOBAL_VAR(v_TopDir, error "TopDir", String) -- -B<dir>
203 -- Parallel system only
204 GLOBAL_VAR(v_Pgm_sysman, error "pgm_sysman", String) -- system manager
206 -- ways to get at some of these variables from outside this module
207 getPackageConfigPath = readIORef v_Path_package_config
208 getTopDir = readIORef v_TopDir
212 %************************************************************************
214 \subsection{Initialisation}
216 %************************************************************************
219 initSysTools :: [String] -- Command-line arguments starting "-B"
221 -> IO () -- Set all the mutable variables above, holding
222 -- (a) the system programs
223 -- (b) the package-config file
224 -- (c) the GHC usage message
227 initSysTools minusB_args
228 = do { (am_installed, top_dir) <- findTopDir minusB_args
229 ; writeIORef v_TopDir top_dir
231 -- for "installed" this is the root of GHC's support files
232 -- for "in-place" it is the root of the build tree
233 -- NB: top_dir is assumed to be in standard Unix format '/' separated
235 ; let installed, installed_bin :: FilePath -> FilePath
236 installed_bin pgm = pgmPath top_dir pgm
237 installed file = pgmPath top_dir file
238 inplace dir pgm = pgmPath (top_dir `slash`
239 cPROJECT_DIR `slash` dir) pgm
242 | am_installed = installed "package.conf"
243 | otherwise = inplace cGHC_DRIVER_DIR_REL "package.conf.inplace"
246 | am_installed = installed "ghc-usage.txt"
247 | otherwise = inplace cGHC_DRIVER_DIR_REL "ghc-usage.txt"
249 -- For all systems, unlit, split, mangle are GHC utilities
250 -- architecture-specific stuff is done when building Config.hs
252 | am_installed = installed_bin cGHC_UNLIT_PGM
253 | otherwise = inplace cGHC_UNLIT_DIR_REL cGHC_UNLIT_PGM
255 -- split and mangle are Perl scripts
257 | am_installed = installed_bin cGHC_SPLIT_PGM
258 | otherwise = inplace cGHC_SPLIT_DIR_REL cGHC_SPLIT_PGM
261 | am_installed = installed_bin cGHC_MANGLER_PGM
262 | otherwise = inplace cGHC_MANGLER_DIR_REL cGHC_MANGLER_PGM
264 #ifndef mingw32_TARGET_OS
265 -- check whether TMPDIR is set in the environment
266 ; IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
271 -- On Win32, consult GetTempPath() for a temp dir.
272 -- => it first tries TMP, TEMP, then finally the
273 -- Windows directory(!). The directory is in short-path
274 -- form and *does* have a trailing backslash.
276 let len = (2048::Int)
277 buf <- mallocArray len
278 ret <- getTempPath len buf
281 -- failed, consult TEMP.
282 destructArray len buf
286 destructArray len buf
289 -- strip the trailing backslash (awful, but
290 -- we only do this once).
300 -- Check that the package config exists
301 ; config_exists <- doesFileExist pkgconfig_path
302 ; when (not config_exists) $
303 throwDyn (InstallationError
304 ("Can't find package.conf as " ++ pkgconfig_path))
306 #if defined(mingw32_TARGET_OS)
307 -- WINDOWS-SPECIFIC STUFF
308 -- On Windows, gcc and friends are distributed with GHC,
309 -- so when "installed" we look in TopDir/bin
310 -- When "in-place" we look wherever the build-time configure
312 -- When "install" we tell gcc where its specs file + exes are (-B)
313 -- and also some places to pick up include files. We need
314 -- to be careful to put all necessary exes in the -B place
315 -- (as, ld, cc1, etc) since if they don't get found there, gcc
316 -- then tries to run unadorned "as", "ld", etc, and will
317 -- pick up whatever happens to be lying around in the path,
318 -- possibly including those from a cygwin install on the target,
319 -- which is exactly what we're trying to avoid.
320 ; let gcc_path | am_installed = installed_bin ("gcc -B\"" ++ installed "gcc-lib/\"")
322 -- The trailing "/" is absolutely essential; gcc seems
323 -- to construct file names simply by concatenating to this
324 -- -B path with no extra slash
325 -- We use "/" rather than "\\" because otherwise "\\\" is mangled
326 -- later on; although gcc_path is in NATIVE format, gcc can cope
327 -- (see comments with declarations of global variables)
329 -- The quotes round the -B argument are in case TopDir has spaces in it
331 perl_path | am_installed = installed_bin cGHC_PERL
332 | otherwise = cGHC_PERL
334 -- 'touch' is a GHC util for Windows, and similarly unlit, mangle
335 ; let touch_path | am_installed = installed_bin cGHC_TOUCHY_PGM
336 | otherwise = inplace cGHC_TOUCHY_DIR_REL cGHC_TOUCHY_PGM
338 -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
339 -- a call to Perl to get the invocation of split and mangle
340 ; let split_path = perl_path ++ " \"" ++ split_script ++ "\""
341 mangle_path = perl_path ++ " \"" ++ mangle_script ++ "\""
343 ; let mkdll_path = cMKDLL
345 -- UNIX-SPECIFIC STUFF
346 -- On Unix, the "standard" tools are assumed to be
347 -- in the same place whether we are running "in-place" or "installed"
348 -- That place is wherever the build-time configure script found them.
349 ; let gcc_path = cGCC
351 mkdll_path = panic "Can't build DLLs on a non-Win32 system"
353 -- On Unix, scripts are invoked using the '#!' method. Binary
354 -- installations of GHC on Unix place the correct line on the front
355 -- of the script at installation time, so we don't want to wire-in
356 -- our knowledge of $(PERL) on the host system here.
357 ; let split_path = split_script
358 mangle_path = mangle_script
361 -- cpp is derived from gcc on all platforms
362 ; let cpp_path = gcc_path ++ " -E " ++ cRAWCPP_FLAGS
364 -- For all systems, copy and remove are provided by the host
365 -- system; architecture-specific stuff is done when building Config.hs
366 ; let cp_path = cGHC_CP
368 -- Other things being equal, as and ld are simply gcc
369 ; let as_path = gcc_path
373 -- ilx2il and ilasm are specified in Config.hs
374 ; let ilx2il_path = cILX2IL
378 -- Initialise the global vars
379 ; writeIORef v_Path_package_config pkgconfig_path
380 ; writeIORef v_Path_usage ghc_usage_msg_path
382 ; writeIORef v_Pgm_sysman (top_dir ++ "/ghc/rts/parallel/SysMan")
383 -- Hans: this isn't right in general, but you can
384 -- elaborate it in the same way as the others
386 ; writeIORef v_Pgm_L unlit_path
387 ; writeIORef v_Pgm_P cpp_path
388 ; writeIORef v_Pgm_F ""
389 ; writeIORef v_Pgm_c gcc_path
390 ; writeIORef v_Pgm_m mangle_path
391 ; writeIORef v_Pgm_s split_path
392 ; writeIORef v_Pgm_a as_path
394 ; writeIORef v_Pgm_I ilx2il_path
395 ; writeIORef v_Pgm_i ilasm_path
397 ; writeIORef v_Pgm_l ld_path
398 ; writeIORef v_Pgm_MkDLL mkdll_path
399 ; writeIORef v_Pgm_T touch_path
400 ; writeIORef v_Pgm_CP cp_path
405 #if defined(mingw32_TARGET_OS)
406 foreign import stdcall "GetTempPathA" unsafe getTempPath :: Int -> CString -> IO Int32
410 setPgm is called when a command-line option like
412 is used to override a particular program with a new one
415 setPgm :: String -> IO ()
416 -- The string is the flag, minus the '-pgm' prefix
417 -- So the first character says which program to override
419 setPgm ('P' : pgm) = writeIORef v_Pgm_P pgm
420 setPgm ('F' : pgm) = writeIORef v_Pgm_F pgm
421 setPgm ('c' : pgm) = writeIORef v_Pgm_c pgm
422 setPgm ('m' : pgm) = writeIORef v_Pgm_m pgm
423 setPgm ('s' : pgm) = writeIORef v_Pgm_s pgm
424 setPgm ('a' : pgm) = writeIORef v_Pgm_a pgm
425 setPgm ('l' : pgm) = writeIORef v_Pgm_l pgm
427 setPgm ('I' : pgm) = writeIORef v_Pgm_I pgm
428 setPgm ('i' : pgm) = writeIORef v_Pgm_i pgm
430 setPgm pgm = unknownFlagErr ("-pgm" ++ pgm)
436 -- for "installed" this is the root of GHC's support files
437 -- for "in-place" it is the root of the build tree
440 -- 1. Set proto_top_dir
441 -- a) look for (the last) -B flag, and use it
442 -- b) if there are no -B flags, get the directory
443 -- where GHC is running (only on Windows)
445 -- 2. If package.conf exists in proto_top_dir, we are running
446 -- installed; and TopDir = proto_top_dir
448 -- 3. Otherwise we are running in-place, so
449 -- proto_top_dir will be /...stuff.../ghc/compiler
450 -- Set TopDir to /...stuff..., which is the root of the build tree
452 -- This is very gruesome indeed
454 findTopDir :: [String]
455 -> IO (Bool, -- True <=> am installed, False <=> in-place
456 String) -- TopDir (in Unix format '/' separated)
459 = do { top_dir <- get_proto
460 -- Discover whether we're running in a build tree or in an installation,
461 -- by looking for the package configuration file.
462 ; am_installed <- doesFileExist (top_dir `slash` "package.conf")
464 ; return (am_installed, top_dir)
467 -- get_proto returns a Unix-format path (relying on getExecDir to do so too)
468 get_proto | not (null minusbs)
469 = return (unDosifyPath (drop 2 (last minusbs))) -- 2 for "-B"
471 = do { maybe_exec_dir <- getExecDir -- Get directory of executable
472 ; case maybe_exec_dir of -- (only works on Windows;
473 -- returns Nothing on Unix)
474 Nothing -> throwDyn (InstallationError "missing -B<dir> option")
475 Just dir -> return dir
480 %************************************************************************
482 \subsection{Command-line options}
484 %************************************************************************
486 When invoking external tools as part of the compilation pipeline, we
487 pass these a sequence of options on the command-line. Rather than
488 just using a list of Strings, we use a type that allows us to distinguish
489 between filepaths and 'other stuff'. [The reason being, of course, that
490 this type gives us a handle on transforming filenames, and filenames only,
491 to whatever format they're expected to be on a particular platform.]
495 = FileOption -- an entry that _contains_ filename(s) / filepaths.
496 String -- a non-filepath prefix that shouldn't be transformed (e.g., "/out="
497 String -- the filepath/filename portion
500 showOptions :: [Option] -> String
501 showOptions ls = unwords (map (quote.showOpt) ls)
503 showOpt (FileOption pre f) = pre ++ dosifyPath f
504 showOpt (Option s) = s
506 #if defined(mingw32_TARGET_OS)
508 quote s = "\"" ++ s ++ "\""
516 %************************************************************************
518 \subsection{Running an external program}
520 %************************************************************************
524 runUnlit :: [Option] -> IO ()
525 runUnlit args = do p <- readIORef v_Pgm_L
526 runSomething "Literate pre-processor" p args
528 runCpp :: [Option] -> IO ()
529 runCpp args = do p <- readIORef v_Pgm_P
530 runSomething "C pre-processor" p args
532 runPp :: [Option] -> IO ()
533 runPp args = do p <- readIORef v_Pgm_F
534 runSomething "Haskell pre-processor" p args
536 runCc :: [Option] -> IO ()
537 runCc args = do p <- readIORef v_Pgm_c
538 runSomething "C Compiler" p args
540 runMangle :: [Option] -> IO ()
541 runMangle args = do p <- readIORef v_Pgm_m
542 runSomething "Mangler" p args
544 runSplit :: [Option] -> IO ()
545 runSplit args = do p <- readIORef v_Pgm_s
546 runSomething "Splitter" p args
548 runAs :: [Option] -> IO ()
549 runAs args = do p <- readIORef v_Pgm_a
550 runSomething "Assembler" p args
552 runLink :: [Option] -> IO ()
553 runLink args = do p <- readIORef v_Pgm_l
554 runSomething "Linker" p args
557 runIlx2il :: [Option] -> IO ()
558 runIlx2il args = do p <- readIORef v_Pgm_I
559 runSomething "Ilx2Il" p args
561 runIlasm :: [Option] -> IO ()
562 runIlasm args = do p <- readIORef v_Pgm_i
563 runSomething "Ilasm" p args
566 runMkDLL :: [Option] -> IO ()
567 runMkDLL args = do p <- readIORef v_Pgm_MkDLL
568 runSomething "Make DLL" p args
570 touch :: String -> String -> IO ()
571 touch purpose arg = do p <- readIORef v_Pgm_T
572 runSomething purpose p [FileOption "" arg]
574 copy :: String -> String -> String -> IO ()
575 copy purpose from to = do
576 verb <- dynFlag verbosity
577 when (verb >= 2) $ hPutStrLn stderr ("*** " ++ purpose)
579 h <- openFile to WriteMode
580 ls <- readFile from -- inefficient, but it'll do for now.
581 -- ToDo: speed up via slurping.
587 getSysMan :: IO String -- How to invoke the system manager
588 -- (parallel system only)
589 getSysMan = readIORef v_Pgm_sysman
592 %************************************************************************
594 \subsection{GHC Usage message}
596 %************************************************************************
598 Show the usage message and exit
601 showGhcUsage = do { usage_path <- readIORef v_Path_usage
602 ; usage <- readFile usage_path
604 ; exitWith ExitSuccess }
607 dump ('$':'$':s) = hPutStr stderr progName >> dump s
608 dump (c:s) = hPutChar stderr c >> dump s
612 %************************************************************************
614 \subsection{Managing temporary files
616 %************************************************************************
619 GLOBAL_VAR(v_FilesToClean, [], [String] )
620 GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String )
621 -- v_TmpDir has no closing '/'
625 setTmpDir dir = writeIORef v_TmpDir dir
627 cleanTempFiles :: Int -> IO ()
628 cleanTempFiles verb = do fs <- readIORef v_FilesToClean
629 removeTmpFiles verb fs
631 cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
632 cleanTempFilesExcept verb dont_delete
633 = do fs <- readIORef v_FilesToClean
634 let leftovers = filter (`notElem` dont_delete) fs
635 removeTmpFiles verb leftovers
636 writeIORef v_FilesToClean dont_delete
639 -- find a temporary name that doesn't already exist.
640 newTempName :: Suffix -> IO FilePath
642 = do x <- getProcessID
643 tmp_dir <- readIORef v_TmpDir
644 findTempName tmp_dir x
646 findTempName tmp_dir x
647 = do let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
648 b <- doesFileExist filename
649 if b then findTempName tmp_dir (x+1)
650 else do add v_FilesToClean filename -- clean it up later
653 addFilesToClean :: [FilePath] -> IO ()
654 -- May include wildcards [used by DriverPipeline.run_phase SplitMangle]
655 addFilesToClean files = mapM_ (add v_FilesToClean) files
657 removeTmpFiles :: Int -> [FilePath] -> IO ()
658 removeTmpFiles verb fs
659 = traceCmd "Deleting temp files"
660 ("Deleting: " ++ unwords fs)
663 rm f = removeFile f `myCatch`
666 hPutStrLn stderr ("Warning: deleting non-existent " ++ f)
672 %************************************************************************
674 \subsection{Running a program}
676 %************************************************************************
679 GLOBAL_VAR(v_Dry_run, False, Bool)
682 setDryRun = writeIORef v_Dry_run True
684 -----------------------------------------------------------------------------
685 -- Running an external program
687 runSomething :: String -- For -v message
688 -> String -- Command name (possibly a full path)
689 -- assumed already dos-ified
690 -> [Option] -- Arguments
691 -- runSomething will dos-ify them
694 runSomething phase_name pgm args
695 = traceCmd phase_name cmd_line $
697 #ifndef mingw32_TARGET_OS
698 exit_code <- system cmd_line
700 exit_code <- rawSystem cmd_line
702 ; if exit_code /= ExitSuccess
703 then throwDyn (PhaseFailed phase_name exit_code)
707 cmd_line = pgm ++ ' ':showOptions args -- unwords (pgm : dosifyPaths (map quote args))
708 -- The pgm is already in native format (appropriate dir separators)
709 #if defined(mingw32_TARGET_OS)
711 quote s = "\"" ++ s ++ "\""
716 traceCmd :: String -> String -> IO () -> IO ()
717 -- a) trace the command (at two levels of verbosity)
718 -- b) don't do it at all if dry-run is set
719 traceCmd phase_name cmd_line action
720 = do { verb <- dynFlag verbosity
721 ; when (verb >= 2) $ hPutStrLn stderr ("*** " ++ phase_name)
722 ; when (verb >= 3) $ hPutStrLn stderr cmd_line
726 ; n <- readIORef v_Dry_run
730 ; action `myCatch` handle_exn verb
733 handle_exn verb exn = do { when (verb >= 2) (hPutStr stderr "\n")
734 ; when (verb >= 3) (hPutStrLn stderr ("Failed: " ++ cmd_line))
735 ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
739 %************************************************************************
741 \subsection{Path names}
743 %************************************************************************
745 We maintain path names in Unix form ('/'-separated) right until
746 the last moment. On Windows we dos-ify them just before passing them
747 to the Windows command.
749 The alternative, of using '/' consistently on Unix and '\' on Windows,
750 proved quite awkward. There were a lot more calls to dosifyPath,
751 and even on Windows we might invoke a unix-like utility (eg 'sh'), which
752 interpreted a command line 'foo\baz' as 'foobaz'.
755 -----------------------------------------------------------------------------
756 -- Convert filepath into MSDOS form.
758 dosifyPaths :: [String] -> [String]
759 -- dosifyPaths does two things
760 -- a) change '/' to '\'
761 -- b) remove initial '/cygdrive/'
763 unDosifyPath :: String -> String
764 -- Just change '\' to '/'
766 pgmPath :: String -- Directory string in Unix format
767 -> String -- Program name with no directory separators
769 -> String -- Program invocation string in native format
773 #if defined(mingw32_TARGET_OS)
775 --------------------- Windows version ------------------
776 dosifyPaths xs = map dosifyPath xs
778 unDosifyPath xs = subst '\\' '/' xs
780 pgmPath dir pgm = dosifyPath dir ++ '\\' : pgm
783 = subst '/' '\\' real_stuff
785 -- fully convince myself that /cygdrive/ prefixes cannot
786 -- really appear here.
787 cygdrive_prefix = "/cygdrive/"
790 | cygdrive_prefix `isPrefixOf` stuff = dropList cygdrive_prefix stuff
795 --------------------- Unix version ---------------------
798 pgmPath dir pgm = dir ++ '/' : pgm
799 dosifyPath stuff = stuff
800 --------------------------------------------------------
803 subst a b ls = map (\ x -> if x == a then b else x) ls
807 -----------------------------------------------------------------------------
808 Path name construction
811 slash :: String -> String -> String
812 absPath, relPath :: [String] -> String
815 relPath xs = foldr1 slash xs
817 absPath xs = "" `slash` relPath xs
819 slash s1 s2 = s1 ++ ('/' : s2)
823 %************************************************************************
825 \subsection{Support code}
827 %************************************************************************
830 -----------------------------------------------------------------------------
831 -- Define getExecDir :: IO (Maybe String)
833 #if defined(mingw32_TARGET_OS)
834 getExecDir :: IO (Maybe String)
835 getExecDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
836 buf <- mallocArray len
837 ret <- getModuleFileName nullAddr buf len
838 if ret == 0 then destructArray len buf >> return Nothing
839 else do s <- peekCString buf
840 destructArray len buf
841 return (Just (reverse (dropList "/bin/ghc.exe" (reverse (unDosifyPath s)))))
844 foreign import stdcall "GetModuleFileNameA" unsafe getModuleFileName :: Addr -> CString -> Int -> IO Int32
846 getExecDir :: IO (Maybe String) = do return Nothing
849 #ifdef mingw32_TARGET_OS
850 foreign import "_getpid" unsafe getProcessID :: IO Int -- relies on Int == Int32 on Windows
852 getProcessID :: IO Int
853 getProcessID = Posix.getProcessID
856 #if defined(mingw32_TARGET_OS) && (__GLASGOW_HASKELL__ <= 408)
857 rawSystem :: String -> IO ExitCode
858 rawSystem cmd = system cmd
859 -- mingw only: if you try to build a stage2 compiler with a stage1
860 -- that has been bootstrapped with 4.08 (or earlier), this will run
861 -- into problems with limits on command-line lengths with the std.
862 -- Win32 command interpreters. So don't this - use 5.00 or later
863 -- to compile up the GHC sources.