Skip to content

GitLab

Commit 266d3892 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-10-26 16:21:02 by sewardj] 

Compile everything up to Main.  The Really Entertaining News (tm) is that
there are still modules beyond Main to fix up :-)
parent 76c2a7cf
Hide whitespace changes
Inline Side-by-side
ghc/compiler/main/DriverFlags.hs
View file @ 266d3892
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.8 2000/10/24 16:08:16 simonmar Exp $
-- $Id: DriverFlags.hs,v 1.9 2000/10/26 16:21:02 sewardj Exp $
--
-- Driver flags
--
......@@ -152,68 +152,68 @@ static_flags =
exitWith ExitSuccess))
------- verbosity ----------------------------------------------------
, ( "v" , NoArg (writeIORef verbose True) )
, ( "n" , NoArg (writeIORef dry_run True) )
, ( "v" , NoArg (writeIORef v_Verbose True) )
, ( "n" , NoArg (writeIORef v_Dry_run True) )
------- recompilation checker --------------------------------------
, ( "recomp" , NoArg (writeIORef recomp True) )
, ( "no-recomp" , NoArg (writeIORef recomp False) )
, ( "recomp" , NoArg (writeIORef v_Recomp True) )
, ( "no-recomp" , NoArg (writeIORef v_Recomp False) )
------- ways --------------------------------------------------------
, ( "prof" , NoArg (addNoDups ways WayProf) )
, ( "unreg" , NoArg (addNoDups ways WayUnreg) )
, ( "dll" , NoArg (addNoDups ways WayDll) )
, ( "ticky" , NoArg (addNoDups ways WayTicky) )
, ( "parallel" , NoArg (addNoDups ways WayPar) )
, ( "gransim" , NoArg (addNoDups ways WayGran) )
, ( "smp" , NoArg (addNoDups ways WaySMP) )
, ( "debug" , NoArg (addNoDups ways WayDebug) )
, ( "prof" , NoArg (addNoDups v_Ways WayProf) )
, ( "unreg" , NoArg (addNoDups v_Ways WayUnreg) )
, ( "dll" , NoArg (addNoDups v_Ways WayDll) )
, ( "ticky" , NoArg (addNoDups v_Ways WayTicky) )
, ( "parallel" , NoArg (addNoDups v_Ways WayPar) )
, ( "gransim" , NoArg (addNoDups v_Ways WayGran) )
, ( "smp" , NoArg (addNoDups v_Ways WaySMP) )
, ( "debug" , NoArg (addNoDups v_Ways WayDebug) )
-- ToDo: user ways
------ Debugging ----------------------------------------------------
, ( "dppr-noprags", PassFlag (add opt_C) )
, ( "dppr-debug", PassFlag (add opt_C) )
, ( "dppr-user-length", AnySuffix (add opt_C) )
, ( "dppr-noprags", PassFlag (add v_Opt_C) )
, ( "dppr-debug", PassFlag (add v_Opt_C) )
, ( "dppr-user-length", AnySuffix (add v_Opt_C) )
-- rest of the debugging flags are dynamic
------- Interface files ---------------------------------------------
, ( "hi" , NoArg (writeIORef produceHi True) )
, ( "nohi" , NoArg (writeIORef produceHi False) )
, ( "hi" , NoArg (writeIORef v_ProduceHi True) )
, ( "nohi" , NoArg (writeIORef v_ProduceHi False) )
--------- Profiling --------------------------------------------------
, ( "auto-dicts" , NoArg (add opt_C "-fauto-sccs-on-dicts") )
, ( "auto-all" , NoArg (add opt_C "-fauto-sccs-on-all-toplevs") )
, ( "auto" , NoArg (add opt_C "-fauto-sccs-on-exported-toplevs") )
, ( "caf-all" , NoArg (add opt_C "-fauto-sccs-on-individual-cafs") )
, ( "auto-dicts" , NoArg (add v_Opt_C "-fauto-sccs-on-dicts") )
, ( "auto-all" , NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") )
, ( "auto" , NoArg (add v_Opt_C "-fauto-sccs-on-exported-toplevs") )
, ( "caf-all" , NoArg (add v_Opt_C "-fauto-sccs-on-individual-cafs") )
-- "ignore-sccs" doesn't work (ToDo)
, ( "no-auto-dicts" , NoArg (add anti_opt_C "-fauto-sccs-on-dicts") )
, ( "no-auto-all" , NoArg (add anti_opt_C "-fauto-sccs-on-all-toplevs") )
, ( "no-auto" , NoArg (add anti_opt_C "-fauto-sccs-on-exported-toplevs") )
, ( "no-caf-all" , NoArg (add anti_opt_C "-fauto-sccs-on-individual-cafs") )
, ( "no-auto-dicts" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-dicts") )
, ( "no-auto-all" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-all-toplevs") )
, ( "no-auto" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-exported-toplevs") )
, ( "no-caf-all" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-individual-cafs") )
------- Miscellaneous -----------------------------------------------
, ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat
------- Output Redirection ------------------------------------------
, ( "odir" , HasArg (writeIORef output_dir . Just) )
, ( "o" , SepArg (writeIORef output_file . Just) )
, ( "osuf" , HasArg (writeIORef output_suf . Just) )
, ( "hisuf" , HasArg (writeIORef hi_suf) )
, ( "odir" , HasArg (writeIORef v_Output_dir . Just) )
, ( "o" , SepArg (writeIORef v_Output_file . Just) )
, ( "osuf" , HasArg (writeIORef v_Output_suf . Just) )
, ( "hisuf" , HasArg (writeIORef v_Hi_suf) )
, ( "tmpdir" , HasArg (writeIORef v_TmpDir . (++ "/")) )
, ( "ohi" , HasArg (\s -> case s of
"-" -> writeIORef hi_on_stdout True
_ -> writeIORef output_hi (Just s)) )
"-" -> writeIORef v_Hi_on_stdout True
_ -> writeIORef v_Output_hi (Just s)) )
-- -odump?
, ( "keep-hc-file" , AnySuffix (\_ -> writeIORef keep_hc_files True) )
, ( "keep-s-file" , AnySuffix (\_ -> writeIORef keep_s_files True) )
, ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef keep_raw_s_files True) )
, ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef keep_tmp_files True) )
, ( "keep-hc-file" , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
, ( "keep-s-file" , AnySuffix (\_ -> writeIORef v_Keep_s_files True) )
, ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files True) )
, ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) )
, ( "split-objs" , NoArg (if can_split
then do writeIORef split_object_files True
add opt_C "-fglobalise-toplev-names"
then do writeIORef v_Split_object_files True
add v_Opt_C "-fglobalise-toplev-names"
-- TODO!!!!! add opt_c "-DUSE_SPLIT_MARKERS"
else hPutStrLn stderr
"warning: don't know how to split \
......@@ -221,15 +221,15 @@ static_flags =
) )
------- Include/Import Paths ----------------------------------------
, ( "i" , OptPrefix (addToDirList import_paths) )
, ( "I" , Prefix (addToDirList include_paths) )
, ( "i" , OptPrefix (addToDirList v_Import_paths) )
, ( "I" , Prefix (addToDirList v_Include_paths) )
------- Libraries ---------------------------------------------------
, ( "L" , Prefix (addToDirList library_paths) )
, ( "l" , Prefix (add cmdline_libraries) )
, ( "L" , Prefix (addToDirList v_Library_paths) )
, ( "l" , Prefix (add v_Cmdline_libraries) )
------- Packages ----------------------------------------------------
, ( "package-name" , HasArg (\s -> add opt_C ("-inpackage="++s)) )
, ( "package-name" , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
, ( "package" , HasArg (addPackage) )
, ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns
......@@ -239,59 +239,59 @@ static_flags =
, ( "-delete-package" , SepArg (deletePackage) )
------- Specific phases --------------------------------------------
, ( "pgmL" , HasArg (writeIORef pgm_L) )
, ( "pgmP" , HasArg (writeIORef pgm_P) )
, ( "pgmc" , HasArg (writeIORef pgm_c) )
, ( "pgmm" , HasArg (writeIORef pgm_m) )
, ( "pgms" , HasArg (writeIORef pgm_s) )
, ( "pgma" , HasArg (writeIORef pgm_a) )
, ( "pgml" , HasArg (writeIORef pgm_l) )
, ( "optdep" , HasArg (add opt_dep) )
, ( "optl" , HasArg (add opt_l) )
, ( "optdll" , HasArg (add opt_dll) )
, ( "pgmL" , HasArg (writeIORef v_Pgm_L) )
, ( "pgmP" , HasArg (writeIORef v_Pgm_P) )
, ( "pgmc" , HasArg (writeIORef v_Pgm_c) )
, ( "pgmm" , HasArg (writeIORef v_Pgm_m) )
, ( "pgms" , HasArg (writeIORef v_Pgm_s) )
, ( "pgma" , HasArg (writeIORef v_Pgm_a) )
, ( "pgml" , HasArg (writeIORef v_Pgm_l) )
, ( "optdep" , HasArg (add v_Opt_dep) )
, ( "optl" , HasArg (add v_Opt_l) )
, ( "optdll" , HasArg (add v_Opt_dll) )
------ Warning opts -------------------------------------------------
, ( "W" , NoArg (writeIORef warning_opt W_) )
, ( "Wall" , NoArg (writeIORef warning_opt W_all) )
, ( "Wnot" , NoArg (writeIORef warning_opt W_not) )
, ( "w" , NoArg (writeIORef warning_opt W_not) )
, ( "W" , NoArg (writeIORef v_Warning_opt W_) )
, ( "Wall" , NoArg (writeIORef v_Warning_opt W_all) )
, ( "Wnot" , NoArg (writeIORef v_Warning_opt W_not) )
, ( "w" , NoArg (writeIORef v_Warning_opt W_not) )
----- Linker --------------------------------------------------------
, ( "static" , NoArg (writeIORef static True) )
, ( "static" , NoArg (writeIORef v_Static True) )
------ Compiler flags -----------------------------------------------
, ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) )
, ( "O" , OptPrefix (setOptLevel) )
, ( "fasm" , OptPrefix (\_ -> writeIORef hsc_lang HscAsm) )
, ( "fasm" , OptPrefix (\_ -> writeIORef v_Hsc_Lang HscAsm) )
, ( "fvia-c" , NoArg (writeIORef hsc_lang HscC) )
, ( "fvia-C" , NoArg (writeIORef hsc_lang HscC) )
, ( "fvia-c" , NoArg (writeIORef v_Hsc_Lang HscC) )
, ( "fvia-C" , NoArg (writeIORef v_Hsc_Lang HscC) )
, ( "fno-asm-mangling" , NoArg (writeIORef do_asm_mangling False) )
, ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) )
, ( "fmax-simplifier-iterations",
Prefix (writeIORef v_MaxSimplifierIterations . read) )
, ( "fusagesp" , NoArg (do writeIORef v_UsageSPInf True
add opt_C "-fusagesp-on") )
add v_Opt_C "-fusagesp-on") )
, ( "fexcess-precision" , NoArg (do writeIORef excess_precision True
add opt_C "-fexcess-precision"))
, ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
add v_Opt_C "-fexcess-precision"))
-- flags that are "active negatives"
, ( "fno-implicit-prelude" , PassFlag (add opt_C) )
, ( "fno-prune-tydecls" , PassFlag (add opt_C) )
, ( "fno-prune-instdecls" , PassFlag (add opt_C) )
, ( "fno-pre-inlining" , PassFlag (add opt_C) )
, ( "fno-implicit-prelude" , PassFlag (add v_Opt_C) )
, ( "fno-prune-tydecls" , PassFlag (add v_Opt_C) )
, ( "fno-prune-instdecls" , PassFlag (add v_Opt_C) )
, ( "fno-pre-inlining" , PassFlag (add v_Opt_C) )
-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
, ( "fno-", PrefixPred (\s -> isStaticHscFlag ("f"++s))
(\s -> add anti_opt_C ("-f"++s)) )
(\s -> add v_Anti_opt_C ("-f"++s)) )
-- Pass all remaining "-f<blah>" options to hsc
, ( "f", AnySuffixPred (isStaticHscFlag) (add opt_C) )
, ( "f", AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
]
-----------------------------------------------------------------------------
......@@ -427,7 +427,7 @@ floatOpt ref str
buildStaticHscOpts :: IO [String]
buildStaticHscOpts = do
opt_C_ <- getStaticOpts opt_C -- misc hsc opts
opt_C_ <- getStaticOpts v_Opt_C -- misc hsc opts
-- optimisation
minus_o <- readIORef v_OptLevel
......@@ -444,14 +444,14 @@ buildStaticHscOpts = do
-- take into account -fno-* flags by removing the equivalent -f*
-- flag from our list.
anti_flags <- getStaticOpts anti_opt_C
anti_flags <- getStaticOpts v_Anti_opt_C
let basic_opts = opt_C_ ++ optimisation_opts ++ stg_opts
filtered_opts = filter (`notElem` anti_flags) basic_opts
verb <- is_verbose
let hi_vers = "-fhi-version="++cProjectVersionInt
static <- (do s <- readIORef static; if s then return "-static"
else return "")
static <- (do s <- readIORef v_Static; if s then return "-static"
else return "")
return ( filtered_opts ++ [ hi_vers, static, verb ] )
ghc/compiler/main/DriverMkDepend.hs
View file @ 266d3892
-----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.2 2000/10/17 13:22:10 simonmar Exp $
-- $Id: DriverMkDepend.hs,v 1.3 2000/10/26 16:21:02 sewardj Exp $
--
-- GHC Driver
--
......@@ -32,17 +32,17 @@ import Maybe
-- mkdependHS
-- flags
GLOBAL_VAR(dep_makefile, "Makefile", String);
GLOBAL_VAR(dep_include_prelude, False, Bool);
GLOBAL_VAR(dep_ignore_dirs, [], [String]);
GLOBAL_VAR(dep_suffixes, [], [String]);
GLOBAL_VAR(dep_warnings, True, Bool);
GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
GLOBAL_VAR(v_Dep_include_prelude, False, Bool);
GLOBAL_VAR(v_Dep_ignore_dirs, [], [String]);
GLOBAL_VAR(v_Dep_suffixes, [], [String]);
GLOBAL_VAR(v_Dep_warnings, True, Bool);
-- global vars
GLOBAL_VAR(dep_makefile_hdl, error "dep_makefile_hdl", Maybe Handle);
GLOBAL_VAR(dep_tmp_file, error "dep_tmp_file", String);
GLOBAL_VAR(dep_tmp_hdl, error "dep_tmp_hdl", Handle);
GLOBAL_VAR(dep_dir_contents, error "dep_dir_contents", [(String,[String])]);
GLOBAL_VAR(v_Dep_makefile_hdl, error "dep_makefile_hdl", Maybe Handle);
GLOBAL_VAR(v_Dep_tmp_file, error "dep_tmp_file", String);
GLOBAL_VAR(v_Dep_tmp_hdl, error "dep_tmp_hdl", Handle);
GLOBAL_VAR(v_Dep_dir_contents, error "dep_dir_contents", [(String,[String])]);
depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
......@@ -50,39 +50,39 @@ depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
-- for compatibility with the old mkDependHS, we accept options of the form
-- -optdep-f -optdep.depend, etc.
dep_opts = [
( "s", SepArg (add dep_suffixes) ),
( "f", SepArg (writeIORef dep_makefile) ),
( "w", NoArg (writeIORef dep_warnings False) ),
( "-include-prelude", NoArg (writeIORef dep_include_prelude True) ),
( "X", Prefix (addToDirList dep_ignore_dirs) ),
( "-exclude-directory=", Prefix (addToDirList dep_ignore_dirs) )
( "s", SepArg (add v_Dep_suffixes) ),
( "f", SepArg (writeIORef v_Dep_makefile) ),
( "w", NoArg (writeIORef v_Dep_warnings False) ),
( "-include-prelude", NoArg (writeIORef v_Dep_include_prelude True) ),
( "X", Prefix (addToDirList v_Dep_ignore_dirs) ),
( "-exclude-directory=", Prefix (addToDirList v_Dep_ignore_dirs) )
]
beginMkDependHS :: IO ()
beginMkDependHS = do
-- slurp in the mkdependHS-style options
flags <- getStaticOpts opt_dep
flags <- getStaticOpts v_Opt_dep
_ <- processArgs dep_opts flags []
-- open a new temp file in which to stuff the dependency info
-- as we go along.
dep_file <- newTempName "dep"
writeIORef dep_tmp_file dep_file
writeIORef v_Dep_tmp_file dep_file
tmp_hdl <- openFile dep_file WriteMode
writeIORef dep_tmp_hdl tmp_hdl
writeIORef v_Dep_tmp_hdl tmp_hdl
-- open the makefile
makefile <- readIORef dep_makefile
makefile <- readIORef v_Dep_makefile
exists <- doesFileExist makefile
if not exists
then do
writeIORef dep_makefile_hdl Nothing
writeIORef v_Dep_makefile_hdl Nothing
return ()
else do
makefile_hdl <- openFile makefile ReadMode
writeIORef dep_makefile_hdl (Just makefile_hdl)
writeIORef v_Dep_makefile_hdl (Just makefile_hdl)
-- slurp through until we get the magic start string,
-- copying the contents into dep_makefile
......@@ -111,28 +111,28 @@ beginMkDependHS = do
-- cache the contents of all the import directories, for future
-- reference.
import_dirs <- readIORef import_paths
import_dirs <- readIORef v_Import_paths
pkg_import_dirs <- getPackageImportPath
import_dir_contents <- mapM getDirectoryContents import_dirs
pkg_import_dir_contents <- mapM getDirectoryContents pkg_import_dirs
writeIORef dep_dir_contents
writeIORef v_Dep_dir_contents
(zip import_dirs import_dir_contents ++
zip pkg_import_dirs pkg_import_dir_contents)
-- ignore packages unless --include-prelude is on
include_prelude <- readIORef dep_include_prelude
include_prelude <- readIORef v_Dep_include_prelude
when (not include_prelude) $
mapM_ (add dep_ignore_dirs) pkg_import_dirs
mapM_ (add v_Dep_ignore_dirs) pkg_import_dirs
return ()
endMkDependHS :: IO ()
endMkDependHS = do
makefile <- readIORef dep_makefile
makefile_hdl <- readIORef dep_makefile_hdl
tmp_file <- readIORef dep_tmp_file
tmp_hdl <- readIORef dep_tmp_hdl
makefile <- readIORef v_Dep_makefile
makefile_hdl <- readIORef v_Dep_makefile_hdl
tmp_file <- readIORef v_Dep_tmp_file
tmp_hdl <- readIORef v_Dep_tmp_hdl
-- write the magic marker into the tmp file
hPutStrLn tmp_hdl depEndMarker
......@@ -166,9 +166,9 @@ endMkDependHS = do
findDependency :: String -> ModImport -> IO (Maybe (String, Bool))
findDependency mod imp = do
dir_contents <- readIORef dep_dir_contents
ignore_dirs <- readIORef dep_ignore_dirs
hisuf <- readIORef hi_suf
dir_contents <- readIORef v_Dep_dir_contents
ignore_dirs <- readIORef v_Dep_ignore_dirs
hisuf <- readIORef v_Hi_suf
let
(imp_mod, is_source) =
......
ghc/compiler/main/DriverPipeline.hs
View file @ 266d3892
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.7 2000/10/26 14:38:42 simonmar Exp $
-- $Id: DriverPipeline.hs,v 1.8 2000/10/26 16:21:02 sewardj Exp $
--
-- GHC Driver
--
......@@ -38,6 +38,7 @@ import Module
import CmdLineOpts
import Config
import Util
import MkIface ( pprIface )
import Posix
import Directory
......@@ -131,12 +132,12 @@ genPipeline
genPipeline todo stop_flag filename
= do
split <- readIORef split_object_files
mangle <- readIORef do_asm_mangling
lang <- readIORef hsc_lang
keep_hc <- readIORef keep_hc_files
keep_raw_s <- readIORef keep_raw_s_files
keep_s <- readIORef keep_s_files
split <- readIORef v_Split_object_files
mangle <- readIORef v_Do_asm_mangling
lang <- readIORef v_Hsc_Lang
keep_hc <- readIORef v_Keep_hc_files
keep_raw_s <- readIORef v_Keep_raw_s_files
keep_s <- readIORef v_Keep_s_files
let
----------- ----- ---- --- -- -- - - -
......@@ -273,7 +274,7 @@ pipeLoop ((phase, keep, o_suffix):phases)
where
outputFileName last_phase keep suffix
= do o_file <- readIORef output_file
= do o_file <- readIORef v_Output_file
if last_phase && not do_linking && use_ofile && isJust o_file
then case o_file of
Just s -> return s
......@@ -287,7 +288,7 @@ pipeLoop ((phase, keep, o_suffix):phases)
-- Unlit phase
run_phase Unlit _basename _suff input_fn output_fn
= do unlit <- readIORef pgm_L
= do unlit <- readIORef v_Pgm_L
unlit_flags <- getOpts opt_L
run_something "Literate pre-processor"
("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
......@@ -304,11 +305,11 @@ run_phase Cpp _basename _suff input_fn output_fn
do_cpp <- readState cpp_flag
if do_cpp
then do
cpp <- readIORef pgm_P
cpp <- readIORef v_Pgm_P
hscpp_opts <- getOpts opt_P
hs_src_cpp_opts <- readIORef hs_source_cpp_opts
hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
cmdline_include_paths <- readIORef include_paths
cmdline_include_paths <- readIORef v_Include_paths
pkg_include_dirs <- getPackageIncludePath
let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
++ pkg_include_dirs)
......@@ -339,18 +340,18 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
deps <- mapM (findDependency basename) imports
osuf_opt <- readIORef output_suf
osuf_opt <- readIORef v_Output_suf
let osuf = case osuf_opt of
Nothing -> "o"
Just s -> s
extra_suffixes <- readIORef dep_suffixes
extra_suffixes <- readIORef v_Dep_suffixes
let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
ofiles = map (\suf -> basename ++ '.':suf) suffixes
objs <- mapM odir_ify ofiles
hdl <- readIORef dep_tmp_hdl
hdl <- readIORef v_Dep_tmp_hdl
-- std dependeny of the object(s) on the source file
hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
......@@ -358,7 +359,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
let genDep (dep, False {- not an hi file -}) =
hPutStrLn hdl (unwords objs ++ " : " ++ dep)
genDep (dep, True {- is an hi file -}) = do
hisuf <- readIORef hi_suf
hisuf <- readIORef v_Hi_suf
let dep_base = remove_suffix '.' dep
deps = (dep_base ++ hisuf)
: map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
......@@ -398,12 +399,12 @@ run_phase Hsc basename suff input_fn output_fn
-- what gcc does, and it's probably what you want.
let current_dir = getdir basename
paths <- readIORef include_paths
writeIORef include_paths (current_dir : paths)
paths <- readIORef v_Include_paths
writeIORef v_Include_paths (current_dir : paths)
-- figure out where to put the .hi file
ohi <- readIORef output_hi
hisuf <- readIORef hi_suf
ohi <- readIORef v_Output_hi
hisuf <- readIORef v_Hi_suf
let hifile = case ohi of
Nothing -> current_dir ++ {-ToDo: modname!!-}basename
++ hisuf
......@@ -418,7 +419,7 @@ run_phase Hsc basename suff input_fn output_fn
-- changed (which the compiler itself figures out).
-- Setting source_unchanged to "" tells the compiler that M.o is out of
-- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
do_recomp <- readIORef recomp
do_recomp <- readIORef v_Recomp
todo <- readIORef v_GhcMode
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
source_unchanged <-
......@@ -451,7 +452,6 @@ run_phase Hsc basename suff input_fn output_fn
Nothing -- no iface
emptyModuleEnv -- HomeSymbolTable
emptyModuleEnv -- HomeIfaceTable
emptyModuleEnv -- PackageIfaceTable
pcs
case result of {
......@@ -461,31 +461,11 @@ run_phase Hsc basename suff input_fn output_fn
HscOK details maybe_iface maybe_stub_h maybe_stub_c
_maybe_interpreted_code pcs -> do
-- generate the interface file
case maybe_iface of
Nothing -> -- compilation not required
do run_something "Touching object file" ("touch " ++ o_file)
return False
Just iface -> do
-- discover the filename for the .hi file in a roundabout way
let mod = moduleString (mi_module iface)
ohi <- readIORef output_hi
hifile <- case ohi of
Just fn -> fn
Nothing -> do hisuf <- readIORef hi_suf
return (current_dir ++
'/'mod ++ '.':hisuf)
-- write out the interface...
if_hdl <- openFile hifile WriteMode
printForIface if_hdl (pprIface iface)
hClose if_hdl
-- deal with stubs
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
case maybe_stub_o of
Nothing -> return ()
Just stub_o -> add ld_inputs stub_o
Just stub_o -> add v_Ld_inputs stub_o
return True
}
......@@ -498,9 +478,9 @@ run_phase Hsc basename suff input_fn output_fn
run_phase cc_phase _basename _suff input_fn output_fn
| cc_phase == Cc || cc_phase == HCc
= do cc <- readIORef pgm_c
= do cc <- readIORef v_Pgm_c
cc_opts <- (getOpts opt_c)
cmdline_include_dirs <- readIORef include_paths
cmdline_include_dirs <- readIORef v_Include_paths
let hcc = cc_phase == HCc
......@@ -531,7 +511,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
ccout <- newTempName "ccout"
mangle <- readIORef do_asm_mangling
mangle <- readIORef v_Do_asm_mangling
(md_c_flags, md_regd_c_flags) <- machdepCCOpts
verb <- is_verbose
......@@ -542,7 +522,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
pkg_extra_cc_opts <- getPackageExtraCcOpts
excessPrecision <- readIORef excess_precision
excessPrecision <- readIORef v_Excess_precision
run_something "C Compiler"
(unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
......@@ -569,7 +549,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
-- Mangle phase
run_phase Mangle _basename _suff input_fn output_fn
= do mangler <- readIORef pgm_m
= do mangler <- readIORef v_Pgm_m
mangler_opts <- getOpts opt_m
machdep_opts <-
if (prefixMatch "i386" cTARGETPLATFORM)
......@@ -588,13 +568,13 @@ run_phase Mangle _basename _suff input_fn output_fn
-- Splitting phase
run_phase SplitMangle _basename _suff input_fn _output_fn
= do splitter <- readIORef pgm_s
= do splitter <- readIORef v_Pgm_s
-- this is the prefix used for the split .s files
tmp_pfx <- readIORef v_TmpDir
x <- getProcessID
let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
writeIORef split_prefix split_s_prefix
writeIORef v_Split_prefix split_s_prefix
addFilesToClean [split_s_prefix ++ "__*"] -- d:-)
-- allocate a tmp file to put the no. of split .s files in (sigh)
......@@ -610,17 +590,17 @@ run_phase SplitMangle _basename _suff input_fn _output_fn
-- save the number of split files for future references
s <- readFile n_files
let n = read s :: Int
<