diff options
Diffstat (limited to 'compiler/main/HscMain.hs')
| -rw-r--r-- | compiler/main/HscMain.hs | 56 |
1 files changed, 43 insertions, 13 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 5e14e77117..cd8b56843f 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -79,6 +79,8 @@ module HscMain , hscSimpleIface', hscNormalIface' , oneShotMsg , hscFileFrontEnd, genericHscFrontend, dumpIfaceStats + , ioMsgMaybe + , showModuleIndex ) where #ifdef GHCI @@ -135,6 +137,7 @@ import InstEnv import FamInstEnv import Fingerprint ( Fingerprint ) import Hooks +import TcEnv import Maybes import DynFlags @@ -342,7 +345,9 @@ hscParse hsc_env mod_summary = runHsc hsc_env $ hscParse' mod_summary -- internal version, that doesn't fail due to -Werror hscParse' :: ModSummary -> Hsc HsParsedModule -hscParse' mod_summary = {-# SCC "Parser" #-} +hscParse' mod_summary + | Just r <- ms_parsed_mod mod_summary = return r + | otherwise = {-# SCC "Parser" #-} withTiming getDynFlags (text "Parser"<+>brackets (ppr $ ms_mod mod_summary)) (const ()) $ do @@ -359,8 +364,11 @@ hscParse' mod_summary = {-# SCC "Parser" #-} Nothing -> liftIO $ hGetStringBuffer src_filename let loc = mkRealSrcLoc (mkFastString src_filename) 1 1 + let parseMod | HsigFile == ms_hsc_src mod_summary + = parseSignature + | otherwise = parseModule - case unP parseModule (mkPState dflags buf loc) of + case unP parseMod (mkPState dflags buf loc) of PFailed span err -> liftIO $ throwOneError (mkPlainErrMsg dflags span err) @@ -417,7 +425,7 @@ type RenamedStuff = hscTypecheckRename :: HscEnv -> ModSummary -> HsParsedModule -> IO (TcGblEnv, RenamedStuff) hscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $ do - tc_result <- tcRnModule' hsc_env mod_summary True rdr_module + tc_result <- hscTypecheck True mod_summary (Just rdr_module) -- This 'do' is in the Maybe monad! let rn_info = do decl <- tcg_rn_decls tc_result @@ -428,6 +436,31 @@ hscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $ do return (tc_result, rn_info) +hscTypecheck :: Bool -- ^ Keep renamed source? + -> ModSummary -> Maybe HsParsedModule + -> Hsc TcGblEnv +hscTypecheck keep_rn mod_summary mb_rdr_module = do + hsc_env <- getHscEnv + let hsc_src = ms_hsc_src mod_summary + dflags = hsc_dflags hsc_env + outer_mod = ms_mod mod_summary + inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod) + src_filename = ms_hspp_file mod_summary + real_loc = realSrcLocSpan $ mkRealSrcLoc (mkFastString src_filename) 1 1 + MASSERT( moduleUnitId outer_mod == thisPackage dflags ) + if hsc_src == HsigFile && not (isHoleModule inner_mod) + then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod real_loc + else + do hpm <- case mb_rdr_module of + Just hpm -> return hpm + Nothing -> hscParse' mod_summary + tc_result0 <- tcRnModule' hsc_env mod_summary keep_rn hpm + if hsc_src == HsigFile + then do (iface, _, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 Nothing + ioMsgMaybe $ + tcRnMergeSignatures hsc_env (tcg_top_loc tc_result0) iface + else return tc_result0 + -- wrapper around tcRnModule to handle safe haskell extras tcRnModule' :: HscEnv -> ModSummary -> Bool -> HsParsedModule -> Hsc TcGblEnv @@ -689,11 +722,12 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result -- to retypecheck but the resulting interface is exactly -- the same.) Right (FrontendTypecheck tc_result, mb_old_hash) -> do - (status, hmi, no_change) <- - if hscTarget dflags /= HscNothing && - ms_hsc_src mod_summary == HsSrcFile - then finish hsc_env mod_summary tc_result mb_old_hash - else finishTypecheckOnly hsc_env mod_summary tc_result mb_old_hash + (status, hmi, no_change) + <- case ms_hsc_src mod_summary of + HsSrcFile | hscTarget dflags /= HscNothing -> + finish hsc_env mod_summary tc_result mb_old_hash + _ -> + finishTypecheckOnly hsc_env mod_summary tc_result mb_old_hash liftIO $ hscMaybeWriteIface dflags (hm_iface hmi) no_change mod_summary return (status, hmi) @@ -803,11 +837,7 @@ batchMsg hsc_env mod_index recomp mod_summary = -- | Given a 'ModSummary', parses and typechecks it, returning the -- 'TcGblEnv' resulting from type-checking. hscFileFrontEnd :: ModSummary -> Hsc TcGblEnv -hscFileFrontEnd mod_summary = do - hpm <- hscParse' mod_summary - hsc_env <- getHscEnv - tcg_env <- tcRnModule' hsc_env mod_summary False hpm - return tcg_env +hscFileFrontEnd mod_summary = hscTypecheck False mod_summary Nothing -------------------------------------------------------------- -- Safe Haskell |