Commit 215dad7b authored by sof's avatar sof

[project @ 2001-08-10 23:08:25 by sof]

Added SysTools.Option, which lets you identify what are
file-path like options to SysTool.run<Foo>.

Using this, we can now precisely control when to transform
filepaths into a host-compatible format (i.e., we can DOSify
just the right bits under Win32).
parent 858fd614
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.95 2001/08/03 07:44:47 sof Exp $ -- $Id: DriverPipeline.hs,v 1.96 2001/08/10 23:08:25 sof Exp $
-- --
-- GHC Driver -- GHC Driver
-- --
...@@ -327,7 +327,12 @@ run_phase Unlit _basename _suff input_fn output_fn ...@@ -327,7 +327,12 @@ run_phase Unlit _basename _suff input_fn output_fn
-- The -h option passes the file name for unlit to put in a #line directive; -- The -h option passes the file name for unlit to put in a #line directive;
-- we undosify it so that it doesn't contain backslashes in Windows, which -- we undosify it so that it doesn't contain backslashes in Windows, which
-- would disappear in error messages -- would disappear in error messages
SysTools.runUnlit (unlit_flags ++ ["-h", unDosifyPath input_fn, input_fn, output_fn]) SysTools.runUnlit (map SysTools.Option unlit_flags ++
[ SysTools.Option "-h"
, SysTools.Option input_fn
, SysTools.FileOption input_fn
, SysTools.FileOption output_fn
])
return (Just output_fn) return (Just output_fn)
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
...@@ -355,12 +360,16 @@ run_phase Cpp basename suff input_fn output_fn ...@@ -355,12 +360,16 @@ run_phase Cpp basename suff input_fn output_fn
verb <- getVerbFlag verb <- getVerbFlag
(md_c_flags, _) <- machdepCCOpts (md_c_flags, _) <- machdepCCOpts
SysTools.runCpp ([verb] SysTools.runCpp ([SysTools.Option verb]
++ include_paths ++ map SysTools.Option include_paths
++ hs_src_cpp_opts ++ map SysTools.Option hs_src_cpp_opts
++ hscpp_opts ++ map SysTools.Option hscpp_opts
++ md_c_flags ++ map SysTools.Option md_c_flags
++ [ "-x", "c", input_fn, "-o", output_fn ]) ++ [ SysTools.Option "-x c"
, SysTools.FileOption input_fn
, SysTools.Option "-o"
, SysTools.FileOption output_fn
])
return (Just output_fn) return (Just output_fn)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
...@@ -569,8 +578,13 @@ run_phase cc_phase basename suff input_fn output_fn ...@@ -569,8 +578,13 @@ run_phase cc_phase basename suff input_fn output_fn
| otherwise = [ ] | otherwise = [ ]
excessPrecision <- readIORef v_Excess_precision excessPrecision <- readIORef v_Excess_precision
SysTools.runCc ([ "-x", "c", input_fn, "-o", output_fn ] SysTools.runCc ([ SysTools.Option "-x c"
++ md_c_flags , SysTools.FileOption input_fn
, SysTools.Option "-o"
, SysTools.FileOption output_fn
]
++ map SysTools.Option (
md_c_flags
++ (if cc_phase == HCc && mangle ++ (if cc_phase == HCc && mangle
then md_regd_c_flags then md_regd_c_flags
else []) else [])
...@@ -581,7 +595,7 @@ run_phase cc_phase basename suff input_fn output_fn ...@@ -581,7 +595,7 @@ run_phase cc_phase basename suff input_fn output_fn
++ (if excessPrecision then [] else [ "-ffloat-store" ]) ++ (if excessPrecision then [] else [ "-ffloat-store" ])
++ include_paths ++ include_paths
++ pkg_extra_cc_opts ++ pkg_extra_cc_opts
) ))
return (Just output_fn) return (Just output_fn)
-- ToDo: postprocess the output from gcc -- ToDo: postprocess the output from gcc
...@@ -596,9 +610,11 @@ run_phase Mangle _basename _suff input_fn output_fn ...@@ -596,9 +610,11 @@ run_phase Mangle _basename _suff input_fn output_fn
return [ show n_regs ] return [ show n_regs ]
else return [] else return []
SysTools.runMangle (mangler_opts SysTools.runMangle (map SysTools.Option mangler_opts
++ [ input_fn, output_fn ] ++ [ SysTools.FileOption input_fn
++ machdep_opts) , SysTools.FileOption output_fn
]
++ map SysTools.Option machdep_opts)
return (Just output_fn) return (Just output_fn)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
...@@ -610,7 +626,10 @@ run_phase SplitMangle _basename _suff input_fn output_fn ...@@ -610,7 +626,10 @@ run_phase SplitMangle _basename _suff input_fn output_fn
split_s_prefix <- SysTools.newTempName "split" split_s_prefix <- SysTools.newTempName "split"
let n_files_fn = split_s_prefix let n_files_fn = split_s_prefix
SysTools.runSplit [input_fn, split_s_prefix, n_files_fn] SysTools.runSplit [ SysTools.FileOption input_fn
, SysTools.FileOption split_s_prefix
, SysTools.FileOption n_files_fn
]
-- Save the number of split files for future references -- Save the number of split files for future references
s <- readFile n_files_fn s <- readFile n_files_fn
...@@ -630,9 +649,13 @@ run_phase As _basename _suff input_fn output_fn ...@@ -630,9 +649,13 @@ run_phase As _basename _suff input_fn output_fn
= do as_opts <- getOpts opt_a = do as_opts <- getOpts opt_a
cmdline_include_paths <- readIORef v_Include_paths cmdline_include_paths <- readIORef v_Include_paths
SysTools.runAs (as_opts SysTools.runAs (map SysTools.Option as_opts
++ [ "-I" ++ p | p <- cmdline_include_paths ] ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
++ [ "-c", input_fn, "-o", output_fn ]) ++ [ SysTools.Option "-c"
, SysTools.FileOption input_fn
, SysTools.Option "-o"
, SysTools.FileOption output_fn
])
return (Just output_fn) return (Just output_fn)
run_phase SplitAs basename _suff _input_fn output_fn run_phase SplitAs basename _suff _input_fn output_fn
...@@ -650,7 +673,12 @@ run_phase SplitAs basename _suff _input_fn output_fn ...@@ -650,7 +673,12 @@ run_phase SplitAs basename _suff _input_fn output_fn
let output_o = newdir real_odir let output_o = newdir real_odir
(basename ++ "__" ++ show n ++ ".o") (basename ++ "__" ++ show n ++ ".o")
real_o <- osuf_ify output_o real_o <- osuf_ify output_o
SysTools.runAs (as_opts ++ ["-c", "-o", real_o, input_s]) SysTools.runAs (map SysTools.Option as_opts ++
[ SysTools.Option "-c"
, SysTools.Option "-o"
, SysTools.FileOption real_o
, SysTools.FileOption input_s
])
mapM_ assemble_file [1..n] mapM_ assemble_file [1..n]
return (Just output_fn) return (Just output_fn)
...@@ -790,8 +818,12 @@ doLink o_files = do ...@@ -790,8 +818,12 @@ doLink o_files = do
head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ] head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
(md_c_flags, _) <- machdepCCOpts (md_c_flags, _) <- machdepCCOpts
SysTools.runLink ( [verb, "-o", output_fn] SysTools.runLink ( [ SysTools.Option verb
++ md_c_flags , SysTools.Option "-o"
, SysTools.FileOption output_fn
]
++ map SysTools.Option (
md_c_flags
++ o_files ++ o_files
++ extra_os ++ extra_os
++ extra_ld_inputs ++ extra_ld_inputs
...@@ -809,7 +841,7 @@ doLink o_files = do ...@@ -809,7 +841,7 @@ doLink o_files = do
[ "-u", prefixUnderscore "PrelMain_mainIO_closure" , [ "-u", prefixUnderscore "PrelMain_mainIO_closure" ,
"-u", prefixUnderscore "__init_PrelMain"] "-u", prefixUnderscore "__init_PrelMain"]
#endif #endif
else []) else []))
-- parallel only: move binary to another dir -- HWL -- parallel only: move binary to another dir -- HWL
ways_ <- readIORef v_Ways ways_ <- readIORef v_Ways
...@@ -862,8 +894,12 @@ doMkDLL o_files = do ...@@ -862,8 +894,12 @@ doMkDLL o_files = do
(md_c_flags, _) <- machdepCCOpts (md_c_flags, _) <- machdepCCOpts
SysTools.runMkDLL SysTools.runMkDLL
([ verb, "-o", output_fn ] ([ SysTools.Option verb
++ md_c_flags , SysTools.Option "-o"
, SysTools.FileOption output_fn
]
++ map SysTools.Option (
md_c_flags
++ o_files ++ o_files
++ extra_os ++ extra_os
++ [ "--target=i386-mingw32" ] ++ [ "--target=i386-mingw32" ]
...@@ -877,7 +913,7 @@ doMkDLL o_files = do ...@@ -877,7 +913,7 @@ doMkDLL o_files = do
Nothing -> [ "--export-all" ] Nothing -> [ "--export-all" ]
Just _ -> [ "" ]) Just _ -> [ "" ])
++ extra_ld_opts ++ extra_ld_opts
) ))
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Just preprocess a file, put the result in a temp. file (used by the -- Just preprocess a file, put the result in a temp. file (used by the
......
...@@ -17,9 +17,9 @@ module SysTools ( ...@@ -17,9 +17,9 @@ module SysTools (
-- Where package.conf is -- Where package.conf is
-- Interface to system tools -- Interface to system tools
runUnlit, runCpp, runCc,-- [String] -> IO () runUnlit, runCpp, runCc, -- [Option] -> IO ()
runMangle, runSplit, -- [String] -> IO () runMangle, runSplit, -- [Option] -> IO ()
runAs, runLink, -- [String] -> IO () runAs, runLink, -- [Option] -> IO ()
runMkDLL, runMkDLL,
touch, -- String -> String -> IO () touch, -- String -> String -> IO ()
...@@ -38,7 +38,9 @@ module SysTools ( ...@@ -38,7 +38,9 @@ module SysTools (
-- Misc -- Misc
showGhcUsage, -- IO () Shows usage message and exits showGhcUsage, -- IO () Shows usage message and exits
getSysMan -- IO String Parallel system only getSysMan, -- IO String Parallel system only
Option(..)
) where ) where
...@@ -386,6 +388,41 @@ getTopDir minusbs ...@@ -386,6 +388,41 @@ getTopDir minusbs
\end{code} \end{code}
%************************************************************************
%* *
\subsection{Command-line options}
n%* *
%************************************************************************
When invoking external tools as part of the compilation pipeline, we
pass these a sequence of options on the command-line. Rather than
just using a list of Strings, we use a type that allows us to distinguish
between filepaths and 'other stuff'. [The reason being, of course, that
this type gives us a handle on transforming filenames, and filenames only,
to whatever format they're expected to be on a particular platform.]
\begin{code}
data Option
= FileOption String
| Option String
showOptions :: [Option] -> String
showOptions ls = unwords (map (quote.showOpt) ls)
where
showOpt (FileOption f) = dosifyPath f
showOpt (Option s) = s
#if defined(mingw32_TARGET_OS)
quote "" = ""
quote s = "\"" ++ s ++ "\""
#else
quote = id
#endif
\end{code}
%************************************************************************ %************************************************************************
%* * %* *
\subsection{Running an external program} \subsection{Running an external program}
...@@ -394,41 +431,41 @@ n%* * ...@@ -394,41 +431,41 @@ n%* *
\begin{code} \begin{code}
runUnlit :: [String] -> IO () runUnlit :: [Option] -> IO ()
runUnlit args = do p <- readIORef v_Pgm_L runUnlit args = do p <- readIORef v_Pgm_L
runSomething "Literate pre-processor" p args runSomething "Literate pre-processor" p args
runCpp :: [String] -> IO () runCpp :: [Option] -> IO ()
runCpp args = do p <- readIORef v_Pgm_P runCpp args = do p <- readIORef v_Pgm_P
runSomething "C pre-processor" p args runSomething "C pre-processor" p args
runCc :: [String] -> IO () runCc :: [Option] -> IO ()
runCc args = do p <- readIORef v_Pgm_c runCc args = do p <- readIORef v_Pgm_c
runSomething "C Compiler" p args runSomething "C Compiler" p args
runMangle :: [String] -> IO () runMangle :: [Option] -> IO ()
runMangle args = do p <- readIORef v_Pgm_m runMangle args = do p <- readIORef v_Pgm_m
runSomething "Mangler" p args runSomething "Mangler" p args
runSplit :: [String] -> IO () runSplit :: [Option] -> IO ()
runSplit args = do p <- readIORef v_Pgm_s runSplit args = do p <- readIORef v_Pgm_s
runSomething "Splitter" p args runSomething "Splitter" p args
runAs :: [String] -> IO () runAs :: [Option] -> IO ()
runAs args = do p <- readIORef v_Pgm_a runAs args = do p <- readIORef v_Pgm_a
runSomething "Assembler" p args runSomething "Assembler" p args
runLink :: [String] -> IO () runLink :: [Option] -> IO ()
runLink args = do p <- readIORef v_Pgm_l runLink args = do p <- readIORef v_Pgm_l
runSomething "Linker" p args runSomething "Linker" p args
runMkDLL :: [String] -> IO () runMkDLL :: [Option] -> IO ()
runMkDLL args = do p <- readIORef v_Pgm_MkDLL runMkDLL args = do p <- readIORef v_Pgm_MkDLL
runSomething "Make DLL" p args runSomething "Make DLL" p args
touch :: String -> String -> IO () touch :: String -> String -> IO ()
touch purpose arg = do p <- readIORef v_Pgm_T touch purpose arg = do p <- readIORef v_Pgm_T
runSomething purpose p [arg] runSomething purpose p [FileOption arg]
copy :: String -> String -> String -> IO () copy :: String -> String -> String -> IO ()
copy purpose from to = do copy purpose from to = do
...@@ -548,7 +585,7 @@ setDryRun = writeIORef v_Dry_run True ...@@ -548,7 +585,7 @@ setDryRun = writeIORef v_Dry_run True
runSomething :: String -- For -v message runSomething :: String -- For -v message
-> String -- Command name (possibly a full path) -> String -- Command name (possibly a full path)
-- assumed already dos-ified -- assumed already dos-ified
-> [String] -- Arguments -> [Option] -- Arguments
-- runSomething will dos-ify them -- runSomething will dos-ify them
-> IO () -> IO ()
...@@ -565,7 +602,7 @@ runSomething phase_name pgm args ...@@ -565,7 +602,7 @@ runSomething phase_name pgm args
else return () else return ()
} }
where where
cmd_line = unwords (pgm : dosifyPaths (map quote args)) cmd_line = pgm ++ ' ':showOptions args -- unwords (pgm : dosifyPaths (map quote args))
-- The pgm is already in native format (appropriate dir separators) -- The pgm is already in native format (appropriate dir separators)
#if defined(mingw32_TARGET_OS) #if defined(mingw32_TARGET_OS)
quote "" = "" quote "" = ""
...@@ -654,9 +691,10 @@ dosifyPath stuff ...@@ -654,9 +691,10 @@ dosifyPath stuff
#else #else
--------------------- Unix version --------------------- --------------------- Unix version ---------------------
dosifyPaths ps = ps dosifyPaths ps = ps
unDosifyPath xs = xs unDosifyPath xs = xs
pgmPath dir pgm = dir ++ '/' : pgm pgmPath dir pgm = dir ++ '/' : pgm
dosifyPath stuff = stuff
-------------------------------------------------------- --------------------------------------------------------
#endif #endif
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment