-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.1 2000/10/11 15:26:18 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.3 2000/10/16 15:16:59 simonmar Exp $
--
-- GHC Driver
--
#include "HsVersions.h"
-import CmSummarise -- for mkdependHS stuff
import DriverState
import DriverUtil
import DriverMkDepend
"only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
-----------------------------------------------------------------------------
--- Phases
-
-{-
-Phase of the | Suffix saying | Flag saying | (suffix of)
-compilation system | ``start here''| ``stop after''| output file
-
-literate pre-processor | .lhs | - | -
-C pre-processor (opt.) | - | -E | -
-Haskell compiler | .hs | -C, -S | .hc, .s
-C compiler (opt.) | .hc or .c | -S | .s
-assembler | .s or .S | -c | .o
-linker | other | - | a.out
--}
-
-data Phase
- = MkDependHS -- haskell dependency generation
- | Unlit
- | Cpp
- | Hsc
- | Cc
- | HCc -- Haskellised C (as opposed to vanilla C) compilation
- | Mangle -- assembly mangling, now done by a separate script.
- | SplitMangle -- after mangler if splitting
- | SplitAs
- | As
- | Ln
- deriving (Eq)
-
--- the first compilation phase for a given file is determined
--- by its suffix.
-startPhase "lhs" = Unlit
-startPhase "hs" = Cpp
-startPhase "hc" = HCc
-startPhase "c" = Cc
-startPhase "raw_s" = Mangle
-startPhase "s" = As
-startPhase "S" = As
-startPhase "o" = Ln
-startPhase _ = Ln -- all unknown file types
-
--- the output suffix for a given phase is uniquely determined by
--- the input requirements of the next phase.
-phase_input_ext Unlit = "lhs"
-phase_input_ext Cpp = "lpp" -- intermediate only
-phase_input_ext Hsc = "cpp" -- intermediate only
-phase_input_ext HCc = "hc"
-phase_input_ext Cc = "c"
-phase_input_ext Mangle = "raw_s"
-phase_input_ext SplitMangle = "split_s" -- not really generated
-phase_input_ext As = "s"
-phase_input_ext SplitAs = "split_s" -- not really generated
-phase_input_ext Ln = "o"
-phase_input_ext MkDependHS = "dep"
-
-haskellish_suffix = (`elem` [ "hs", "lhs", "hc" ])
-cish_suffix = (`elem` [ "c", "s", "S" ]) -- maybe .cc et al.??
-
-haskellish_file f = haskellish_suffix suf where (_,suf) = splitFilename f
-cish_file f = cish_suffix suf where (_,suf) = splitFilename f
-
------------------------------------------------------------------------------
-- genPipeline
--
-- Herein is all the magic about which phases to run in which order, whether
annotatePipeline [] _ = []
annotatePipeline (Ln:_) _ = []
annotatePipeline (phase:next_phase:ps) stop =
- (phase, keep_this_output, phase_input_ext next_phase)
+ (phase, keep_this_output, phaseInputExt next_phase)
: annotatePipeline (next_phase:ps) stop
where
keep_this_output
-----------------------------------------------------------------------------
-- 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.
-- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
do_recomp <- readIORef recomp
todo <- readIORef v_GhcMode
- o_file <- odir_ify (basename ++ '.':phase_input_ext Ln)
+ o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
source_unchanged <-
if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
then return ""
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
projects / ghc-hetmet.git / blobdiff