Commit 12467fbf authored by sewardj's avatar sewardj

[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 ) ...@@ -33,6 +33,7 @@ import ErrUtils ( dumpIfSet_dyn )
import Outputable import Outputable
import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName ) import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName )
import TmpFiles ( newTempName ) import TmpFiles ( newTempName )
import UniqSupply ( mkSplitUniqSupply )
import IO ( IOMode(..), hClose, openFile, Handle ) import IO ( IOMode(..), hClose, openFile, Handle )
\end{code} \end{code}
...@@ -108,9 +109,7 @@ outputAsm dflags filenm flat_absC ...@@ -108,9 +109,7 @@ outputAsm dflags filenm flat_absC
#ifndef OMIT_NATIVE_CODEGEN #ifndef OMIT_NATIVE_CODEGEN
= do ncg_uniqs <- mkSplitUniqSupply 'n' = do ncg_uniqs <- mkSplitUniqSupply 'n'
let let (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
in
dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d
doOutput filenm ( \f -> printForAsm f 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 -- GHC Driver
-- --
...@@ -294,9 +294,15 @@ run_phase Unlit _basename _suff input_fn output_fn ...@@ -294,9 +294,15 @@ run_phase Unlit _basename _suff input_fn output_fn
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Cpp phase -- 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 = 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 do_cpp <- readState cpp_flag
if do_cpp if do_cpp
...@@ -349,7 +355,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do ...@@ -349,7 +355,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
hdl <- readIORef v_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) hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
let genDep (dep, False {- not an hi file -}) = let genDep (dep, False {- not an hi file -}) =
...@@ -412,27 +418,27 @@ run_phase Hsc basename suff input_fn output_fn ...@@ -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. -- only do this if we're eventually going to generate a .o file.
-- (ToDo: do when generating .hc files too?) -- (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 -- to be up to date wrt M.hs; so no need to recompile unless imports have
-- changed (which the compiler itself figures out). -- 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. -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
do_recomp <- readIORef v_Recomp do_recomp <- readIORef v_Recomp
todo <- readIORef v_GhcMode todo <- readIORef v_GhcMode
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
source_unchanged <- source_unchanged <-
if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln )) if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
then return "" then return False
else do t1 <- getModificationTime (basename ++ '.':suff) else do t1 <- getModificationTime (basename ++ '.':suff)
o_file_exists <- doesFileExist o_file o_file_exists <- doesFileExist o_file
if not o_file_exists if not o_file_exists
then return "" -- Need to recompile then return False -- Need to recompile
else do t2 <- getModificationTime o_file else do t2 <- getModificationTime o_file
if t2 > t1 if t2 > t1
then return "-fsource-unchanged" then return True
else return "" else return False
-- build a bogus ModuleLocation to pass to hscMain. -- build a ModuleLocation to pass to hscMain.
let location = ModuleLocation { let location = ModuleLocation {
ml_hs_file = Nothing, ml_hs_file = Nothing,
ml_hspp_file = Just input_fn, ml_hspp_file = Just input_fn,
...@@ -446,7 +452,7 @@ run_phase Hsc basename suff input_fn output_fn ...@@ -446,7 +452,7 @@ run_phase Hsc basename suff input_fn output_fn
-- run the compiler! -- run the compiler!
pcs <- initPersistentCompilerState pcs <- initPersistentCompilerState
result <- hscMain dyn_flags{ hscOutName = output_fn } result <- hscMain dyn_flags{ hscOutName = output_fn }
(source_unchanged == "-fsource-unchanged") source_unchanged
location location
Nothing -- no iface Nothing -- no iface
emptyModuleEnv -- HomeSymbolTable emptyModuleEnv -- HomeSymbolTable
...@@ -460,13 +466,14 @@ run_phase Hsc basename suff input_fn output_fn ...@@ -460,13 +466,14 @@ run_phase Hsc basename suff input_fn output_fn
HscOK details maybe_iface maybe_stub_h maybe_stub_c HscOK details maybe_iface maybe_stub_h maybe_stub_c
_maybe_interpreted_code pcs -> do _maybe_interpreted_code pcs -> do
-- deal with stubs -- deal with stubs
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
case maybe_stub_o of case maybe_stub_o of
Nothing -> return () Nothing -> return ()
Just stub_o -> add v_Ld_inputs stub_o 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 ...@@ -95,8 +95,7 @@ hscMain
hscMain dflags source_unchanged location maybe_old_iface hst hit pcs hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
= do { = do {
putStrLn ( "hscMain: location =\n" ++ show location); putStrLn "CHECKING OLD IFACE";
putStrLn "checking old iface ...";
(pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface)) (pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
<- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain") <- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain")
source_unchanged maybe_old_iface; source_unchanged maybe_old_iface;
...@@ -108,7 +107,6 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs ...@@ -108,7 +107,6 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
what_next | recomp_reqd || no_old_iface = hscRecomp what_next | recomp_reqd || no_old_iface = hscRecomp
| otherwise = hscNoRecomp | otherwise = hscNoRecomp
; ;
putStrLn "doing what_next ...";
what_next dflags location maybe_checked_iface what_next dflags location maybe_checked_iface
hst hit pcs_ch hst hit pcs_ch
}} }}
...@@ -116,6 +114,7 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs ...@@ -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 hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
= do { = do {
hPutStrLn stderr "COMPILATION NOT REQUIRED";
-- we definitely expect to have the old interface available -- we definitely expect to have the old interface available
let old_iface = case maybe_checked_iface of let old_iface = case maybe_checked_iface of
Just old_if -> old_if Just old_if -> old_if
...@@ -154,10 +153,11 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch ...@@ -154,10 +153,11 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
hscRecomp dflags location maybe_checked_iface hst hit pcs_ch hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
= do { = do {
hPutStrLn stderr "COMPILATION IS REQUIRED";
-- what target are we shooting for? -- what target are we shooting for?
let toInterp = dopt_HscLang dflags == HscInterpreted let toInterp = dopt_HscLang dflags == HscInterpreted
; ;
-- putStrLn ("toInterp = " ++ show toInterp);
-- PARSE -- PARSE
maybe_parsed maybe_parsed
<- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp"); <- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp");
...@@ -201,15 +201,9 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch ...@@ -201,15 +201,9 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
let new_details = mkModDetails env_tc local_insts tidy_binds let new_details = mkModDetails env_tc local_insts tidy_binds
top_level_ids orphan_rules top_level_ids orphan_rules
; ;
-- and possibly create a new ModIface -- and the final interface
let maybe_final_iface_and_sdoc final_iface
= completeIface maybe_checked_iface new_iface new_details <- mkFinalIface dflags location 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
; ;
-- do the rest of code generation/emission -- do the rest of code generation/emission
(maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds) (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
...@@ -219,12 +213,24 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch ...@@ -219,12 +213,24 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
hit (pcs_PIT pcs_tc) hit (pcs_PIT pcs_tc)
; ;
-- and the answer is ... -- 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_stub_h_filename maybe_stub_c_filename
maybe_ibinds pcs_tc) 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 myParseModule dflags src_filename
= do -------------------------- Parser ---------------- = do -------------------------- Parser ----------------
show_pass dflags "Parser" show_pass dflags "Parser"
......
...@@ -23,8 +23,7 @@ import TcHsSyn ( TypecheckedRuleDecl ) ...@@ -23,8 +23,7 @@ import TcHsSyn ( TypecheckedRuleDecl )
import HscTypes ( VersionInfo(..), IfaceDecls(..), ModIface(..), ModDetails(..), import HscTypes ( VersionInfo(..), IfaceDecls(..), ModIface(..), ModDetails(..),
TyThing(..), DFunId, TypeEnv, isTyClThing, Avails, TyThing(..), DFunId, TypeEnv, isTyClThing, Avails,
WhatsImported(..), GenAvailInfo(..), WhatsImported(..), GenAvailInfo(..),
ImportVersion, AvailInfo, Deprecations(..), ImportVersion, AvailInfo, Deprecations(..)
ModuleLocation(..)
) )
import CmdLineOpts import CmdLineOpts
...@@ -54,8 +53,7 @@ import FieldLabel ( fieldLabelType ) ...@@ -54,8 +53,7 @@ import FieldLabel ( fieldLabelType )
import Type ( splitSigmaTy, tidyTopType, deNoteType ) import Type ( splitSigmaTy, tidyTopType, deNoteType )
import SrcLoc ( noSrcLoc ) import SrcLoc ( noSrcLoc )
import Outputable import Outputable
import Module ( ModuleName, moduleName ) import Module ( ModuleName )
import Finder ( findModule )
import List ( partition ) import List ( partition )
import IO ( IOMode(..), openFile, hClose ) import IO ( IOMode(..), openFile, hClose )
...@@ -128,7 +126,7 @@ mkModDetailsFromIface type_env dfun_ids rules ...@@ -128,7 +126,7 @@ mkModDetailsFromIface type_env dfun_ids rules
completeIface :: Maybe ModIface -- The old interface, if we have it completeIface :: Maybe ModIface -- The old interface, if we have it
-> ModIface -- The new one, minus the decls and versions -> ModIface -- The new one, minus the decls and versions
-> ModDetails -- The ModDetails for this module -> 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 -- The SDoc is a debug document giving differences
-- Nothing => no change -- Nothing => no change
...@@ -225,6 +223,8 @@ ifaceTyCls (ATyCon tycon) so_far ...@@ -225,6 +223,8 @@ ifaceTyCls (ATyCon tycon) so_far
mk_field strict_mark field_label mk_field strict_mark field_label
= ([getName field_label], mk_bang_ty strict_mark (fieldLabelType 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 ifaceTyCls (AnId id) so_far
| omitIfaceSigForId id = so_far | omitIfaceSigForId id = so_far
| otherwise = iface_sig : so_far | otherwise = iface_sig : so_far
...@@ -522,7 +522,7 @@ getRules orphan_rules binds emitted ...@@ -522,7 +522,7 @@ getRules orphan_rules binds emitted
\begin{code} \begin{code}
addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi
-> ModIface -- The new interface decls -> 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 -- Just mi => Here is the new interface to write
-- with correct version numbers -- with correct version numbers
...@@ -532,7 +532,7 @@ addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi ...@@ -532,7 +532,7 @@ addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi
addVersionInfo Nothing new_iface addVersionInfo Nothing new_iface
-- No old interface, so definitely write a new one! -- 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, addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
mi_decls = old_decls, mi_decls = old_decls,
...@@ -541,10 +541,10 @@ addVersionInfo (Just old_iface@(ModIface { mi_version = old_version, ...@@ -541,10 +541,10 @@ addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
mi_fixities = new_fixities }) mi_fixities = new_fixities })
| no_output_change && no_usage_change | no_output_change && no_usage_change
= Nothing = (old_iface, Nothing)
| otherwise -- Add updated version numbers | otherwise -- Add updated version numbers
= Just (final_iface, pp_tc_diffs) = (final_iface, Just pp_tc_diffs)
where where
final_iface = new_iface { mi_version = new_version } final_iface = new_iface { mi_version = new_version }
...@@ -613,11 +613,8 @@ diffDecls old_vers old_fixities new_fixities old new ...@@ -613,11 +613,8 @@ diffDecls old_vers old_fixities new_fixities old new
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
writeIface :: FilePath -> Maybe ModIface -> IO () writeIface :: FilePath -> ModIface -> IO ()
writeIface hi_path Nothing writeIface hi_path mod_iface
= return ()
writeIface hi_path (Just mod_iface)
= do { if_hdl <- openFile hi_path WriteMode = do { if_hdl <- openFile hi_path WriteMode
; printForIface if_hdl (pprIface mod_iface) ; printForIface if_hdl (pprIface mod_iface)
; hClose if_hdl ; 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