- = do {
- when (verbosity dflags >= 1) $
- hPutStrLn stderr ("Skipping " ++ compMsg mod location);
-
- -- CLOSURE
- (pcs_cl, closure_errs, cl_hs_decls)
- <- closeIfaceDecls dflags hit hst pcs_ch old_iface ;
- if closure_errs then
- return (HscFail pcs_cl)
- else do {
-
- -- TYPECHECK
- maybe_tc_result
- <- typecheckIface dflags pcs_cl hst old_iface (vanillaSyntaxMap, cl_hs_decls);
+ = do { compilationProgressMsg (hsc_dflags hsc_env) $
+ (showModuleIndex mb_mod_index ++
+ "Skipping " ++ showModMsg have_object mod_summary)
+
+ ; new_details <- {-# SCC "tcRnIface" #-}
+ initIfaceCheck hsc_env $
+ typecheckIface old_iface ;
+ ; dumpIfaceStats hsc_env
+
+ ; return (HscNoRecomp new_details old_iface)
+ }
+
+hscNoRecomp hsc_env msg_act mod_summary
+ have_object Nothing
+ mb_mod_index
+ = panic "hscNoRecomp" -- hscNoRecomp definitely expects to
+ -- have the old interface available
+
+------------------------------
+hscRecomp hsc_env msg_act mod_summary
+ have_object maybe_old_iface
+ mb_mod_index
+ = case ms_hsc_src mod_summary of
+ HsSrcFile -> do
+ front_res <- hscFileFrontEnd hsc_env msg_act mod_summary mb_mod_index
+ hscBackEnd hsc_env mod_summary maybe_old_iface front_res
+
+ HsBootFile -> do
+ front_res <- hscFileFrontEnd hsc_env msg_act mod_summary mb_mod_index
+ hscBootBackEnd hsc_env mod_summary maybe_old_iface front_res
+
+ ExtCoreFile -> do
+ front_res <- hscCoreFrontEnd hsc_env msg_act mod_summary
+ hscBackEnd hsc_env mod_summary maybe_old_iface front_res
+
+hscCoreFrontEnd hsc_env msg_act mod_summary = do {
+ -------------------
+ -- PARSE
+ -------------------
+ ; inp <- readFile (expectJust "hscCoreFrontEnd" (ms_hspp_file mod_summary))
+ ; case parseCore inp 1 of
+ FailP s -> putMsg s{-ToDo: wrong-} >> return Nothing
+ OkP rdr_module -> do {
+
+ -------------------
+ -- RENAME and TYPECHECK
+ -------------------
+ ; (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
+ tcRnExtCore hsc_env rdr_module
+ ; msg_act tc_msgs
+ ; case maybe_tc_result of
+ Nothing -> return Nothing
+ Just mod_guts -> return (Just mod_guts) -- No desugaring to do!
+ }}
+
+
+hscFileFrontEnd hsc_env msg_act mod_summary mb_mod_index = do {
+ -------------------
+ -- DISPLAY PROGRESS MESSAGE
+ -------------------
+ let one_shot = isOneShot (ghcMode (hsc_dflags hsc_env))
+ ; let dflags = hsc_dflags hsc_env
+ ; let toInterp = hscTarget dflags == HscInterpreted
+ ; when (not one_shot) $
+ compilationProgressMsg dflags $
+ (showModuleIndex mb_mod_index ++
+ "Compiling " ++ showModMsg (not toInterp) mod_summary)
+
+ -------------------
+ -- PARSE
+ -------------------
+ ; let hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
+ hspp_buf = ms_hspp_buf mod_summary