-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.6 2000/10/25 14:42:32 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.7 2000/10/26 14:38:42 simonmar Exp $
--
-- GHC Driver
--
import DriverMkDepend
import DriverPhases
import DriverFlags
+import HscMain
import Finder
import TmpFiles
import HscTypes
-import UniqFM
import Outputable
import Module
-import ErrUtils
import CmdLineOpts
import Config
import Util
-import Panic
+import Posix
import Directory
import System
import IOExts
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 && haskellish = HscC
- | otherwise = lang
+ real_lang | suffix == "hc" = HscC
+ | otherwise = lang
let
----------- ----- ---- --- -- -- - - -
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 []
do_cpp <- readState cpp_flag
-----------------------------------------------------------------------------
-- Hsc phase
-run_phase Hsc basename suff input_fn output_fn
+run_phase Hsc basename suff input_fn output_fn
= do
-- we add the current directory (i.e. the directory in which
-- build a bogus ModSummary to pass to hscMain.
let summary = ModSummary {
ms_location = error "no loc",
- ms_ppsource = Just (loc, error "no fingerprint"),
+ ms_ppsource = Just (input_fn, error "no fingerprint"),
ms_imports = error "no imports"
}
+ -- 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 }
+ (error "no Finder!")
+ summary
+ Nothing -- no iface
+ emptyModuleEnv -- HomeSymbolTable
+ emptyModuleEnv -- HomeIfaceTable
+ emptyModuleEnv -- PackageIfaceTable
+ pcs
case result of {
- HscErrs pcs errs warns -> do {
- printErrorsAndWarnings errs warns
- throwDyn (PhaseFailed "hsc" (ExitFailure 1)) };
-
- HscOK details maybe_iface maybe_stub_h maybe_stub_c pcs warns -> do
-
- pprBagOfWarnings warns
+ HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
- -- get the module name
+ HscOK details maybe_iface maybe_stub_h maybe_stub_c
+ _maybe_interpreted_code pcs -> do
-- generate the interface file
- case iface of
+ case maybe_iface of
Nothing -> -- compilation not required
do run_something "Touching object file" ("touch " ++ o_file)
return False
Just iface -> do
-- discover the filename for the .hi file in a roundabout way
- let mod = md_id details
- locn <- mkHomeModule mod basename input_fn
- let hifile = hi_file locn
- -- write out the interface file here...
- return ()
+ let mod = moduleString (mi_module iface)
+ ohi <- readIORef output_hi
+ hifile <- case ohi of
+ Just fn -> fn
+ Nothing -> do hisuf <- readIORef hi_suf
+ return (current_dir ++
+ '/'mod ++ '.':hisuf)
+ -- write out the interface...
+ if_hdl <- openFile hifile WriteMode
+ printForIface if_hdl (pprIface iface)
+ hClose if_hdl
-- deal with stubs
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
- case stub_o of
+ case maybe_stub_o of
Nothing -> return ()
Just stub_o -> add ld_inputs stub_o
verb <- is_verbose
- o2 <- readIORef opt_minus_o2_for_C
+ o2 <- readIORef v_minus_o2_for_C
let opt_flag | o2 = "-O2"
| otherwise = "-O"
compile :: Finder -- to find modules
-> ModSummary -- summary, including source
- -> Maybe ModIFace -- old interface, if available
+ -> Maybe ModIface -- old interface, if available
-> HomeSymbolTable -- for home module ModDetails
-> PersistentCompilerState -- persistent compiler state
-> IO CompResult
HscAsm -> newTempName (phaseInputExt As)
HscC -> newTempName (phaseInputExt HCc)
HscJava -> newTempName "java" -- ToDo
- HscInterpreter -> return (error "no output file")
+ HscInterpreted -> 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);
+ HscFail pcs -> return (CompErrs pcs);
HscOK details maybe_iface
maybe_stub_h maybe_stub_c maybe_interpreted_code pcs warns -> do
-- in interpreted mode, just return the compiled code
-- as our "unlinked" object.
- HscInterpreter ->
+ HscInterpreted ->
case maybe_interpreted_code of
Just code -> return (Trees code)
Nothing -> panic "compile: no interpreted code"
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.8 2000/10/24 16:08:16 simonmar Exp $
+-- $Id: Main.hs,v 1.9 2000/10/26 14:38:42 simonmar Exp $
--
-- GHC Driver program
--
-- install signal handlers
main_thread <- myThreadId
-
#ifndef mingw32_TARGET_OS
let sig_handler = Catch (throwTo main_thread
(DynException (toDyn Interrupted)))
(flags2, mode, stop_flag) <- getGhcMode argv'
writeIORef v_GhcMode mode
+ -- force lang to "C" if the -C flag was given
+ case mode of StopBefore HCc -> writeIORef hsc_lang HscC
+ _ -> return ()
+
-- process all the other arguments, and get the source files
non_static <- processArgs static_flags flags2 []
static_opts <- buildStaticHscOpts
writeIORef static_hsc_opts static_opts
+ -- warnings
+ warn_level <- readIORef warning_opt
+ let warn_opts = case warn_level of
+ W_default -> standardWarnings
+ W_ -> minusWOpts
+ W_all -> minusWallOpts
+ W_not -> []
+
-- build the default DynFlags (these may be adjusted on a per
-- module basis by OPTIONS pragmas and settings in the interpreter).
-- leave out hscOutName for now
flags = [] }
- -- warnings
- warn_level <- readIORef warning_opt
- let warn_opts = case warn_level of
- W_default -> standardWarnings
- W_ -> minusWOpts
- W_all -> minusWallOpts
- W_not -> []
-
-- the rest of the arguments are "dynamic"
srcs <- processArgs dynamic_flags non_static []
-- save the "initial DynFlags" away
projects / ghc-hetmet.git / commitdiff