-hscCoreFrontEnd :: FrontEnd ModGuts
-hscCoreFrontEnd hsc_env mod_summary mb_mod_index = do {
- -------------------
- -- PARSE
- -------------------
- ; inp <- readFile (expectJust "hscCoreFrontEnd" (ms_hspp_file mod_summary))
- ; case parseCore inp 1 of
- FailP s -> do errorMsg (hsc_dflags hsc_env) (text s{-ToDo: wrong-})
- return Nothing
- OkP rdr_module -> do {
-
- -------------------
- -- RENAME and TYPECHECK
- -------------------
- ; (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
- tcRnExtCore hsc_env rdr_module
- ; printErrorsAndWarnings (hsc_dflags hsc_env) tc_msgs
- ; case maybe_tc_result of
- Nothing -> return Nothing
- Just mod_guts -> return (Just mod_guts) -- No desugaring to do!
- }}
-
-hscFileFrontEnd :: FrontEnd ModGuts
-hscFileFrontEnd hsc_env mod_summary mb_mod_index = do {
--- FIXME: Move 'DISPLAY PROGRESS MESSAGE' out of the frontend.
- -------------------
- -- DISPLAY PROGRESS MESSAGE
- -------------------
- ; let dflags = hsc_dflags hsc_env
- one_shot = isOneShot (ghcMode dflags)
- 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
+oneShotMsg :: Maybe (Int,Int) -> Bool -> Comp ()
+oneShotMsg _mb_mod_index recomp
+ = do hsc_env <- gets compHscEnv
+ liftIO $ do
+ if recomp
+ then return ()
+ else compilationProgressMsg (hsc_dflags hsc_env) $
+ "compilation IS NOT required"
+
+batchMsg :: Bool -> Maybe (Int,Int) -> Bool -> Comp ()
+batchMsg toInterp mb_mod_index recomp
+ = do hsc_env <- gets compHscEnv
+ mod_summary <- gets compModSummary
+ let showMsg msg = compilationProgressMsg (hsc_dflags hsc_env) $
+ (showModuleIndex mb_mod_index ++
+ msg ++ showModMsg (not toInterp) mod_summary)
+ liftIO $ do
+ if recomp
+ then showMsg "Compiling "
+ else showMsg "Skipping "