-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.2 2000/10/11 15:26:18 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.3 2000/10/11 16:26:04 simonmar Exp $
--
-- Driver flags
--
-----------------------------------------------------------------------------
-- parse the dynamic arguments
-GLOBAL_VAR(dynFlags, error "no dynFlags", DynFlags)
+GLOBAL_VAR(v_DynFlags, error "no dynFlags", DynFlags)
setDynFlag f = do
- dfs <- readIORef dynFlags
- writeIORef dynFlags dfs{ flags = f : flags dfs }
+ dfs <- readIORef v_DynFlags
+ writeIORef v_DynFlags dfs{ flags = f : flags dfs }
unSetDynFlag f = do
- dfs <- readIORef dynFlags
- writeIORef dynFlags dfs{ flags = filter (/= f) (flags dfs) }
+ dfs <- readIORef v_DynFlags
+ writeIORef v_DynFlags dfs{ flags = filter (/= f) (flags dfs) }
dynamic_flags = [
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.1 2000/10/11 15:26:18 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.2 2000/10/11 16:26:04 simonmar Exp $
--
-- GHC Driver
--
-----------------------------------------------------------------------------
-- Hsc phase
-{-
run_phase Hsc basename suff input_fn output_fn
- = do hsc <- readIORef pgm_C
+ = do
-- we add the current directory (i.e. the directory in which
-- the .hs files resides) to the import path, since this is
paths <- readIORef include_paths
writeIORef include_paths (current_dir : paths)
- -- build the hsc command line
- hsc_opts <- build_hsc_opts
-
- doing_hi <- readIORef produceHi
- tmp_hi_file <- if doing_hi
- then newTempName "hi"
- else return ""
-
- -- tmp files for foreign export stub code
- tmp_stub_h <- newTempName "stub_h"
- tmp_stub_c <- newTempName "stub_c"
-
-- figure out where to put the .hi file
ohi <- readIORef output_hi
hisuf <- readIORef hi_suf
- let hi_flags = case ohi of
- Nothing -> [ "-hidir="++current_dir, "-hisuf="++hisuf ]
- Just fn -> [ "-hifile="++fn ]
+ let hifile = case ohi of
+ Nothing -> current_dir ++ {-ToDo: modname!!-}basename
+ ++ hisuf
+ Just fn -> fn
-- figure out if the source has changed, for recompilation avoidance.
-- only do this if we're eventually going to generate a .o file.
then return "-fsource-unchanged"
else return ""
+ -- build a bogus ModSummary to pass to hscMain.
+ let summary = ModSummary {
+ ms_loc = SourceOnly (error "no mod") input_fn,
+ ms_ppsource = Just (loc, error "no fingerprint"),
+ ms_imports = error "no imports"
+ }
+
-- run the compiler!
- run_something "Haskell Compiler"
- (unwords (hsc : input_fn : (
- hsc_opts
- ++ hi_flags
- ++ [
- source_unchanged,
- "-ofile="++output_fn,
- "-F="++tmp_stub_c,
- "-FH="++tmp_stub_h
- ]
- )))
-
- -- check whether compilation was performed, bail out if not
- b <- doesFileExist output_fn
- if not b && not (null source_unchanged) -- sanity
- then do run_something "Touching object file"
- ("touch " ++ o_file)
- return False
- else do -- carry on...
+ result <- hscMain dyn_flags mod_summary
+ Nothing{-no iface-}
+ output_fn emptyUFM emptyPCS
+
+ case result of {
+
+ HscErrs pcs errs warns -> do
+ mapM (printSDoc PprForUser) warns
+ mapM (printSDoc PprForUser) errs
+ throwDyn (PhaseFailed "hsc" (ExitFailure 1));
+
+ HscOk details maybe_iface maybe_stub_h maybe_stub_c pcs warns -> do
+
+ mapM (printSDoc PprForUser) warns
+
+ -- generate the interface file
+ case iface of
+ Nothing -> -- compilation not required
+ do run_something "Touching object file" ("touch " ++ o_file)
+ return False
+
+ Just iface ->
-- Deal with stubs
let stub_h = basename ++ "_stub.h"
let stub_c = basename ++ "_stub.c"
-
- -- copy .h_stub file into current dir if present
- b <- doesFileExist tmp_stub_h
- when b (do
+
+ -- copy the .stub_h file into the current dir if necessary
+ case maybe_stub_h of
+ Nothing -> return ()
+ Just tmp_stub_h -> do
run_something "Copy stub .h file"
("cp " ++ tmp_stub_h ++ ' ':stub_h)
-- #include <..._stub.h> in .hc file
addCmdlineHCInclude tmp_stub_h -- hack
- -- copy the _stub.c file into the current dir
+ -- copy the .stub_c file into the current dir, and compile it, if necessary
+ case maybe_stub_c of
+ Nothing -> return ()
+ Just tmp_stub_c -> do -- copy the _stub.c file into the current dir
run_something "Copy stub .c file"
(unwords [
"rm -f", stub_c, "&&",
runPipeline pipeline stub_c False{-no linking-} False{-no -o option-}
add ld_inputs (basename++"_stub.o")
- )
+
return True
--}
-----------------------------------------------------------------------------
-- Cc phase
-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.3 2000/10/11 15:26:18 simonmar Exp $
+-- $Id: DriverState.hs,v 1.4 2000/10/11 16:26:04 simonmar Exp $
--
-- Settings for the driver
--
GLOBAL_VAR(pgm_L, error "pgm_L", String)
GLOBAL_VAR(pgm_P, cRAWCPP, String)
-GLOBAL_VAR(pgm_C, error "pgm_L", String)
GLOBAL_VAR(pgm_c, cGCC, String)
GLOBAL_VAR(pgm_m, error "pgm_m", String)
GLOBAL_VAR(pgm_s, error "pgm_s", String)
:: DynFlags
-> ModSummary -- summary, including source filename
-> Maybe ModIFace -- old interface, if available
- -> String -- file in which to put the output (.s or .c)
+ -> String -- file in which to put the output (.s, .hc, .java etc.)
-> HomeSymbolTable -- for home module ModDetails
-> PersistentCompilerState -- IN: persistent compiler state
- -> IO CompResult -- NB. without the Linkable filled in; the
- -- driver sorts that out.
+ -> IO HscResult
hscMain flags core_cmds stg_cmds summary maybe_old_iface
output_filename mod_details pcs =
\subsection{The result of compiling one module}
%* *
%************************************************************************
+
\begin{code}
data CompResult
= CompOK ModDetails -- new details (HST additions)
[SDoc] -- warnings
+-- The driver sits between 'compile' and 'hscMain', translating calls
+-- to the former into calls to the latter, and results from the latter
+-- into results from the former. It does things like preprocessing
+-- the .hs file if necessary, and compiling up the .stub_c files to
+-- generate Linkables.
+
+data HscResult
+ = HscOK ModDetails -- new details (HomeSymbolTable additions)
+ Maybe ModIFace -- new iface (if any compilation was done)
+ Maybe String -- generated stub_h
+ Maybe String -- generated stub_c
+ PersistentCompilerState -- updated PCS
+ [SDoc] -- warnings
+
+ | HscErrs PersistentCompilerState -- updated PCS
+ [SDoc] -- errors
+ [SDoc] -- warnings
+
+
+
-- These two are only here to avoid recursion between CmCompile and
-- CompManager. They really ought to be in the latter.
type ModuleEnv a = UniqFM a -- Domain is Module
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.4 2000/10/11 15:26:18 simonmar Exp $
+-- $Id: Main.hs,v 1.5 2000/10/11 16:26:04 simonmar Exp $
--
-- GHC Driver program
--
if am_installed
then do writeIORef path_usage (installed "ghc-usage.txt")
writeIORef pgm_L (installed "unlit")
- writeIORef pgm_C (installed "hsc")
writeIORef pgm_m (installed "ghc-asm")
writeIORef pgm_s (installed "ghc-split")
else do writeIORef path_usage (inplace (cGHC_DRIVER_DIR ++ "/ghc-usage.txt"))
writeIORef pgm_L (inplace cGHC_UNLIT)
- writeIORef pgm_C (inplace cGHC_HSC)
writeIORef pgm_m (inplace cGHC_MANGLER)
writeIORef pgm_s (inplace cGHC_SPLIT)
o_files <- mapM compileFile src_pipelines
when (mode == DoMkDependHS) endMkDependHS
-
when (mode == DoLink) (doLink o_files)
-- grab the last -B option on the command line, and
projects / ghc-hetmet.git / commitdiff