diff options
author | Divam <dfordivam@gmail.com> | 2021-04-19 13:49:30 +0900 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-25 05:50:51 -0400 |
commit | f243acf4d7322a15e9eb6e432c490a4d6db741df (patch) | |
tree | f01d9ab4799043931488fa3c97a0ce75a3e4c7c1 | |
parent | a3665a7aa5db8a77809b8e2246b8cd7eee86935c (diff) | |
download | haskell-f243acf4d7322a15e9eb6e432c490a4d6db741df.tar.gz |
Refactor driver code; de-duplicate and split APIs (#14095, !5555)
This commit does some de-duplication of logic between the one-shot and --make
modes, and splitting of some of the APIs so that its easier to do the
fine-grained parallelism implementation. This is the first part of the
implementation plan as described in #14095
* compileOne now uses the runPhase pipeline for most of the work.
The Interpreter backend handling has been moved to the runPhase.
* hscIncrementalCompile has been broken down into multiple APIs.
* haddock submodule bump: Rename of variables in html-test ref:
This is caused by a change in ModDetails in case of NoBackend.
Now the initModDetails is used to recreate the ModDetails from interface and
in-memory ModDetails is not used.
-rw-r--r-- | compiler/GHC/Driver/Env.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Driver/Main.hs | 202 | ||||
-rw-r--r-- | compiler/GHC/Driver/Make.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 431 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline/Monad.hs | 38 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Iface/Recomp.hs | 26 | ||||
-rw-r--r-- | compiler/GHC/Unit/Module/Status.hs | 24 | ||||
m--------- | utils/haddock | 0 |
9 files changed, 368 insertions, 367 deletions
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs index 756d8eaff0..fe0137c786 100644 --- a/compiler/GHC/Driver/Env.hs +++ b/compiler/GHC/Driver/Env.hs @@ -8,6 +8,7 @@ module GHC.Driver.Env , hsc_HPT , hscUpdateHPT , runHsc + , runHsc' , mkInteractiveHscEnv , runInteractiveHsc , hscEPS @@ -31,6 +32,7 @@ import GHC.Prelude import GHC.Driver.Ppr import GHC.Driver.Session import GHC.Driver.Errors ( printOrThrowDiagnostics ) +import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Runtime.Context import GHC.Runtime.Interpreter.Types (Interp) @@ -51,7 +53,7 @@ import GHC.Core.InstEnv ( ClsInst ) import GHC.Types.Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv ) import GHC.Types.CompleteMatch -import GHC.Types.Error ( emptyMessages ) +import GHC.Types.Error ( emptyMessages, Messages ) import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.TyThing @@ -76,6 +78,9 @@ runHsc hsc_env (Hsc hsc) = do printOrThrowDiagnostics (hsc_logger hsc_env) (hsc_dflags hsc_env) w return a +runHsc' :: HscEnv -> Hsc a -> IO (a, Messages GhcMessage) +runHsc' hsc_env (Hsc hsc) = hsc hsc_env emptyMessages + -- | Switches in the DynFlags and Plugins from the InteractiveContext mkInteractiveHscEnv :: HscEnv -> HscEnv mkInteractiveHscEnv hsc_env = diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 8c09f4434c..f0204246b6 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -40,8 +40,7 @@ module GHC.Driver.Main -- * Compiling complete source files , Messager, batchMsg - , HscStatus (..) - , hscIncrementalCompile + , HscBackendAction (..), HscRecompStatus (..) , initModDetails , hscMaybeWriteIface , hscCompileCmmFile @@ -50,11 +49,14 @@ module GHC.Driver.Main , hscInteractive -- * Running passes separately + , hscRecompStatus , hscParse , hscTypecheckRename + , hscTypecheckAndGetWarnings , hscDesugar , makeSimpleDetails , hscSimplify -- ToDo, shouldn't really export this + , hscDesugarAndSimplify -- * Safe Haskell , hscCheckSafe @@ -198,7 +200,6 @@ import GHC.Types.IPE import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Name -import GHC.Types.Name.Env import GHC.Types.Name.Cache ( initNameCache ) import GHC.Types.Name.Reader import GHC.Types.Name.Ppr @@ -518,6 +519,12 @@ hscTypecheckRename :: HscEnv -> ModSummary -> HsParsedModule hscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $ hsc_typecheck True mod_summary (Just rdr_module) +-- | Do Typechecking without throwing SourceError exception with -Werror +hscTypecheckAndGetWarnings :: HscEnv -> ModSummary -> IO (FrontendResult, WarningMessages) +hscTypecheckAndGetWarnings hsc_env summary = runHsc' hsc_env $ do + case hscFrontendHook (hsc_hooks hsc_env) of + Nothing -> FrontendTypecheck . fst <$> hsc_typecheck False summary Nothing + Just h -> h summary -- | A bunch of logic piled around @tcRnModule'@, concerning a) backpack -- b) concerning dumping rename info and hie files. It would be nice to further @@ -627,14 +634,9 @@ hscDesugar hsc_env mod_summary tc_result = hscDesugar' :: ModLocation -> TcGblEnv -> Hsc ModGuts hscDesugar' mod_location tc_result = do hsc_env <- getHscEnv - r <- ioMsgMaybe $ hoistDsMessage $ - {-# SCC "deSugar" #-} - deSugar hsc_env mod_location tc_result - - -- always check -Werror after desugaring, this is the last opportunity for - -- warnings to arise before the backend. - handleWarnings - return r + ioMsgMaybe $ hoistDsMessage $ + {-# SCC "deSugar" #-} + deSugar hsc_env mod_location tc_result -- | Make a 'ModDetails' from the results of typechecking. Used when -- typechecking only, as opposed to full compilation. @@ -687,140 +689,41 @@ This is the only thing that isn't caught by the type-system. type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModuleGraphNode -> IO () --- | 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 mod_summary source_modified mb_old_iface mod_index - = do - hsc_env <- getHscEnv - - let msg what = case mHscMessage of +-- | Do the recompilation avoidance checks for both one-shot and --make modes +hscRecompStatus :: Maybe Messager + -> HscEnv + -> ModSummary + -> SourceModified + -> Maybe ModIface + -> (Int,Int) + -> IO HscRecompStatus +hscRecompStatus + mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index + = do + let + msg what = case mHscMessage of -- We use extendModSummaryNoDeps because extra backpack deps are only needed for batch mode Just hscMessage -> hscMessage hsc_env mod_index what (ModuleNode (extendModSummaryNoDeps mod_summary)) Nothing -> return () - skip iface = do - liftIO $ msg UpToDate - return $ Left iface - - compile mb_old_hash reason = do - liftIO $ msg reason - tc_result <- case hscFrontendHook (hsc_hooks hsc_env) of - Nothing -> FrontendTypecheck . fst <$> hsc_typecheck False mod_summary Nothing - Just h -> h mod_summary - return $ Right (tc_result, mb_old_hash) - - stable = case source_modified of - SourceUnmodifiedAndStable -> True - _ -> False - - case m_tc_result of - Just tc_result - | not always_do_basic_recompilation_check -> - return $ Right (FrontendTypecheck tc_result, Nothing) - _ -> do - (recomp_reqd, mb_checked_iface) - <- {-# SCC "checkOldIface" #-} - 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 - -- point, when checkOldIface reads it from the disk. - let mb_old_hash = fmap (mi_iface_hash . mi_final_exts) 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. - case m_tc_result of - Nothing - | mi_used_th iface && not stable -> - compile mb_old_hash (RecompBecause "TH") - _ -> - skip iface - _ -> - case m_tc_result of - Nothing -> compile mb_old_hash recomp_reqd - Just tc_result -> - return $ Right (FrontendTypecheck tc_result, mb_old_hash) + (recomp_reqd, mb_checked_iface) + <- {-# SCC "checkOldIface" #-} + liftIO $ checkOldIface hsc_env mod_summary + source_modified mb_old_iface --------------------------------------------------------------- --- Compilers --------------------------------------------------------------- + -- 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 . mi_final_exts) mb_checked_iface --- | Used by both OneShot and batch mode. Runs the pipeline HsSyn and Core parts --- of the pipeline. --- We return a interface if we already had an old one around and recompilation --- was not needed. Otherwise it will be created during later passes when we --- run the compilation pipeline. -hscIncrementalCompile :: Bool - -> Maybe TcGblEnv - -> Maybe Messager - -> HscEnv - -> ModSummary - -> SourceModified - -> Maybe ModIface - -> (Int,Int) - -> IO (HscStatus, HscEnv) -hscIncrementalCompile always_do_basic_recompilation_check m_tc_result - mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index - = do - hsc_env'' <- initializePlugins hsc_env' - - -- One-shot mode needs a knot-tying mutable variable for interface - -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var. - -- See also Note [hsc_type_env_var hack] - type_env_var <- newIORef emptyNameEnv - let mod = ms_mod mod_summary - hsc_env | isOneShot (ghcMode (hsc_dflags hsc_env'')) - = hsc_env'' { hsc_type_env_var = Just (mod, type_env_var) } - | otherwise - = hsc_env'' - - -- 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 - e <- hscIncrementalFrontend always_do_basic_recompilation_check m_tc_result mHscMessage - mod_summary source_modified mb_old_iface mod_index - case e of + msg recomp_reqd + case mb_checked_iface of + Just iface | not (recompileRequired recomp_reqd) -> do -- We didn't need to do any typechecking; the old interface -- file on disk was good enough. - Left iface -> do - details <- liftIO $ initModDetails hsc_env mod_summary iface - return (HscUpToDate iface details, hsc_env') - -- We finished type checking. (mb_old_hash is the hash of - -- the interface that existed on disk; it's possible we had - -- to retypecheck but the resulting interface is exactly - -- the same.) - Right (FrontendTypecheck tc_result, mb_old_hash) -> do - status <- finish mod_summary tc_result mb_old_hash - return (status, hsc_env) + return $ HscUpToDate iface + + _ -> return $ HscRecompNeeded mb_old_hash -- Knot tying! See Note [Knot-tying typecheckIface] -- See Note [ModDetails and --make mode] @@ -892,11 +795,12 @@ See !5492 and #13586 -- HscRecomp in turn will carry the information required to compute a interface -- when passed the result of the code generator. So all this can and is done at -- the call site of the backend code gen if it is run. -finish :: ModSummary - -> TcGblEnv +hscDesugarAndSimplify :: ModSummary + -> FrontendResult + -> Messages GhcMessage -> Maybe Fingerprint - -> Hsc HscStatus -finish summary tc_result mb_old_hash = do + -> Hsc HscBackendAction +hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_hash = do hsc_env <- getHscEnv dflags <- getDynFlags logger <- getLogger @@ -914,6 +818,11 @@ finish summary tc_result mb_old_hash = do then Just <$> hscDesugar' (ms_location summary) tc_result else pure Nothing + -- Report the warnings from both typechecking and desugar together + w <- getDiagnostics + liftIO $ printOrThrowDiagnostics logger dflags (unionMessages tc_warnings w) + clearDiagnostics + -- Simplify, if appropriate, and (whether we simplified or not) generate an -- interface file. case mb_desugar of @@ -940,17 +849,12 @@ finish summary tc_result mb_old_hash = do -- We are not generating code, so we can skip simplification -- and generate a simple interface. _ -> do - (iface, mb_old_iface_hash, details) <- liftIO $ + (iface, mb_old_iface_hash, _details) <- liftIO $ hscSimpleIface hsc_env tc_result mb_old_hash liftIO $ hscMaybeWriteIface logger dflags True iface mb_old_iface_hash (ms_location summary) - return $ case bcknd of - NoBackend -> HscNotGeneratingCode iface details - _ -> case hsc_src of - HsBootFile -> HscUpdateBoot iface details - HsigFile -> HscUpdateSig iface details - _ -> panic "finish" + return $ HscUpdate iface {- Note [Writing interface files] @@ -975,7 +879,7 @@ contents). Cases for which we generate simple interfaces: - * GHC.Driver.Main.finish: when a compilation does NOT require (re)compilation + * GHC.Driver.Main.hscDesugarAndSimplify: when a compilation does NOT require (re)compilation of the hard code * GHC.Driver.Pipeline.compileOne': when we run in One Shot mode and target diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 30920ced1d..855675aa67 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -2408,7 +2408,11 @@ enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd let ms' = ms { ms_location = ms_location {ml_hi_file = hi_file, ml_obj_file = o_file} - , ms_hspp_opts = updOptLevel 0 $ dflags {backend = bcknd} + , ms_hspp_opts = updOptLevel 0 $ + setOutputFile (Just o_file) $ + setDynOutputFile (Just $ dynamicOutputFile dflags o_file) $ + setOutputHi (Just hi_file) $ + dflags {backend = bcknd} } pure (ExtendedModSummary ms' bkp_deps) | otherwise = return (ExtendedModSummary ms bkp_deps) diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index c4de774033..f8ad427dc2 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -71,6 +71,7 @@ import GHC.Linker.Types import GHC.Utils.Outputable import GHC.Utils.Error +import GHC.Utils.Fingerprint import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc @@ -87,9 +88,11 @@ import GHC.Data.StringBuffer ( hGetStringBuffer, hPutStringBuffer ) import GHC.Data.Maybe ( expectJust ) import GHC.Iface.Make ( mkFullIface ) +import GHC.Runtime.Loader ( initializePlugins ) import GHC.Types.Basic ( SuccessFlag(..) ) import GHC.Types.Error ( singleMessage, getMessages ) +import GHC.Types.Name.Env import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile @@ -110,6 +113,7 @@ import System.FilePath import System.IO import Control.Monad import qualified Control.Monad.Catch as MC (handle) +import Data.IORef import Data.List ( isInfixOf, intercalate ) import Data.Maybe import Data.Version @@ -137,7 +141,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = MC.handle handler $ fmap Right $ do massertPpr (isJust mb_phase || isHaskellSrcFilename input_fn) (text input_fn) - (dflags, fp, mb_iface) <- runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase) + (dflags, fp, mb_iface, mb_linkable) <- runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase) Nothing -- We keep the processed file for the whole session to save on -- duplicated work in ghci. @@ -146,6 +150,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = []{-no foreign objects-} -- We stop before Hsc phase so we shouldn't generate an interface massert (isNothing mb_iface) + massert (isNothing mb_linkable) return (dflags, fp) where srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1 @@ -205,18 +210,8 @@ compileOne' m_tc_result mHscMessage source_modified0 = do - let logger = hsc_logger hsc_env0 - let tmpfs = hsc_tmpfs hsc_env0 debugTraceMsg logger dflags1 2 (text "compile: input file" <+> text input_fnpp) - -- Run the pipeline up to codeGen (so everything up to, but not including, STG) - (status, plugin_hsc_env) <- hscIncrementalCompile - always_do_basic_recompilation_check - m_tc_result mHscMessage - hsc_env summary source_modified mb_old_iface (mod_index, nmods) - -- Use an HscEnv updated with the plugin info - let hsc_env' = plugin_hsc_env - let flags = hsc_dflags hsc_env0 in do unless (gopt Opt_KeepHiFiles flags) $ addFilesToClean tmpfs TFL_CurrentModule $ @@ -225,101 +220,29 @@ compileOne' m_tc_result mHscMessage addFilesToClean tmpfs TFL_GhcSession $ [ml_obj_file $ ms_location summary] - case (status, bcknd) of - (HscUpToDate iface hmi_details, _) -> - -- TODO recomp014 triggers this assert. What's going on?! - -- assert (isJust mb_old_linkable || isNoLink (ghcLink dflags) ) - return $! HomeModInfo iface hmi_details mb_old_linkable - (HscNotGeneratingCode iface hmi_details, NoBackend) -> - let mb_linkable = if isHsBootOrSig src_flavour - then Nothing - -- TODO: Questionable. - else Just (LM (ms_hs_date summary) this_mod []) - in return $! HomeModInfo iface hmi_details mb_linkable - (HscNotGeneratingCode _ _, _) -> panic "compileOne HscNotGeneratingCode" - (_, NoBackend) -> panic "compileOne NoBackend" - (HscUpdateBoot iface hmi_details, Interpreter) -> - return $! HomeModInfo iface hmi_details Nothing - (HscUpdateBoot iface hmi_details, _) -> do - touchObjectFile logger dflags object_filename - return $! HomeModInfo iface hmi_details Nothing - (HscUpdateSig iface hmi_details, Interpreter) -> do - let !linkable = LM (ms_hs_date summary) this_mod [] - return $! HomeModInfo iface hmi_details (Just linkable) - (HscUpdateSig iface hmi_details, _) -> do - output_fn <- getOutputFilename logger tmpfs next_phase - (Temporary TFL_CurrentModule) basename dflags - next_phase (Just location) - - -- #10660: Use the pipeline instead of calling - -- compileEmptyStub directly, so -dynamic-too gets - -- handled properly - _ <- runPipeline StopLn hsc_env' - (output_fn, - Nothing, - Just (HscOut src_flavour - mod_name (HscUpdateSig iface hmi_details))) - (Just basename) - Persistent - (Just location) - [] - o_time <- getModificationUTCTime object_filename - let !linkable = LM o_time this_mod [DotO object_filename] - return $! HomeModInfo iface hmi_details (Just linkable) - (HscRecomp { hscs_guts = cgguts, - hscs_mod_location = mod_location, - hscs_partial_iface = partial_iface, - hscs_old_iface_hash = mb_old_iface_hash - }, Interpreter) -> do - -- In interpreted mode the regular codeGen backend is not run so we - -- generate a interface without codeGen info. - final_iface <- mkFullIface hsc_env' partial_iface Nothing - -- Reconstruct the `ModDetails` from the just-constructed `ModIface` - -- See Note [ModDetails and --make mode] - hmi_details <- liftIO $ initModDetails hsc_env' summary final_iface - liftIO $ hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash (ms_location summary) - - (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env' cgguts mod_location - - stub_o <- case hasStub of - Nothing -> return [] - Just stub_c -> do - stub_o <- compileStub hsc_env' stub_c - return [DotO stub_o] - - let hs_unlinked = [BCOs comp_bc spt_entries] - unlinked_time = ms_hs_date summary - -- Why do we use the timestamp of the source file here, - -- rather than the current time? This works better in - -- the case where the local clock is out of sync - -- with the filesystem's clock. It's just as accurate: - -- if the source is modified, then the linkable will - -- be out of date. - let !linkable = LM unlinked_time (ms_mod summary) - (hs_unlinked ++ stub_o) - return $! HomeModInfo final_iface hmi_details (Just linkable) - (HscRecomp{}, _) -> do - output_fn <- getOutputFilename logger tmpfs next_phase - (Temporary TFL_CurrentModule) - basename dflags next_phase (Just location) - -- We're in --make mode: finish the compilation pipeline. - (_, _, Just iface) <- runPipeline StopLn hsc_env' - (output_fn, - Nothing, - Just (HscOut src_flavour mod_name status)) - (Just basename) - Persistent - (Just location) - [] - -- The object filename comes from the ModLocation - o_time <- getModificationUTCTime object_filename - let !linkable = LM o_time this_mod [DotO object_filename] - -- See Note [ModDetails and --make mode] - details <- initModDetails hsc_env' summary iface - return $! HomeModInfo iface details (Just linkable) + plugin_hsc_env <- initializePlugins hsc_env + + let runPostTc = compileOnePostTc plugin_hsc_env summary + + case m_tc_result of + Just tc_result + | not always_do_basic_recompilation_check -> do + runPostTc (FrontendTypecheck tc_result) emptyMessages Nothing + _ -> do + status <- hscRecompStatus mHscMessage plugin_hsc_env summary + source_modified mb_old_iface (mod_index, nmods) + + case status of + HscUpToDate iface -> do + massert ( isJust mb_old_linkable || isNoLink (ghcLink dflags) ) + -- See Note [ModDetails and --make mode] + details <- initModDetails plugin_hsc_env summary iface + return $! HomeModInfo iface details mb_old_linkable + HscRecompNeeded mb_old_hash -> do + (tc_result, warnings) <- hscTypecheckAndGetWarnings plugin_hsc_env summary + runPostTc tc_result warnings mb_old_hash where dflags0 = ms_hspp_opts summary - this_mod = ms_mod summary location = ms_location summary input_fn = expectJust "compile:hs" (ml_hs_file location) input_fnpp = ms_hspp_file summary @@ -329,10 +252,8 @@ compileOne' m_tc_result mHscMessage isProfWay = any (== WayProf) (ways dflags0) internalInterpreter = not (gopt Opt_ExternalInterpreter dflags0) - src_flavour = ms_hsc_src summary - mod_name = ms_mod_name summary - next_phase = hscPostBackendPhase src_flavour bcknd - object_filename = ml_obj_file location + logger = hsc_logger hsc_env0 + tmpfs = hsc_tmpfs hsc_env0 -- #8180 - when using TemplateHaskell, switch on -dynamic-too so -- the linker can correctly load the object files. This isn't necessary @@ -387,6 +308,59 @@ compileOne' m_tc_result mHscMessage Interpreter -> True _ -> False +-- | Do the post typechecking compilation of a module in the --make mode +compileOnePostTc + :: HscEnv + -> ModSummary + -> FrontendResult + -> WarningMessages + -> Maybe Fingerprint + -> IO HomeModInfo +compileOnePostTc hsc_env summary tc_result warnings mb_old_hash = do + output_fn <- getOutputFilename logger tmpfs next_phase + (Temporary TFL_CurrentModule) + basename dflags next_phase (Just location) + (_, _, Just iface, mb_linkable) <- runPipeline StopLn hsc_env + (output_fn, + Nothing, + Just (HscPostTc summary tc_result warnings mb_old_hash)) + (Just basename) + pipelineOutput + (Just location) + [] + -- TODO: figure out a way to set this in runPipeline for HsSrcFile + mLinkable <- case () of + _ | Just l <- mb_linkable -> return $ Just l + | bcknd == NoBackend -> return Nothing + | src_flavour == HsSrcFile -> do + -- The object filename comes from the ModLocation + o_time <- getModificationUTCTime object_filename + let !linkable = LM o_time this_mod [DotO object_filename] + return $ Just linkable + | otherwise -> return Nothing + -- See Note [ModDetails and --make mode] + details <- initModDetails hsc_env summary iface + return $! HomeModInfo iface details mLinkable + + where dflags = hsc_dflags hsc_env + this_mod = ms_mod summary + location = ms_location summary + input_fn = expectJust "compile:hs" (ml_hs_file location) + + logger = hsc_logger hsc_env + tmpfs = hsc_tmpfs hsc_env + src_flavour = ms_hsc_src summary + next_phase = hscPostBackendPhase src_flavour bcknd + bcknd = backend dflags + object_filename = ml_obj_file location + + basename = dropExtension input_fn + + pipelineOutput = case bcknd of + Interpreter -> NoOutputFile + NoBackend -> NoOutputFile + _ -> Persistent + ----------------------------------------------------------------------------- -- stub .h and .c files (for foreign export support), and cc files. @@ -413,7 +387,7 @@ compileForeign hsc_env lang stub_c = do #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif - (_, stub_o, _) <- runPipeline StopLn hsc_env + (_, stub_o, _, _) <- runPipeline StopLn hsc_env (stub_c, Nothing, Just (RealPhase phase)) Nothing (Temporary TFL_GhcSession) Nothing{-no ModLocation-} @@ -668,17 +642,14 @@ compileFile hsc_env stop_phase (src, mb_phase) = do -- When linking, the -o argument refers to the linker's output. -- otherwise, we use it as the name for the pipeline's output. output - -- If we are doing -fno-code, then act as if the output is - -- 'Temporary'. This stops GHC trying to copy files to their - -- final location. - | NoBackend <- backend dflags = Temporary TFL_CurrentModule + | NoBackend <- backend dflags = NoOutputFile | StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent -- -o foo applies to linker | isJust mb_o_file = SpecificFile -- -o foo applies to the file we are compiling now | otherwise = Persistent - ( _, out_file, _) <- runPipeline stop_phase hsc_env + ( _, out_file, _, _) <- runPipeline stop_phase hsc_env (src, Nothing, fmap RealPhase mb_phase) Nothing output @@ -726,8 +697,8 @@ runPipeline -> PipelineOutput -- ^ Output filename -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module -> [FilePath] -- ^ foreign objects - -> IO (DynFlags, FilePath, Maybe ModIface) - -- ^ (final flags, output filename, interface) + -> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable) + -- ^ (final flags, output filename, interface, linkable) runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) mb_basename output maybe_loc foreign_os @@ -752,7 +723,8 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) isHaskell (RealPhase (Cpp _)) = True isHaskell (RealPhase (HsPp _)) = True isHaskell (RealPhase (Hsc _)) = True - isHaskell (HscOut {}) = True + isHaskell (HscPostTc {}) = True + isHaskell (HscBackend {}) = True isHaskell _ = False isHaskellishFile = isHaskell start_phase @@ -780,7 +752,8 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) throwGhcExceptionIO (UsageError ("cannot compile this file to desired target: " ++ input_fn)) - HscOut {} -> return () + HscPostTc {} -> return () + HscBackend {} -> return () -- Write input buffer to temp file if requested input_fn' <- case (start_phase, mb_input_buf) of @@ -856,15 +829,17 @@ runPipeline' -> FilePath -- ^ Input filename -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module -> [FilePath] -- ^ foreign objects, if we have one - -> IO (DynFlags, FilePath, Maybe ModIface) - -- ^ (final flags, output filename, interface) + -> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable) + -- ^ (final flags, output filename, interface, linkable) runPipeline' start_phase hsc_env env input_fn maybe_loc foreign_os = do -- Execute the pipeline... - let state = PipeState{ hsc_env, maybe_loc, foreign_os = foreign_os, iface = Nothing } + let state = PipeState{ hsc_env, maybe_loc, foreign_os = foreign_os, iface = Nothing + , maybe_linkable = Nothing } (pipe_state, fp) <- evalP (pipeLoop start_phase input_fn) env state - return (pipeStateDynFlags pipe_state, fp, pipeStateModIface pipe_state) + return (pipeStateDynFlags pipe_state, fp, pipeStateModIface pipe_state + , pipeStateLinkable pipe_state ) -- --------------------------------------------------------------------------- -- outer pipeline loop @@ -888,6 +863,7 @@ pipeLoop phase input_fn = do case output_spec env of Temporary _ -> return input_fn + NoOutputFile -> return input_fn output -> do pst <- getPipeState tmpfs <- hsc_tmpfs <$> getPipeSession @@ -915,7 +891,7 @@ pipeLoop phase input_fn = do (text "Running phase" <+> ppr phase) case phase of - HscOut {} -> do + HscBackend {} -> do -- Depending on the dynamic-too state, we first run the -- backend to generate the non-dynamic objects and then -- re-run it to generate the dynamic ones. @@ -1351,20 +1327,67 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn -- run the compiler! let msg hsc_env _ what _ = oneShotMsg hsc_env what - (result, plugin_hsc_env) <- - liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env' - mod_summary source_unchanged Nothing (1,1) + plugin_hsc_env' <- liftIO $ initializePlugins hsc_env' + + -- Need to set the knot-tying mutable variable for interface + -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var. + -- See also Note [hsc_type_env_var hack] + type_env_var <- liftIO $ newIORef emptyNameEnv + let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_var = Just (mod, type_env_var) } - -- In the rest of the pipeline use the loaded plugins - setPlugins (hsc_plugins plugin_hsc_env) - (hsc_static_plugins plugin_hsc_env) - -- "driver" plugins may have modified the DynFlags so we update them - setDynFlags (hsc_dflags plugin_hsc_env) + status <- liftIO $ hscRecompStatus (Just msg) plugin_hsc_env mod_summary + source_unchanged Nothing (1, 1) - return (HscOut src_flavour mod_name result, - panic "HscOut doesn't have an input filename") + logger <- getLogger + case status of + HscUpToDate iface -> + do liftIO $ touchObjectFile logger dflags o_file + -- The .o file must have a later modification date + -- than the source file (else we wouldn't get Nothing) + -- but we touch it anyway, to keep 'make' happy (we think). + setIface iface + return (RealPhase StopLn, o_file) + HscRecompNeeded mb_old_hash -> do + (tc_result, warnings) <- liftIO $ + hscTypecheckAndGetWarnings plugin_hsc_env mod_summary + + -- In the rest of the pipeline use the loaded plugins + setPlugins (hsc_plugins plugin_hsc_env) + (hsc_static_plugins plugin_hsc_env) + -- "driver" plugins may have modified the DynFlags so we update them + setDynFlags (hsc_dflags plugin_hsc_env) + + return (HscPostTc mod_summary tc_result warnings mb_old_hash, + panic "HscPostTc doesn't have an input filename") + +runPhase (HscPostTc mod_summary tc_result tc_warnings mb_old_hash) _ = do + PipeState{hsc_env=hsc_env'} <- getPipeState + hscBackendAction <- liftIO $ runHsc hsc_env' $ do + hscDesugarAndSimplify mod_summary tc_result tc_warnings mb_old_hash + + dflags <- getDynFlags + let hscBackendPhase = HscBackend mod_summary hscBackendAction + next_phase <- case hscBackendAction of + HscUpdate iface -> do + setIface iface + -- Need to set a fake linkable + let setLinkableAndStop = do + unless (isHsBootOrSig $ ms_hsc_src mod_summary) $ + setLinkable (LM (ms_hs_date mod_summary) (ms_mod mod_summary) []) + return $ RealPhase StopLn + case backend dflags of + NoBackend -> setLinkableAndStop + Interpreter -> setLinkableAndStop + _ -> return hscBackendPhase -- Need to create .o, and handle -dynamic-too + _ -> return hscBackendPhase + + return (next_phase, + panic "HscBackend doesn't have an input filename") + +runPhase (HscBackend mod_summary result) _ = do + let mod_name = moduleName (ms_mod mod_summary) + src_flavour = (ms_hsc_src mod_summary) -runPhase (HscOut src_flavour mod_name result) _ = do dflags <- getDynFlags logger <- getLogger location <- getLocation src_flavour mod_name @@ -1374,34 +1397,62 @@ runPhase (HscOut src_flavour mod_name result) _ = do next_phase = hscPostBackendPhase src_flavour (backend dflags) case result of - HscNotGeneratingCode _ _ -> - return (RealPhase StopLn, - panic "No output filename from Hsc when no-code") - HscUpToDate _ _ -> - do liftIO $ touchObjectFile logger dflags o_file - -- The .o file must have a later modification date - -- than the source file (else we wouldn't get Nothing) - -- but we touch it anyway, to keep 'make' happy (we think). - return (RealPhase StopLn, o_file) - HscUpdateBoot _ _ -> - do -- In the case of hs-boot files, generate a dummy .o-boot - -- stamp file for the benefit of Make - liftIO $ touchObjectFile logger dflags o_file - return (RealPhase StopLn, o_file) - HscUpdateSig _ _ -> - do -- We need to create a REAL but empty .o file - -- because we are going to attempt to put it in a library - PipeState{hsc_env=hsc_env'} <- getPipeState - let input_fn = expectJust "runPhase" (ml_hs_file location) - basename = dropExtension input_fn - liftIO $ compileEmptyStub dflags hsc_env' basename location mod_name + HscUpdate iface -> + do + case src_flavour of + HsigFile -> do + -- We need to create a REAL but empty .o file + -- because we are going to attempt to put it in a library + PipeState{hsc_env=hsc_env'} <- getPipeState + let input_fn = expectJust "runPhase" (ml_hs_file location) + basename = dropExtension input_fn + liftIO $ compileEmptyStub dflags hsc_env' basename location mod_name + + -- In the case of hs-boot files, generate a dummy .o-boot + -- stamp file for the benefit of Make + HsBootFile -> liftIO $ touchObjectFile logger dflags o_file + HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" + + setIface iface return (RealPhase StopLn, o_file) HscRecomp { hscs_guts = cgguts, hscs_mod_location = mod_location, hscs_partial_iface = partial_iface, hscs_old_iface_hash = mb_old_iface_hash } - -> do output_fn <- phaseOutputFilename next_phase + -> case backend dflags of + NoBackend -> panic "HscRecomp not relevant for NoBackend" + Interpreter -> do + PipeState{hsc_env=hsc_env'} <- getPipeState + -- In interpreted mode the regular codeGen backend is not run so we + -- generate a interface without codeGen info. + final_iface <- liftIO $ mkFullIface hsc_env' partial_iface Nothing + liftIO $ hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location + + (hasStub, comp_bc, spt_entries) <- liftIO $ hscInteractive hsc_env' cgguts mod_location + + stub_o <- liftIO $ case hasStub of + Nothing -> return [] + Just stub_c -> do + stub_o <- compileStub hsc_env' stub_c + return [DotO stub_o] + + let hs_unlinked = [BCOs comp_bc spt_entries] + unlinked_time = ms_hs_date mod_summary + -- Why do we use the timestamp of the source file here, + -- rather than the current time? This works better in + -- the case where the local clock is out of sync + -- with the filesystem's clock. It's just as accurate: + -- if the source is modified, then the linkable will + -- be out of date. + let !linkable = LM unlinked_time (ms_mod mod_summary) + (hs_unlinked ++ stub_o) + setIface final_iface + setLinkable linkable + return (RealPhase StopLn, + panic "Interpreter backend doesn't have an output file") + _ -> do + output_fn <- phaseOutputFilename next_phase PipeState{hsc_env=hsc_env'} <- getPipeState @@ -1820,47 +1871,33 @@ getLocation src_flavour mod_name = do PipeEnv{ src_basename=basename, src_suffix=suff } <- getPipeEnv - PipeState { maybe_loc=maybe_loc} <- getPipeState - case maybe_loc of - -- Build a ModLocation to pass to hscMain. - -- The source filename is rather irrelevant by now, but it's used - -- by hscMain for messages. hscMain also needs - -- the .hi and .o filenames. If we already have a ModLocation - -- then simply update the extensions of the interface and object - -- files to match the DynFlags, otherwise use the logic in Finder. - Just l -> return $ l - { ml_hs_file = Just $ basename <.> suff - , ml_hi_file = ml_hi_file l -<.> hiSuf dflags - , ml_obj_file = ml_obj_file l -<.> objectSuf dflags - } - _ -> do - location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff - - -- Boot-ify it if necessary - let location2 - | HsBootFile <- src_flavour = addBootSuffixLocnOut location1 - | otherwise = location1 - - - -- Take -ohi into account if present - -- This can't be done in mkHomeModuleLocation because - -- it only applies to the module being compiles - let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } - | otherwise = location2 - - -- Take -o into account if present - -- Very like -ohi, but we must *only* do this if we aren't linking - -- (If we're linking then the -o applies to the linked thing, not to - -- the object file for one module.) - -- Note the nasty duplication with the same computation in compileFile - -- above - let expl_o_file = outputFile dflags - location4 | Just ofile <- expl_o_file - , isNoLink (ghcLink dflags) - = location3 { ml_obj_file = ofile } - | otherwise = location3 - return location4 + location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff + + -- Boot-ify it if necessary + let location2 + | HsBootFile <- src_flavour = addBootSuffixLocnOut location1 + | otherwise = location1 + + + -- Take -ohi into account if present + -- This can't be done in mkHomeModuleLocation because + -- it only applies to the module being compiles + let ohi = outputHi dflags + location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + | otherwise = location2 + + -- Take -o into account if present + -- Very like -ohi, but we must *only* do this if we aren't linking + -- (If we're linking then the -o applies to the linked thing, not to + -- the object file for one module.) + -- Note the nasty duplication with the same computation in compileFile + -- above + let expl_o_file = outputFile dflags + location4 | Just ofile <- expl_o_file + , isNoLink (ghcLink dflags) + = location3 { ml_obj_file = ofile } + | otherwise = location3 + return location4 ----------------------------------------------------------------------------- -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs index d95f9a3973..8440141f2c 100644 --- a/compiler/GHC/Driver/Pipeline/Monad.hs +++ b/compiler/GHC/Driver/Pipeline/Monad.hs @@ -4,15 +4,16 @@ -- Defined in separate module so that it can safely be imported from Hooks module GHC.Driver.Pipeline.Monad ( CompPipeline(..), evalP - , PhasePlus(..) + , PhasePlus(..), HscBackendAction (..) , PipeEnv(..), PipeState(..), PipelineOutput(..) , getPipeEnv, getPipeState, getPipeSession , setDynFlags, setModLocation, setForeignOs, setIface - , pipeStateDynFlags, pipeStateModIface, setPlugins + , pipeStateDynFlags, pipeStateModIface, pipeStateLinkable, setPlugins, setLinkable ) where import GHC.Prelude +import GHC.Utils.Fingerprint import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Logger @@ -22,14 +23,21 @@ import GHC.Driver.Phases import GHC.Driver.Env import GHC.Driver.Plugins +import GHC.Linker.Types + import GHC.Utils.TmpFs (TempFileLifetime) -import GHC.Types.SourceFile +import GHC.Types.Error import GHC.Unit.Module import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModSummary import GHC.Unit.Module.Status +import GHC.Driver.Errors.Types ( GhcMessage ) + +import GHC.Tc.Types + import Control.Monad newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) } @@ -50,11 +58,17 @@ instance MonadIO CompPipeline where liftIO m = P $ \_env state -> do a <- m; return (state, a) data PhasePlus = RealPhase Phase - | HscOut HscSource ModuleName HscStatus + -- | Runs the pipeline post typechecking, till the end + | HscPostTc ModSummary FrontendResult (Messages GhcMessage) (Maybe Fingerprint) + -- | The backend phase runs the code-gen. This may be run twice in + -- the case of -dynamic-too + | HscBackend ModSummary HscBackendAction + instance Outputable PhasePlus where ppr (RealPhase p) = ppr p - ppr (HscOut {}) = text "HscOut" + ppr (HscPostTc {}) = text "HscPostTc" + ppr (HscBackend {}) = text "HscBackend" -- ----------------------------------------------------------------------------- -- The pipeline uses a monad to carry around various bits of information @@ -81,9 +95,11 @@ data PipeState = PipeState { -- ^ additional object files resulting from compiling foreign -- code. They come from two sources: foreign stubs, and -- add{C,Cxx,Objc,Objcxx}File from template haskell - iface :: Maybe ModIface - -- ^ Interface generated by HscOut phase. Only available after the + iface :: Maybe ModIface, + -- ^ Interface generated by HscBackend phase. Only available after the -- phase runs. + maybe_linkable :: Maybe Linkable + -- ^ Linkable generated by HscBackend phase, for the Interpreter backend. } pipeStateDynFlags :: PipeState -> DynFlags @@ -92,6 +108,9 @@ pipeStateDynFlags = hsc_dflags . hsc_env pipeStateModIface :: PipeState -> Maybe ModIface pipeStateModIface = iface +pipeStateLinkable :: PipeState -> Maybe Linkable +pipeStateLinkable = maybe_linkable + data PipelineOutput = Temporary TempFileLifetime -- ^ Output should be to a temporary file: we're going to @@ -104,6 +123,8 @@ data PipelineOutput -- ^ The output must go into the specific outputFile in DynFlags. -- We don't store the filename in the constructor as it changes -- when doing -dynamic-too. + | NoOutputFile + -- ^ No output should be created, like in Interpreter or NoBackend. deriving Show getPipeEnv :: CompPipeline PipeEnv @@ -140,3 +161,6 @@ setForeignOs os = P $ \_env state -> setIface :: ModIface -> CompPipeline () setIface iface = P $ \_env state -> return (state{ iface = Just iface }, ()) + +setLinkable :: Linkable -> CompPipeline () +setLinkable l = P $ \_env state -> return (state{ maybe_linkable = Just l }, ()) diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index a4562b753a..c6c1e42070 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -151,6 +151,7 @@ module GHC.Driver.Session ( defaultFatalMessager, defaultFlushOut, defaultFlushErr, + setOutputFile, setDynOutputFile, setOutputHi, getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] getVerbFlags, diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index 9bccffab3d..392085f309 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -209,7 +209,31 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface -- even in the SourceUnmodifiedAndStable case we -- should check versions because some packages -- might have changed or gone away. - Just iface -> checkVersions hsc_env mod_summary iface + Just iface -> do + (recomp_reqd, mb_checked_iface) <- + checkVersions hsc_env mod_summary iface + return $ 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. + let stable = case src_modified of + SourceUnmodifiedAndStable -> True + _ -> False + in if mi_used_th iface && not stable + then (RecompBecause "TH", mb_checked_iface) + else (recomp_reqd, mb_checked_iface) + _ -> (recomp_reqd, mb_checked_iface) -- | Check if a module is still the same 'version'. -- diff --git a/compiler/GHC/Unit/Module/Status.hs b/compiler/GHC/Unit/Module/Status.hs index 52938154b4..e4273de94b 100644 --- a/compiler/GHC/Unit/Module/Status.hs +++ b/compiler/GHC/Unit/Module/Status.hs @@ -1,5 +1,5 @@ module GHC.Unit.Module.Status - ( HscStatus (..) + ( HscBackendAction(..), HscRecompStatus (..) ) where @@ -8,20 +8,22 @@ import GHC.Prelude import GHC.Unit import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface -import GHC.Unit.Module.ModDetails import GHC.Utils.Fingerprint --- | Status of a module compilation to machine code -data HscStatus - -- | Nothing to do. - = HscNotGeneratingCode ModIface ModDetails +-- | Status of a module in incremental compilation +data HscRecompStatus -- | Nothing to do because code already exists. - | HscUpToDate ModIface ModDetails - -- | Update boot file result. - | HscUpdateBoot ModIface ModDetails - -- | Generate signature file (backpack) - | HscUpdateSig ModIface ModDetails + = HscUpToDate ModIface + -- | Recompilation of module, or update of interface is required. Optionally + -- pass the old interface hash to avoid updating the existing interface when + -- it has not changed. + | HscRecompNeeded (Maybe Fingerprint) + +-- | Action to perform in backend compilation +data HscBackendAction + -- | Update the boot and signature file results. + = HscUpdate ModIface -- | Recompile this module. | HscRecomp { hscs_guts :: CgGuts diff --git a/utils/haddock b/utils/haddock -Subproject 3b6a8774bdb543dad59b2618458b07feab8a55e +Subproject 804254a541d800ef983df7c98426014ff94430d |