Commit 76c2a7cf authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-26 14:38:42 by simonmar]

Simon's stuff
parent d893f380
-----------------------------------------------------------------------------
-- $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
--
......@@ -29,18 +29,17 @@ import DriverUtil
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
......@@ -149,10 +148,8 @@ genPipeline todo stop_flag filename
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
----------- ----- ---- --- -- -- - - -
......@@ -302,8 +299,6 @@ run_phase Unlit _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 []
do_cpp <- readState cpp_flag
......@@ -395,7 +390,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
-----------------------------------------------------------------------------
-- 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
......@@ -441,44 +436,54 @@ run_phase Hsc basename suff input_fn output_fn
-- 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
......@@ -531,7 +536,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
verb <- is_verbose
o2 <- readIORef opt_minus_o2_for_C
o2 <- readIORef v_minus_o2_for_C
let opt_flag | o2 = "-O2"
| otherwise = "-O"
......@@ -720,7 +725,7 @@ preprocess filename =
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
......@@ -757,13 +762,13 @@ compile finder summary old_iface hst pcs = do
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
......@@ -784,7 +789,7 @@ compile finder summary old_iface hst pcs = 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"
......
......@@ -118,12 +118,12 @@ mkHomeModuleLocn mod_name basename source_fn = do
ohi <- readIORef output_hi
hisuf <- readIORef hi_suf
let hifile = case ohi of
Nothing -> basename ++ hisuf
Nothing -> basename ++ '.':hisuf
Just fn -> fn
-- figure out the .o file name. It also lives in the same dir
-- as the source, but can be overriden by a -odir flag.
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
return (Just (mkHomeModule mod_name,
ModuleLocation{
......
......@@ -4,7 +4,8 @@
\section[GHC_Main]{Main driver for Glasgow Haskell compiler}
\begin{code}
module HscMain ( hscMain ) where
module HscMain ( HscResult(..), hscMain,
initPersistentCompilerState ) where
#include "HsVersions.h"
......
{-# 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
--
......@@ -94,7 +94,6 @@ main =
-- install signal handlers
main_thread <- myThreadId
#ifndef mingw32_TARGET_OS
let sig_handler = Catch (throwTo main_thread
(DynException (toDyn Interrupted)))
......@@ -149,6 +148,10 @@ main =
(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 []
......@@ -160,6 +163,14 @@ main =
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).
......@@ -174,14 +185,6 @@ main =
-- 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
......
......@@ -5,7 +5,8 @@
\begin{code}
module MkIface (
mkModDetails, mkModDetailsFromIface, completeIface, writeIface
mkModDetails, mkModDetailsFromIface, completeIface,
writeIface, pprIface
) where
#include "HsVersions.h"
......@@ -266,7 +267,7 @@ ifaceTyCls (AnId id)
%* *
%************************************************************************
\begin{code}
\begin{code}
ifaceInstance :: DFunId -> RenamedInstDecl
ifaceInstance dfun_id
= InstDecl (toHsType tidy_ty) EmptyMonoBinds [] (Just (getName dfun_id)) noSrcLoc
......@@ -621,6 +622,7 @@ writeIface finder (Just mod_iface)
where
mod_name = moduleName (mi_module mod_iface)
pprIface :: ModIface -> SDoc
pprIface iface
= vcat [ ptext SLIT("__interface")
<+> doubleQuotes (ptext opt_InPackage)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment