import Module ( ModuleName, moduleName, mkModuleInThisPackage )
import CmdLineOpts
import ErrUtils ( dumpIfSet_dyn )
+import Util ( unJust )
import UniqSupply ( mkSplitUniqSupply )
import Bag ( emptyBag )
import StgInterp ( ItblEnv )
import FiniteMap ( FiniteMap, plusFM, emptyFM, addToFM )
import OccName ( OccName )
-import Name ( Name, nameModule, emptyNameEnv, nameOccName, getName )
+import Name ( Name, nameModule, nameOccName, getName )
+import Name ( emptyNameEnv )
import Module ( Module, lookupModuleEnvByName )
\end{code}
hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
= do {
- putStrLn "checking old iface ...";
+ putStrLn "CHECKING OLD IFACE";
(pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
- <- checkOldIface dflags hit hst pcs (hi_file location)
+ <- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain")
source_unchanged maybe_old_iface;
if check_errs then
return (HscFail pcs_ch)
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
}}
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
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 (hs_preprocd_file location);
+ maybe_parsed
+ <- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp");
case maybe_parsed of {
Nothing -> return (HscFail pcs_ch);
Just rdr_module -> do {
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 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)
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
+ -> do if dopt Opt_D_dump_hi_diffs dflags then
+ printDump (text "INTERFACE UNCHANGED")
+ else return ()
+ 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"
= do (ibinds,itbl_env)
<- stgToInterpSyn (map fst stg_binds) local_tycons local_classes
return (Nothing, Nothing, Just (ibinds,itbl_env))
+
| otherwise
= do -------------------------- Code generation -------------------------------
show_pass dflags "CodeGen"
-- _scc_ "CodeGen"
abstractC <- codeGen dflags this_mod imported_modules
cost_centre_info fe_binders
- local_tycons local_classes stg_binds
+ local_tycons stg_binds
-------------------------- Code output -------------------------------
show_pass dflags "CodeOutput"
-- _scc_ "CodeOutput"
- ncg_uniqs <- mkSplitUniqSupply 'n'
(maybe_stub_h_name, maybe_stub_c_name)
- <- codeOutput dflags this_mod local_tycons local_classes
+ <- codeOutput dflags this_mod local_tycons
oa_tidy_binds stg_binds
- c_code h_code abstractC ncg_uniqs
+ c_code h_code abstractC
return (maybe_stub_h_name, maybe_stub_c_name, Nothing)
where