+
+-----------------------------------------------------------------------------
+-- Compile a single module.
+--
+-- This is the interface between the compilation manager and the
+-- compiler proper (hsc), where we deal with tedious details like
+-- reading the OPTIONS pragma from the source file, and passing the
+-- output of hsc through the C compiler.
+
+compile :: Finder -- to find modules
+ -> ModSummary -- summary, including source
+ -> Maybe ModIFace -- old interface, if available
+ -> HomeSymbolTable -- for home module ModDetails
+ -> PersistentCompilerState -- persistent compiler state
+ -> IO CompResult
+
+compile finder summary old_iface hst pcs = do
+ verb <- readIORef verbose
+ when verb (hPutStrLn stderr ("compile: compiling " ++
+ name_of_summary summary))
+
+ init_dyn_flags <- readIORef v_InitDynFlags
+ writeIORef v_DynFlags init_dyn_flags
+
+ let input_fn = case ms_ppsource summary of
+ Just (ppsource, fingerprint) -> ppsource
+ Nothing -> hs_file (ms_location summary)
+
+ when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
+
+ opts <- getOptionsFromSource input_fn
+ processArgs dynamic_flags opts []
+ dyn_flags <- readIORef v_DynFlags
+
+ output_fn <- case hsc_lang of
+ HscAsm -> newTempName (phaseInputExt As)
+ HscC -> newTempName (phaseInputExt HCc)
+ HscJava -> newTempName "java" -- ToDo
+ HscInterpreter -> return (error "no output file")
+
+ -- run the compiler
+ hsc_result <- hscMain dyn_flags summary old_iface output_fn hst pcs
+
+ case hsc_result of {
+ HscErrs pcs errs warns -> return (CompErrs pcs errs warns);
+
+ HscOK details maybe_iface
+ maybe_stub_h maybe_stub_c maybe_interpreted_code pcs warns -> do
+
+ -- if no compilation happened, bail out early
+ case maybe_iface of {
+ Nothing -> return (CompOK details Nothing pcs warns);
+ Just iface -> do
+
+ let (basename, _) = splitFilename (hs_file (ms_location summary))
+ maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
+ stub_unlinked <- case maybe_stub_o of
+ Nothing -> []
+ Just stub_o -> [ DotO stub_o ]
+
+ hs_unlinked <-
+ case hsc_lang of
+
+ -- in interpreted mode, just return the compiled code
+ -- as our "unlinked" object.
+ HscInterpreter ->
+ case maybe_interpreted_code of
+ Just code -> return (Trees code)
+ Nothing -> panic "compile: no interpreted code"
+
+ -- we're in batch mode: finish the compilation pipeline.
+ _other -> do pipe <- genPipeline (StopBefore Ln) "" output_fn
+ o_file <- runPipeline pipe output_fn False False
+ return [ DotO o_file ]
+
+ let linkable = LM (moduleName (ms_mod summary))
+ (hs_unlinked ++ stub_unlinked)
+
+ return (CompOK details (Just (iface, linkable)) pcs warns)
+ }
+ }
+
+-----------------------------------------------------------------------------
+-- stub .h and .c files (for foreign export support)
+
+dealWithStubs basename maybe_stub_h maybe_stub_c
+
+ = do let stub_h = basename ++ "_stub.h"
+ let stub_c = basename ++ "_stub.c"
+
+ -- 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, and compile it, if necessary
+ case maybe_stub_c of
+ Nothing -> return Nothing
+ 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, "&&",
+ "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
+ "cat", tmp_stub_c, ">> ", stub_c
+ ])
+
+ -- compile the _stub.c file w/ gcc
+ pipeline <- genPipeline (StopBefore Ln) "" stub_c
+ stub_o <- runPipeline pipeline stub_c False{-no linking-}
+ False{-no -o option-}
+
+ return (Just stub_o)