diff options
Diffstat (limited to 'compiler/main/HscMain.hs')
| -rw-r--r-- | compiler/main/HscMain.hs | 310 |
1 files changed, 163 insertions, 147 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index e5c6ce14ec..f783a9a9bc 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -19,10 +19,11 @@ -- from here on in (although it has mutable components, for the -- caches). -- --- Warning messages are dealt with consistently throughout this API: --- during compilation warnings are collected, and before any function --- in @HscMain@ returns, the warnings are either printed, or turned --- into a real compialtion error if the @-Werror@ flag is enabled. +-- We use the Hsc monad to deal with warning messages consistently: +-- specifically, while executing within an Hsc monad, warnings are +-- collected. When a Hsc monad returns to an IO monad, the +-- warnings are printed, or compilation aborts if the @-Werror@ +-- flag is enabled. -- -- (c) The GRASP/AQUA Project, Glasgow University, 1993-2000 -- @@ -36,12 +37,11 @@ module HscMain -- * Compiling complete source files , Messager, batchMsg , HscStatus (..) - , hscCompileOneShot + , hscIncrementalCompile , hscCompileCmmFile , hscCompileCore - , genericHscCompileGetFrontendResult - , genericHscMergeRequirement + , hscIncrementalFrontend , genModDetails , hscSimpleIface @@ -58,12 +58,14 @@ module HscMain , makeSimpleDetails , hscSimplify -- ToDo, shouldn't really export this + -- * Safe Haskell + , hscCheckSafe + , hscGetSafe + -- * Support for interactive evaluation , hscParseIdentifier , hscTcRcLookupName , hscTcRnGetInfo - , hscCheckSafe - , hscGetSafe #ifdef GHCI , hscIsGHCiMonad , hscGetModuleInterface @@ -513,73 +515,38 @@ This is the only thing that isn't caught by the type-system. type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO () --- | Analogous to 'genericHscCompileGetFrontendResult', this function --- calls 'hscMergeFrontEnd' if recompilation is necessary. It does --- not write out the resulting 'ModIface' (see 'compileOne'). --- TODO: maybe fold this 'genericHscCompileGetFrontendResult' into --- some higher-order function -genericHscMergeRequirement :: - Maybe Messager - -> HscEnv - -> ModSummary - -> Maybe ModIface -- Old interface, if available - -> (Int,Int) -- (i,n) = module i of n (for msgs) - -> IO (Either ModIface (ModIface, Maybe Fingerprint)) -genericHscMergeRequirement mHscMessage - hsc_env mod_summary mb_old_iface mod_index = do - let msg what = case mHscMessage of - Just hscMessage -> - hscMessage hsc_env mod_index what mod_summary - Nothing -> return () - - skip iface = do - msg UpToDate - return (Left iface) - - -- TODO: hook this - compile mb_old_hash reason = do - msg reason - r <- hscMergeFrontEnd hsc_env mod_summary - return $ Right (r, mb_old_hash) - - (recomp_reqd, mb_checked_iface) - <- {-# SCC "checkOldIface" #-} - checkOldIface hsc_env mod_summary - SourceUnmodified mb_old_iface - case mb_checked_iface of - Just iface | not (recompileRequired recomp_reqd) -> skip iface - _ -> compile (fmap mi_iface_hash mb_checked_iface) recomp_reqd - --- | This function runs 'genericHscFrontend' if recompilation is necessary. --- It does not write out the results of typechecking (see 'compileOne'). -genericHscCompileGetFrontendResult :: - Bool -- always do basic recompilation check? - -> Maybe TcGblEnv - -> Maybe Messager - -> HscEnv - -> ModSummary - -> SourceModified - -> Maybe ModIface -- Old interface, if available - -> (Int,Int) -- (i,n) = module i of n (for msgs) - -> IO (Either ModIface (TcGblEnv, Maybe Fingerprint)) - -genericHscCompileGetFrontendResult +-- | This function runs GHC's frontend with recompilation +-- avoidance. Specifically, it checks if recompilation is needed, +-- and if it is, it parses and typechecks the input module. +-- It does not write out the results of typechecking (See +-- compileOne and hscIncrementalCompile). +hscIncrementalFrontend :: Bool -- always do basic recompilation check? + -> Maybe TcGblEnv + -> Maybe Messager + -> ModSummary + -> SourceModified + -> Maybe ModIface -- Old interface, if available + -> (Int,Int) -- (i,n) = module i of n (for msgs) + -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint)) + +hscIncrementalFrontend always_do_basic_recompilation_check m_tc_result - mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index + mHscMessage mod_summary source_modified mb_old_iface mod_index = do + hsc_env <- getHscEnv let msg what = case mHscMessage of Just hscMessage -> hscMessage hsc_env mod_index what mod_summary Nothing -> return () skip iface = do - msg UpToDate + liftIO $ msg UpToDate return $ Left iface compile mb_old_hash reason = do - msg reason - tc_result <- runHsc hsc_env $ genericHscFrontend mod_summary - return $ Right (tc_result, mb_old_hash) + liftIO $ msg reason + result <- genericHscFrontend mod_summary + return $ Right (result, mb_old_hash) stable = case source_modified of SourceUnmodifiedAndStable -> True @@ -588,11 +555,11 @@ genericHscCompileGetFrontendResult case m_tc_result of Just tc_result | not always_do_basic_recompilation_check -> - return $ Right (tc_result, Nothing) + return $ Right (FrontendTypecheck tc_result, Nothing) _ -> do (recomp_reqd, mb_checked_iface) <- {-# SCC "checkOldIface" #-} - checkOldIface hsc_env mod_summary + liftIO $ checkOldIface hsc_env mod_summary source_modified mb_old_iface -- save the interface that comes back from checkOldIface. -- In one-shot mode we don't have the old iface until this @@ -624,101 +591,149 @@ genericHscCompileGetFrontendResult case m_tc_result of Nothing -> compile mb_old_hash recomp_reqd Just tc_result -> - return $ Right (tc_result, mb_old_hash) + return $ Right (FrontendTypecheck tc_result, mb_old_hash) -genericHscFrontend :: ModSummary -> Hsc TcGblEnv +genericHscFrontend :: ModSummary -> Hsc FrontendResult genericHscFrontend mod_summary = getHooked hscFrontendHook genericHscFrontend' >>= ($ mod_summary) -genericHscFrontend' :: ModSummary -> Hsc TcGblEnv -genericHscFrontend' mod_summary = hscFileFrontEnd mod_summary +genericHscFrontend' :: ModSummary -> Hsc FrontendResult +genericHscFrontend' mod_summary + | ms_hsc_src mod_summary == HsBootMerge + = FrontendMerge `fmap` hscMergeFrontEnd mod_summary + | otherwise + = FrontendTypecheck `fmap` hscFileFrontEnd mod_summary -------------------------------------------------------------- -- Compilers -------------------------------------------------------------- -hscCompileOneShot :: HscEnv - -> ModSummary - -> SourceModified - -> IO HscStatus -hscCompileOneShot env = - lookupHook hscCompileOneShotHook hscCompileOneShot' (hsc_dflags env) env - -- Compile Haskell/boot in OneShot mode. -hscCompileOneShot' :: HscEnv - -> ModSummary - -> SourceModified - -> IO HscStatus -hscCompileOneShot' hsc_env mod_summary src_changed +hscIncrementalCompile :: Bool + -> Maybe TcGblEnv + -> Maybe Messager + -> HscEnv + -> ModSummary + -> SourceModified + -> Maybe ModIface + -> (Int,Int) + -- HomeModInfo does not contain linkable, since we haven't + -- code-genned yet + -> IO (HscStatus, HomeModInfo) +hscIncrementalCompile always_do_basic_recompilation_check m_tc_result + mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index = do -- One-shot mode needs a knot-tying mutable variable for interface -- files. See TcRnTypes.TcGblEnv.tcg_type_env_var. type_env_var <- newIORef emptyNameEnv let mod = ms_mod mod_summary - hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) } + hsc_env = hsc_env'{ hsc_type_env_var = Just (mod, type_env_var) } - msg what = oneShotMsg hsc_env' what - - skip = do msg UpToDate - dumpIfaceStats hsc_env' - return HscUpToDate + -- NB: enter Hsc monad here so that we don't bail out early with + -- -Werror on typechecker warnings; we also want to run the desugarer + -- to get those warnings too. (But we'll always exit at that point + -- because the desugarer runs ioMsgMaybe.) + runHsc hsc_env $ do + let dflags = hsc_dflags hsc_env - compile mb_old_hash reason = runHsc hsc_env' $ do - liftIO $ msg reason - tc_result <- genericHscFrontend mod_summary - guts0 <- hscDesugar' (ms_location mod_summary) tc_result - dflags <- getDynFlags + e <- hscIncrementalFrontend always_do_basic_recompilation_check m_tc_result mHscMessage + mod_summary source_modified mb_old_iface mod_index + case e of + Left iface -> do + details <- liftIO $ genModDetails hsc_env iface + return (HscUpToDate, HomeModInfo{ + hm_details = details, + hm_iface = iface, + hm_linkable = Nothing + }) + Right (result, mb_old_hash) -> do + (status, hmi, no_change) <- case result of + FrontendTypecheck tc_result -> + 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 + FrontendMerge raw_iface -> + finishMerge hsc_env mod_summary raw_iface mb_old_hash + liftIO $ hscMaybeWriteIface dflags (hm_iface hmi) no_change mod_summary + return (status, hmi) + +-- Generates and writes out the final interface for an hs-boot merge. +finishMerge :: HscEnv + -> ModSummary + -> ModIface + -> Maybe Fingerprint + -> Hsc (HscStatus, HomeModInfo, Bool) +finishMerge hsc_env summary iface0 mb_old_hash = do + MASSERT( ms_hsc_src summary == HsBootMerge ) + (iface, changed) <- liftIO $ mkIfaceDirect hsc_env mb_old_hash iface0 + details <- liftIO $ genModDetails hsc_env iface + let dflags = hsc_dflags hsc_env + hsc_status = case hscTarget dflags of - HscNothing -> do - when (gopt Opt_WriteInterface dflags) $ liftIO $ do - (iface, changed, _details) <- hscSimpleIface hsc_env tc_result mb_old_hash - hscWriteIface dflags iface changed mod_summary - return HscNotGeneratingCode - _ -> - case ms_hsc_src mod_summary of - HsBootFile -> - do (iface, changed, _) <- hscSimpleIface' tc_result mb_old_hash - liftIO $ hscWriteIface dflags iface changed mod_summary - return HscUpdateBoot - HsSrcFile -> - do guts <- hscSimplify' guts0 - (iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash - liftIO $ hscWriteIface dflags iface changed mod_summary - return $ HscRecomp cgguts mod_summary - HsBootMerge -> panic "hscCompileOneShot HsBootMerge" - - -- XXX This is always False, because in one-shot mode the - -- concept of stability does not exist. The driver never - -- passes SourceUnmodifiedAndStable in here. - stable = case src_changed of - SourceUnmodifiedAndStable -> True - _ -> False - - (recomp_reqd, mb_checked_iface) - <- {-# SCC "checkOldIface" #-} - checkOldIface hsc_env' mod_summary src_changed Nothing - -- save the interface that comes back from checkOldIface. - -- In one-shot mode we don't have the old iface until this - -- point, when checkOldIface reads it from the disk. - let mb_old_hash = fmap mi_iface_hash mb_checked_iface - - case mb_checked_iface of - Just iface | not (recompileRequired recomp_reqd) -> - -- If the module used TH splices when it was last compiled, - -- then the recompilation check is not accurate enough (#481) - -- and we must ignore it. However, if the module is stable - -- (none of the modules it depends on, directly or indirectly, - -- changed), then we *can* skip recompilation. This is why - -- the SourceModified type contains SourceUnmodifiedAndStable, - -- and it's pretty important: otherwise ghc --make would - -- always recompile TH modules, even if nothing at all has - -- changed. Stability is just the same check that make is - -- doing for us in one-shot mode. - if mi_used_th iface && not stable - then compile mb_old_hash (RecompBecause "TH") - else skip - _ -> - compile mb_old_hash recomp_reqd + HscNothing -> HscNotGeneratingCode + _ -> HscUpdateBootMerge + return (hsc_status, + HomeModInfo{ hm_details = details, + hm_iface = iface, + hm_linkable = Nothing }, + changed) + +-- Generates and writes out the final interface for a typecheck. +finishTypecheckOnly :: HscEnv + -> ModSummary + -> TcGblEnv + -> Maybe Fingerprint + -> Hsc (HscStatus, HomeModInfo, Bool) +finishTypecheckOnly hsc_env summary tc_result mb_old_hash = do + let dflags = hsc_dflags hsc_env + MASSERT( hscTarget dflags == HscNothing || ms_hsc_src summary == HsBootFile ) + (iface, changed, details) <- liftIO $ hscSimpleIface hsc_env tc_result mb_old_hash + let hsc_status = + case (hscTarget dflags, ms_hsc_src summary) of + (HscNothing, _) -> HscNotGeneratingCode + (_, HsBootFile) -> HscUpdateBoot + _ -> panic "finishTypecheckOnly" + return (hsc_status, + HomeModInfo{ hm_details = details, + hm_iface = iface, + hm_linkable = Nothing }, + changed) + +-- Runs the post-typechecking frontend (desugar and simplify), +-- and then generates and writes out the final interface. We want +-- to write the interface AFTER simplification so we can get +-- as up-to-date and good unfoldings and other info as possible +-- in the interface file. This is only ever run for HsSrcFile, +-- and NOT for HscNothing. +finish :: HscEnv + -> ModSummary + -> TcGblEnv + -> Maybe Fingerprint + -> Hsc (HscStatus, HomeModInfo, Bool) +finish hsc_env summary tc_result mb_old_hash = do + let dflags = hsc_dflags hsc_env + MASSERT( ms_hsc_src summary == HsSrcFile ) + MASSERT( hscTarget dflags /= HscNothing ) + guts0 <- hscDesugar' (ms_location summary) tc_result + guts <- hscSimplify' guts0 + (iface, changed, details, cgguts) <- liftIO $ hscNormalIface hsc_env guts mb_old_hash + + return (HscRecomp cgguts summary, + HomeModInfo{ hm_details = details, + hm_iface = iface, + hm_linkable = Nothing }, + changed) + +hscMaybeWriteIface :: DynFlags -> ModIface -> Bool -> ModSummary -> IO () +hscMaybeWriteIface dflags iface changed summary = + let force_write_interface = gopt Opt_WriteInterface dflags + write_interface = case hscTarget dflags of + HscNothing -> False + HscInterpreted -> False + _ -> True + in when (write_interface || force_write_interface) $ + hscWriteIface dflags iface changed summary -------------------------------------------------------------- -- NoRecomp handlers @@ -768,8 +783,9 @@ batchMsg hsc_env mod_index recomp mod_summary = -- | Given an 'HsBootMerge' 'ModSummary', merges all @hs-boot@ files -- under this module name into a composite, publically visible 'ModIface'. -hscMergeFrontEnd :: HscEnv -> ModSummary -> IO ModIface -hscMergeFrontEnd hsc_env mod_summary = do +hscMergeFrontEnd :: ModSummary -> Hsc ModIface +hscMergeFrontEnd mod_summary = do + hsc_env <- getHscEnv MASSERT( ms_hsc_src mod_summary == HsBootMerge ) let dflags = hsc_dflags hsc_env -- TODO: actually merge in signatures from external packages. @@ -783,7 +799,7 @@ hscMergeFrontEnd hsc_env mod_summary = do iface0 <- case lookupHptByModule hpt mod of Just hm -> return (hm_iface hm) Nothing -> do - mb_iface0 <- initIfaceCheck hsc_env + mb_iface0 <- liftIO . initIfaceCheck hsc_env $ findAndReadIface (text "merge-requirements") mod is_boot case mb_iface0 of |