diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 51c5a08f116e0630502eb369e2f4ad40c8da31d6..642e90d729e9d24ca623574989db1d814319a8ff 100644
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -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)
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 1a3fc0dcb81634d5d3cee16371537d59f3c332f2..555afc5164bbb88e8d9be286ea6fa0e6a6e1a0f7 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
-----------------------------------------------------------------------------
--- $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
}
-----------------------------------------------------------------------------
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 8d09e720b3279dea2da9a756ac86bfc358bb8ef6..72a4cf7333e397d8e20d6520a7ed2a2cb04fcad4 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -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"
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 6fbf4ae5a00d250d68033925c85dbf13e0aa3db1..18735999eb86f441ba3166271b52fe2ace23a336 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -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