Commit 12467fbf authored by sewardj's avatar sewardj
Browse files

[project @ 2000-10-31 13:01:46 by sewardj]

* Stop pipeline when recompilation not needed.
* Check OPTIONS pragmas for non-dynamic flags.
* Misc wibbles.
parent 5f67848a
......@@ -33,6 +33,7 @@ import ErrUtils ( dumpIfSet_dyn )
import Outputable
import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName )
import TmpFiles ( newTempName )
import UniqSupply ( mkSplitUniqSupply )
import IO ( IOMode(..), hClose, openFile, Handle )
\end{code}
......@@ -108,9 +109,7 @@ outputAsm dflags filenm flat_absC
#ifndef OMIT_NATIVE_CODEGEN
= do ncg_uniqs <- mkSplitUniqSupply 'n'
let
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
in
let (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d
doOutput filenm ( \f -> printForAsm f ncg_output_d)
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.13 2000/10/30 18:13:15 sewardj Exp $
-- $Id: DriverPipeline.hs,v 1.14 2000/10/31 13:01:46 sewardj Exp $
--
-- GHC Driver
--
......@@ -294,9 +294,15 @@ 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
_ <- 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
......@@ -349,7 +355,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
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 -}) =
......@@ -412,27 +418,27 @@ run_phase Hsc basename suff input_fn output_fn
-- 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 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 ModuleLocation to pass to hscMain.
-- build a ModuleLocation to pass to hscMain.
let location = ModuleLocation {
ml_hs_file = Nothing,
ml_hspp_file = Just input_fn,
......@@ -446,7 +452,7 @@ run_phase Hsc basename suff input_fn output_fn
-- run the compiler!
pcs <- initPersistentCompilerState
result <- hscMain dyn_flags{ hscOutName = output_fn }
(source_unchanged == "-fsource-unchanged")
source_unchanged
location
Nothing -- no iface
emptyModuleEnv -- HomeSymbolTable
......@@ -460,13 +466,14 @@ run_phase Hsc basename suff input_fn output_fn
HscOK details maybe_iface maybe_stub_h maybe_stub_c
_maybe_interpreted_code pcs -> do
-- deal with stubs
-- 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
return True
let keep_going = case maybe_iface of Just _ -> True; Nothing -> False
return keep_going
}
-----------------------------------------------------------------------------
......
......@@ -95,8 +95,7 @@ hscMain
hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
= do {
putStrLn ( "hscMain: location =\n" ++ show location);
putStrLn "checking old iface ...";
putStrLn "CHECKING OLD IFACE";
(pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
<- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain")
source_unchanged maybe_old_iface;
......@@ -108,7 +107,6 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
what_next | recomp_reqd || no_old_iface = hscRecomp
| otherwise = hscNoRecomp
;
putStrLn "doing what_next ...";
what_next dflags location maybe_checked_iface
hst hit pcs_ch
}}
......@@ -116,6 +114,7 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
= do {
hPutStrLn stderr "COMPILATION NOT REQUIRED";
-- we definitely expect to have the old interface available
let old_iface = case maybe_checked_iface of
Just old_if -> old_if
......@@ -154,10 +153,11 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
= do {
hPutStrLn stderr "COMPILATION IS REQUIRED";
-- what target are we shooting for?
let toInterp = dopt_HscLang dflags == HscInterpreted
;
-- putStrLn ("toInterp = " ++ show toInterp);
-- PARSE
maybe_parsed
<- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp");
......@@ -201,15 +201,9 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
let new_details = mkModDetails env_tc local_insts tidy_binds
top_level_ids orphan_rules
;
-- and possibly create a new ModIface
let maybe_final_iface_and_sdoc
= completeIface maybe_checked_iface new_iface new_details
maybe_final_iface
= case maybe_final_iface_and_sdoc of
Just (fif, sdoc) -> Just fif; Nothing -> Nothing
;
-- Write the interface file
writeIface (unJust (ml_hi_file location) "hscRecomp:hi") maybe_final_iface
-- and the final interface
final_iface
<- mkFinalIface dflags location maybe_checked_iface new_iface new_details
;
-- do the rest of code generation/emission
(maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
......@@ -219,12 +213,24 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
hit (pcs_PIT pcs_tc)
;
-- and the answer is ...
return (HscOK new_details maybe_final_iface
return (HscOK new_details (Just final_iface)
maybe_stub_h_filename maybe_stub_c_filename
maybe_ibinds pcs_tc)
}}}}}}}
mkFinalIface dflags location maybe_old_iface new_iface new_details
= case completeIface maybe_old_iface new_iface new_details of
(new_iface, Nothing) -- no change in the interfacfe
-> return new_iface
(new_iface, Just sdoc)
-> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "NEW INTERFACE" sdoc
-- Write the interface file
writeIface (unJust (ml_hi_file location) "hscRecomp:hi") new_iface
return new_iface
myParseModule dflags src_filename
= do -------------------------- Parser ----------------
show_pass dflags "Parser"
......
......@@ -23,8 +23,7 @@ import TcHsSyn ( TypecheckedRuleDecl )
import HscTypes ( VersionInfo(..), IfaceDecls(..), ModIface(..), ModDetails(..),
TyThing(..), DFunId, TypeEnv, isTyClThing, Avails,
WhatsImported(..), GenAvailInfo(..),
ImportVersion, AvailInfo, Deprecations(..),
ModuleLocation(..)
ImportVersion, AvailInfo, Deprecations(..)
)
import CmdLineOpts
......@@ -54,8 +53,7 @@ import FieldLabel ( fieldLabelType )
import Type ( splitSigmaTy, tidyTopType, deNoteType )
import SrcLoc ( noSrcLoc )
import Outputable
import Module ( ModuleName, moduleName )
import Finder ( findModule )
import Module ( ModuleName )
import List ( partition )
import IO ( IOMode(..), openFile, hClose )
......@@ -128,7 +126,7 @@ mkModDetailsFromIface type_env dfun_ids rules
completeIface :: Maybe ModIface -- The old interface, if we have it
-> ModIface -- The new one, minus the decls and versions
-> ModDetails -- The ModDetails for this module
-> Maybe (ModIface, SDoc) -- The new one, complete with decls and versions
-> (ModIface, Maybe SDoc) -- The new one, complete with decls and versions
-- The SDoc is a debug document giving differences
-- Nothing => no change
......@@ -225,6 +223,8 @@ ifaceTyCls (ATyCon tycon) so_far
mk_field strict_mark field_label
= ([getName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
ifaceTyCls (ATyCon tycon) so_far = pprPanic "ifaceTyCls" (ppr tycon)
ifaceTyCls (AnId id) so_far
| omitIfaceSigForId id = so_far
| otherwise = iface_sig : so_far
......@@ -522,7 +522,7 @@ getRules orphan_rules binds emitted
\begin{code}
addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi
-> ModIface -- The new interface decls
-> Maybe (ModIface, SDoc) -- Nothing => no change; no need to write new Iface
-> (ModIface, Maybe SDoc) -- Nothing => no change; no need to write new Iface
-- Just mi => Here is the new interface to write
-- with correct version numbers
......@@ -532,7 +532,7 @@ addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi
addVersionInfo Nothing new_iface
-- No old interface, so definitely write a new one!
= Just (new_iface, text "No old interface available")
= (new_iface, Just (text "No old interface available"))
addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
mi_decls = old_decls,
......@@ -541,10 +541,10 @@ addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
mi_fixities = new_fixities })
| no_output_change && no_usage_change
= Nothing
= (old_iface, Nothing)
| otherwise -- Add updated version numbers
= Just (final_iface, pp_tc_diffs)
= (final_iface, Just pp_tc_diffs)
where
final_iface = new_iface { mi_version = new_version }
......@@ -613,11 +613,8 @@ diffDecls old_vers old_fixities new_fixities old new
%************************************************************************
\begin{code}
writeIface :: FilePath -> Maybe ModIface -> IO ()
writeIface hi_path Nothing
= return ()
writeIface hi_path (Just mod_iface)
writeIface :: FilePath -> ModIface -> IO ()
writeIface hi_path mod_iface
= do { if_hdl <- openFile hi_path WriteMode
; printForIface if_hdl (pprIface mod_iface)
; hClose if_hdl
......
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