diff options
| -rw-r--r-- | ghc/compiler/main/DriverFlags.hs | 12 | ||||
| -rw-r--r-- | ghc/compiler/main/DriverPipeline.hs | 89 | ||||
| -rw-r--r-- | ghc/compiler/main/DriverState.hs | 3 | ||||
| -rw-r--r-- | ghc/compiler/main/HscMain.lhs | 5 | ||||
| -rw-r--r-- | ghc/compiler/main/HscTypes.lhs | 21 | ||||
| -rw-r--r-- | ghc/compiler/main/Main.hs | 5 |
6 files changed, 76 insertions, 59 deletions
diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index f609826a6e..4470862c3f 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 = [ diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 0d88b89aaf..94d8b97fa7 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index e789e5ec25..270e00916b 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index e13368f9ae..cfeadd4c3a 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -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 = diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 3894df95ae..e274124a8a 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -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 diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index e313fbebce..f101b7e63e 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# 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 |