diff options
| -rw-r--r-- | ghc/compiler/main/CodeOutput.lhs | 5 | ||||
| -rw-r--r-- | ghc/compiler/main/DriverPipeline.hs | 35 | ||||
| -rw-r--r-- | ghc/compiler/main/HscMain.lhs | 34 | ||||
| -rw-r--r-- | ghc/compiler/main/MkIface.lhs | 25 |
4 files changed, 54 insertions, 45 deletions
diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs index 51c5a08f11..642e90d729 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 1a3fc0dcb8..555afc5164 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 8d09e720b3..72a4cf7333 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 6fbf4ae5a0..18735999eb 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 |