[project @ 2000-11-14 17:41:04 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / DriverPipeline.hs
index c569aec..f1e9618 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.3 2000/10/16 15:16:59 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.25 2000/11/14 17:41:04 sewardj Exp $
 --
 -- GHC Driver
 --
@@ -8,26 +8,39 @@
 -----------------------------------------------------------------------------
 
 module DriverPipeline (
+
+       -- interfaces for the batch-mode driver
    GhcMode(..), getGhcMode, v_GhcMode,
    genPipeline, runPipeline,
-   preprocess,
-   doLink,
+
+       -- interfaces for the compilation manager (interpreted/batch-mode)
+   preprocess, compile, CompResult(..),
+
+       -- batch-mode linking interface
+   doLink
   ) where
 
 #include "HsVersions.h"
 
+import CmSummarise
+import CmLink
 import DriverState
 import DriverUtil
 import DriverMkDepend
+import DriverPhases
 import DriverFlags
+import HscMain
 import TmpFiles
+import HscTypes
+import Outputable
+import Module
+import CmdLineOpts
 import Config
 import Util
-import CmdLineOpts
-import Panic
 
+import Directory
+import System
 import IOExts
-import Posix
 import Exception
 
 import IO
@@ -106,6 +119,8 @@ data IntermediateFileType
 genPipeline
    :: GhcMode          -- when to stop
    -> String           -- "stop after" flag (for error messages)
+   -> Bool             -- True => output is persistent
+   -> HscLang          -- preferred output language for hsc
    -> String           -- original filename
    -> IO [             -- list of phases to run for this file
             (Phase,
@@ -113,14 +128,14 @@ genPipeline
              String)                -- output file suffix
          ]     
 
-genPipeline todo stop_flag filename
+genPipeline todo stop_flag persistent_output lang filename 
  = do
-   split      <- readIORef split_object_files
-   mangle     <- readIORef do_asm_mangling
-   lang       <- readIORef hsc_lang
-   keep_hc    <- readIORef keep_hc_files
-   keep_raw_s <- readIORef keep_raw_s_files
-   keep_s     <- readIORef keep_s_files
+   split      <- readIORef v_Split_object_files
+   mangle     <- readIORef v_Do_asm_mangling
+   keep_hc    <- readIORef v_Keep_hc_files
+   keep_raw_s <- readIORef v_Keep_raw_s_files
+   keep_s     <- readIORef v_Keep_s_files
+   osuf       <- readIORef v_Object_suf
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
@@ -131,11 +146,9 @@ genPipeline todo stop_flag filename
     haskellish = haskellish_suffix suffix
     cish = cish_suffix suffix
 
-   -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
-    real_lang 
-       | suffix == "hc"  = HscC
-       | todo == StopBefore HCc && lang /= HscC && haskellish = HscC
-       | otherwise = lang
+   -- for a .hc file we need to force lang to HscC
+    real_lang | start_phase == HCc  = HscC
+             | otherwise           = lang
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
@@ -184,6 +197,10 @@ genPipeline todo stop_flag filename
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
+      myPhaseInputExt Ln = case osuf of Nothing -> phaseInputExt Ln
+                                       Just s  -> s
+      myPhaseInputExt other = phaseInputExt other
+
       annotatePipeline
         :: [Phase]             -- raw pipeline
         -> Phase               -- phase to stop before
@@ -191,13 +208,14 @@ genPipeline todo stop_flag filename
       annotatePipeline []     _    = []
       annotatePipeline (Ln:_) _    = []
       annotatePipeline (phase:next_phase:ps) stop = 
-         (phase, keep_this_output, phaseInputExt next_phase)
+         (phase, keep_this_output, myPhaseInputExt next_phase)
             : annotatePipeline (next_phase:ps) stop
          where
                keep_this_output
-                    | next_phase == stop = Persistent
-                    | otherwise =
-                       case next_phase of
+                    | next_phase == stop 
+                     = if persistent_output then Persistent else Temporary
+                    | otherwise
+                    = case next_phase of
                             Ln -> Persistent
                             Mangle | keep_raw_s -> Persistent
                             As     | keep_s     -> Persistent
@@ -249,31 +267,24 @@ pipeLoop ((phase, keep, o_suffix):phases)
                return ofile
        else do -- carry on ...
 
-       -- sadly, ghc -E is supposed to write the file to stdout.  We
-       -- generate <file>.cpp, so we also have to cat the file here.
-     when (null phases && phase == Cpp) $
-       run_something "Dump pre-processed file to stdout"
-                     ("cat " ++ output_fn)
-
      pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
 
   where
      outputFileName last_phase keep suffix
-       = do o_file <- readIORef output_file
+       = do o_file <- readIORef v_Output_file
             if last_phase && not do_linking && use_ofile && isJust o_file
               then case o_file of 
                       Just s  -> return s
                       Nothing -> error "outputFileName"
               else if keep == Persistent
-                          then do f <- odir_ify (orig_basename ++ '.':suffix)
-                                  osuf_ify f
+                          then odir_ify (orig_basename ++ '.':suffix)
                           else newTempName suffix
 
 -------------------------------------------------------------------------------
 -- Unlit phase 
 
 run_phase Unlit _basename _suff input_fn output_fn
-  = do unlit <- readIORef pgm_L
+  = do unlit <- readIORef v_Pgm_L
        unlit_flags <- getOpts opt_L
        run_something "Literate pre-processor"
          ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
@@ -283,20 +294,24 @@ run_phase Unlit _basename _suff input_fn output_fn
 -------------------------------------------------------------------------------
 -- Cpp phase 
 
-run_phase Cpp _basename _suff input_fn output_fn
+run_phase Cpp basename suff input_fn output_fn
   = do src_opts <- getOptionsFromSource input_fn
-       -- ToDo: this is *wrong* if we're processing more than one file:
-       -- the OPTIONS will persist through the subsequent compilations.
-       _ <- processArgs dynamic_flags src_opts []
+       unhandled_flags <- processArgs dynamic_flags src_opts []
+
+       when (not (null unhandled_flags)) 
+            (throwDyn (OtherError (
+                          basename ++ "." ++ suff 
+                          ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
+                          ++ unwords unhandled_flags)) (ExitFailure 1))
 
        do_cpp <- readState cpp_flag
        if do_cpp
           then do
-                   cpp <- readIORef pgm_P
+                   cpp <- readIORef v_Pgm_P
            hscpp_opts <- getOpts opt_P
-                   hs_src_cpp_opts <- readIORef hs_source_cpp_opts
+                   hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
 
-           cmdline_include_paths <- readIORef include_paths
+           cmdline_include_paths <- readIORef v_Include_paths
            pkg_include_dirs <- getPackageIncludePath
            let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
                                                        ++ pkg_include_dirs)
@@ -327,26 +342,26 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
 
    deps <- mapM (findDependency basename) imports
 
-   osuf_opt <- readIORef output_suf
+   osuf_opt <- readIORef v_Object_suf
    let osuf = case osuf_opt of
-                       Nothing -> "o"
+                       Nothing -> phaseInputExt Ln
                        Just s  -> s
 
-   extra_suffixes <- readIORef dep_suffixes
+   extra_suffixes <- readIORef v_Dep_suffixes
    let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
        ofiles = map (\suf -> basename ++ '.':suf) suffixes
           
    objs <- mapM odir_ify ofiles
    
-   hdl <- readIORef dep_tmp_hdl
+   hdl <- readIORef v_Dep_tmp_hdl
 
-       -- std dependeny of the object(s) on the source file
+       -- std dependency of the object(s) on the source file
    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 
    let genDep (dep, False {- not an hi file -}) = 
          hPutStrLn hdl (unwords objs ++ " : " ++ dep)
        genDep (dep, True  {- is an hi file -}) = do
-         hisuf <- readIORef hi_suf
+         hisuf <- readIORef v_Hi_suf
          let dep_base = remove_suffix '.' dep
              deps = (dep_base ++ hisuf)
                     : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
@@ -378,7 +393,9 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
 -----------------------------------------------------------------------------
 -- Hsc phase
 
-run_phase Hsc  basename suff input_fn output_fn
+-- Compilation of a single module, in "legacy" mode (_not_ under
+-- the direction of the compilation manager).
+run_phase Hsc basename suff input_fn output_fn
   = do
        
   -- we add the current directory (i.e. the directory in which
@@ -386,104 +403,77 @@ run_phase Hsc    basename suff input_fn output_fn
   -- what gcc does, and it's probably what you want.
        let current_dir = getdir basename
        
-       paths <- readIORef include_paths
-       writeIORef include_paths (current_dir : paths)
+       paths <- readIORef v_Include_paths
+       writeIORef v_Include_paths (current_dir : paths)
        
   -- figure out where to put the .hi file
-       ohi    <- readIORef output_hi
-       hisuf  <- readIORef hi_suf
+       ohi    <- readIORef v_Output_hi
+       hisuf  <- readIORef v_Hi_suf
        let hifile = case ohi of
-                          Nothing -> current_dir ++ {-ToDo: modname!!-}basename
-                                       ++ hisuf
+                          Nothing -> 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.
   -- (ToDo: do when generating .hc files too?)
   --
-  -- Setting source_unchanged to "-fsource_unchanged" means that M.o seems
+  -- Setting source_unchanged to True means that M.o seems
   -- to be up to date wrt M.hs; so no need to recompile unless imports have
   -- changed (which the compiler itself figures out).
-  -- Setting source_unchanged to "" tells the compiler that M.o is out of
+  -- Setting source_unchanged to False tells the compiler that M.o is out of
   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
-       do_recomp <- readIORef recomp
+       do_recomp <- readIORef v_Recomp
        todo <- readIORef v_GhcMode
         o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
        source_unchanged <- 
           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
-            then return ""
+            then return False
             else do t1 <- getModificationTime (basename ++ '.':suff)
                     o_file_exists <- doesFileExist o_file
                     if not o_file_exists
-                       then return ""  -- Need to recompile
+                       then return False       -- Need to recompile
                        else do t2 <- getModificationTime o_file
                                if t2 > t1
-                                 then return "-fsource-unchanged"
-                                 else return ""
+                                 then return True
+                                 else return False
 
-   -- 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"
-                    }
+   -- build a ModuleLocation to pass to hscMain.
+        let location = ModuleLocation {
+                          ml_hs_file   = Nothing,
+                          ml_hspp_file = Just input_fn,
+                          ml_hi_file   = Just hifile,
+                          ml_obj_file  = Just o_file
+                       }
+
+  -- get the DynFlags
+        dyn_flags <- readIORef v_DynFlags
 
   -- run the compiler!
-       result <- hscMain dyn_flags mod_summary 
-                               Nothing{-no iface-}
-                               output_fn emptyUFM emptyPCS
+        pcs <- initPersistentCompilerState
+       result <- hscMain dyn_flags{ hscOutName = output_fn }
+                         source_unchanged
+                         location
+                         Nothing        -- no iface
+                         emptyModuleEnv -- HomeSymbolTable
+                         emptyModuleEnv -- HomeIfaceTable
+                         pcs
 
        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
+           HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 
-       mapM (printSDoc PprForUser) warns
+           HscOK details maybe_iface maybe_stub_h maybe_stub_c 
+                       _maybe_interpreted_code pcs -> do
 
-   -- generate the interface file
-       case iface of
-          Nothing -> -- compilation not required
-            do run_something "Touching object file" ("touch " ++ o_file)
-               return False
+           -- deal with stubs
+       maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
+       case maybe_stub_o of
+               Nothing -> return ()
+               Just stub_o -> add v_Ld_inputs stub_o
 
-          Just iface ->
-
-  -- Deal with stubs
-       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 ()
-          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
-               runPipeline pipeline stub_c False{-no linking-} False{-no -o option-}
-
-               add ld_inputs (basename++"_stub.o")
-
-       return True
+        let keep_going = case maybe_iface of Just _ -> True; Nothing -> False
+       return keep_going
+    }
 
 -----------------------------------------------------------------------------
 -- Cc phase
@@ -493,9 +483,9 @@ run_phase Hsc       basename suff input_fn output_fn
 
 run_phase cc_phase _basename _suff input_fn output_fn
    | cc_phase == Cc || cc_phase == HCc
-   = do        cc <- readIORef pgm_c
+   = do        cc <- readIORef v_Pgm_c
                cc_opts <- (getOpts opt_c)
-               cmdline_include_dirs <- readIORef include_paths
+               cmdline_include_dirs <- readIORef v_Include_paths
 
         let hcc = cc_phase == HCc
 
@@ -526,18 +516,22 @@ run_phase cc_phase _basename _suff input_fn output_fn
 
        ccout <- newTempName "ccout"
 
-       mangle <- readIORef do_asm_mangling
+       mangle <- readIORef v_Do_asm_mangling
        (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 
         verb <- is_verbose
 
-       o2 <- readIORef opt_minus_o2_for_C
+       o2 <- readIORef v_minus_o2_for_C
        let opt_flag | o2        = "-O2"
                     | otherwise = "-O"
 
        pkg_extra_cc_opts <- getPackageExtraCcOpts
 
-       excessPrecision <- readIORef excess_precision
+       split_objs <- readIORef v_Split_object_files
+       let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
+                     | otherwise         = [ ]
+
+       excessPrecision <- readIORef v_Excess_precision
 
        run_something "C Compiler"
         (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
@@ -548,6 +542,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
                   ++ [ verb, "-S", "-Wimplicit", opt_flag ]
                   ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
                   ++ cc_opts
+                  ++ split_opt
 #ifdef mingw32_TARGET_OS
                    ++ [" -mno-cygwin"]
 #endif
@@ -564,7 +559,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
 -- Mangle phase
 
 run_phase Mangle _basename _suff input_fn output_fn
-  = do mangler <- readIORef pgm_m
+  = do mangler <- readIORef v_Pgm_m
        mangler_opts <- getOpts opt_m
        machdep_opts <-
         if (prefixMatch "i386" cTARGETPLATFORM)
@@ -583,13 +578,13 @@ run_phase Mangle _basename _suff input_fn output_fn
 -- Splitting phase
 
 run_phase SplitMangle _basename _suff input_fn _output_fn
-  = do  splitter <- readIORef pgm_s
+  = do  splitter <- readIORef v_Pgm_s
 
        -- this is the prefix used for the split .s files
        tmp_pfx <- readIORef v_TmpDir
-       x <- getProcessID
+       x <- myGetProcessID
        let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
-       writeIORef split_prefix split_s_prefix
+       writeIORef v_Split_prefix split_s_prefix
        addFilesToClean [split_s_prefix ++ "__*"] -- d:-)
 
        -- allocate a tmp file to put the no. of split .s files in (sigh)
@@ -605,17 +600,17 @@ run_phase SplitMangle _basename _suff input_fn _output_fn
        -- save the number of split files for future references
        s <- readFile n_files
        let n = read s :: Int
-       writeIORef n_split_files n
+       writeIORef v_N_split_files n
        return True
 
 -----------------------------------------------------------------------------
 -- As phase
 
 run_phase As _basename _suff input_fn output_fn
-  = do         as <- readIORef pgm_a
+  = do         as <- readIORef v_Pgm_a
         as_opts <- getOpts opt_a
 
-        cmdline_include_paths <- readIORef include_paths
+        cmdline_include_paths <- readIORef v_Include_paths
         let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
         run_something "Assembler"
           (unwords (as : as_opts
@@ -625,13 +620,13 @@ run_phase As _basename _suff input_fn output_fn
        return True
 
 run_phase SplitAs basename _suff _input_fn _output_fn
-  = do  as <- readIORef pgm_a
+  = do  as <- readIORef v_Pgm_a
         as_opts <- getOpts opt_a
 
-       split_s_prefix <- readIORef split_prefix
-       n <- readIORef n_split_files
+       split_s_prefix <- readIORef v_Split_prefix
+       n <- readIORef v_N_split_files
 
-       odir <- readIORef output_dir
+       odir <- readIORef v_Output_dir
        let real_odir = case odir of
                                Nothing -> basename
                                Just d  -> d
@@ -654,36 +649,54 @@ run_phase SplitAs basename _suff _input_fn _output_fn
 
 doLink :: [String] -> IO ()
 doLink o_files = do
-    ln <- readIORef pgm_l
+    ln <- readIORef v_Pgm_l
     verb <- is_verbose
-    o_file <- readIORef output_file
+    static <- readIORef v_Static
+    let imp = if static then "" else "_imp"
+    no_hs_main <- readIORef v_NoHsMain
+
+    o_file <- readIORef v_Output_file
     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 
     pkg_lib_paths <- getPackageLibraryPath
     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 
-    lib_paths <- readIORef library_paths
+    lib_paths <- readIORef v_Library_paths
     let lib_path_opts = map ("-L"++) lib_paths
 
     pkg_libs <- getPackageLibraries
-    let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs
+    let pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
 
-    libs <- readIORef cmdline_libraries
+    libs <- readIORef v_Cmdline_libraries
     let lib_opts = map ("-l"++) (reverse libs)
         -- reverse because they're added in reverse order from the cmd line
 
     pkg_extra_ld_opts <- getPackageExtraLdOpts
 
        -- probably _stub.o files
-    extra_ld_inputs <- readIORef ld_inputs
+    extra_ld_inputs <- readIORef v_Ld_inputs
 
        -- opts from -optl-<blah>
-    extra_ld_opts <- getStaticOpts opt_l
+    extra_ld_opts <- getStaticOpts v_Opt_l
 
+    rts_pkg <- getPackageDetails ["rts"]
+    std_pkg <- getPackageDetails ["std"]
+#ifdef mingw32_TARGET_OS
+    let extra_os = if static || no_hs_main
+                   then []
+--                   else [ head (lib_paths (head rts_pkg)) ++ "/Main.dll_o",
+--                          head (lib_paths (head std_pkg)) ++ "/PrelMain.dll_o" ]
+                    else []
+#endif
+    (md_c_flags, _) <- machdepCCOpts
     run_something "Linker"
-       (unwords 
+       (unwords
         ([ ln, verb, "-o", output_fn ]
+        ++ md_c_flags
         ++ o_files
+#ifdef mingw32_TARGET_OS
+        ++ extra_os
+#endif
         ++ extra_ld_inputs
         ++ lib_path_opts
         ++ lib_opts
@@ -691,6 +704,11 @@ doLink o_files = do
         ++ pkg_lib_opts
         ++ pkg_extra_ld_opts
         ++ extra_ld_opts
+#ifdef mingw32_TARGET_OS
+         ++ if static then [ "-u _PrelMain_mainIO_closure" , "-u ___init_PrelMain"] else []
+#else
+        ++ [ "-u PrelMain_mainIO_closure" , "-u __init_PrelMain"]
+#endif
        )
        )
 
@@ -701,5 +719,146 @@ doLink o_files = do
 preprocess :: FilePath -> IO FilePath
 preprocess filename =
   ASSERT(haskellish_file filename) 
-  do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
+  do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
+                       defaultHscLang filename
      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
+
+
+-----------------------------------------------------------------------------
+-- Compile a single module, under the control of the compilation manager.
+--
+-- 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.
+
+-- 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.
+
+compile :: ModSummary              -- summary, including source
+        -> Maybe ModIface          -- old interface, if available
+        -> HomeSymbolTable         -- for home module ModDetails
+       -> HomeIfaceTable          -- for home module Ifaces
+        -> PersistentCompilerState -- persistent compiler state
+        -> IO CompResult
+
+data CompResult
+   = CompOK   ModDetails  -- new details (HST additions)
+              (Maybe (ModIface, Linkable))
+                       -- summary and code; Nothing => compilation not reqd
+                       -- (old summary and code are still valid)
+              PersistentCompilerState  -- updated PCS
+
+   | CompErrs PersistentCompilerState  -- updated PCS
+
+
+compile summary old_iface hst hit pcs = do 
+   verb <- readIORef v_Verbose
+   when verb (hPutStrLn stderr 
+                 (showSDoc (text "compile: compiling" 
+                            <+> ppr (name_of_summary summary))))
+
+   init_dyn_flags <- readIORef v_InitDynFlags
+   writeIORef v_DynFlags init_dyn_flags
+
+   let location   = ms_location summary   
+   let input_fn   = unJust (ml_hs_file location) "compile:hs"
+   let input_fnpp = unJust (ml_hspp_file location) "compile:hspp"
+
+   when verb (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
+
+   opts <- getOptionsFromSource input_fnpp
+   processArgs dynamic_flags opts []
+   dyn_flags <- readIORef v_DynFlags
+
+   let hsc_lang = hscLang dyn_flags
+   output_fn <- case hsc_lang of
+                   HscAsm         -> newTempName (phaseInputExt As)
+                   HscC           -> newTempName (phaseInputExt HCc)
+                   HscJava        -> newTempName "java" -- ToDo
+                   HscInterpreted -> return (error "no output file")
+
+   -- run the compiler
+   hsc_result <- hscMain dyn_flags{ hscOutName = output_fn } 
+                        False -- (panic "compile:source_unchanged")
+                         location old_iface hst hit pcs
+
+   case hsc_result of {
+      HscFail pcs -> return (CompErrs pcs);
+
+      HscOK details maybe_iface 
+       maybe_stub_h maybe_stub_c maybe_interpreted_code pcs -> do
+          
+          -- if no compilation happened, bail out early
+          case maybe_iface of {
+               Nothing -> return (CompOK details Nothing pcs);
+               Just iface -> do
+
+          let (basename, _) = splitFilename input_fn
+          maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
+          let 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.
+               HscInterpreted -> 
+                   case maybe_interpreted_code of
+                       Just (code,itbl_env) -> return [Trees code itbl_env]
+                       Nothing -> panic "compile: no interpreted code"
+
+               -- we're in batch mode: finish the compilation pipeline.
+               _other -> do pipe <- genPipeline (StopBefore Ln) "" True 
+                                       hsc_lang 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)
+          }
+   }
+
+-----------------------------------------------------------------------------
+-- 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) "" True 
+                               defaultHscLang stub_c
+               stub_o <- runPipeline pipeline stub_c False{-no linking-} 
+                               False{-no -o option-}
+
+               return (Just stub_o)