Commit 0e5a78df authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-11 16:26:04 by simonmar]

more progress; initial stab at calling hscMain from the driver

Summary:

  * in normal mode, the driver calls hscMain directly.  The
    compilation manager is not involved at all.  This bit is almost
    there, just waiting for hscMain to catch up.

  * in `ghc --make' mode, the driver will hand off control to the
    compilation manager, and provide the `compile' interface.  This
    bit isn't there yet.

  * in `ghc --interactive' mode, the driver will hand off control
    to the user interface (which doesn't exist yet), which will in
    turn invoke the compilation manager, which in turn invokes the
    driver again through the `compile' interface.  None of this
    is there yet.
parent 587d59d7
-----------------------------------------------------------------------------
-- $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
--
......@@ -298,15 +298,15 @@ static_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
--
......@@ -440,9 +440,8 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
-----------------------------------------------------------------------------
-- 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
......@@ -452,24 +451,13 @@ run_phase Hsc basename suff input_fn output_fn
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.
......@@ -495,41 +483,55 @@ run_phase Hsc basename suff input_fn output_fn
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, "&&",
......@@ -542,9 +544,8 @@ run_phase Hsc basename suff input_fn output_fn
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
--
......@@ -658,7 +658,6 @@ way_details =
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)
......
......@@ -54,11 +54,10 @@ hscMain
:: 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 =
......
......@@ -112,6 +112,7 @@ data NameSupply
\subsection{The result of compiling one module}
%* *
%************************************************************************
\begin{code}
data CompResult
= CompOK ModDetails -- new details (HST additions)
......@@ -126,6 +127,26 @@ data CompResult
[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
--
......@@ -132,13 +132,11 @@ main =
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)
......@@ -208,7 +206,6 @@ main =
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
......
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