diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-05-25 23:09:32 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-07 11:56:36 -0400 |
commit | 421beb3f93d1986f0fabeaad6947e3ac4b5304ea (patch) | |
tree | e690be1faa34f6af0be661689b89a4e181b96856 /ghc | |
parent | 6618008b5338ae43d8a362c31c5d5e820ff2d61c (diff) | |
download | haskell-421beb3f93d1986f0fabeaad6947e3ac4b5304ea.tar.gz |
driver: Convert runPipeline to use a free monad
This patch converts the runPipeline function to be implemented in terms
of a free monad rather than the previous CompPipeline.
The advantages of this are three-fold:
1. Different parts of the pipeline can return different results, the
limits of runPipeline were being pushed already by !5555, this opens up
futher fine-grainedism of the pipeline.
2. The same mechanism can be extended to build-plan at the module level
so the whole build plan can be expressed in terms of one computation
which can then be treated uniformly.
3. The pipeline monad can now be interpreted in different ways, for
example, you may want to interpret the `TPhase` action into the monad
for your own build system (such as shake). That bit will probably
require a bit more work, but this is a step in the right directin.
There are a few more modules containing useful functions for interacting
with the pipelines.
* GHC.Driver.Pipeline: Functions for building pipelines at a high-level
* GHC.Driver.Pipeline.Execute: Functions for providing the default
interpretation of TPhase, in terms of normal IO.
* GHC.Driver.Pipeline.Phases: The home for TPhase, the typed phase data
type which dictates what the phases are.
* GHC.Driver.Pipeline.Monad: Definitions to do with the TPipelineClass
and MonadUse class.
Hooks consumers may notice the type of the `phaseHook` has got
slightly more restrictive, you can now no longer control the
continuation of the pipeline by returning the next phase to execute but
only override individual phases. If this is a problem then please open
an issue and we will work out a solution.
-------------------------
Metric Decrease:
T4029
-------------------------
Diffstat (limited to 'ghc')
-rw-r--r-- | ghc/Main.hs | 27 |
1 files changed, 14 insertions, 13 deletions
diff --git a/ghc/Main.hs b/ghc/Main.hs index 0dec4f6cbc..bda5cd9ef9 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -57,7 +57,7 @@ import GHC.Utils.Error import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Outputable as Outputable -import GHC.Utils.Monad ( liftIO ) +import GHC.Utils.Monad ( liftIO, mapMaybeM ) import GHC.Utils.Binary ( openBinMem, put_ ) import GHC.Utils.Logger @@ -324,10 +324,10 @@ checkOptions mode dflags srcs objs = do else do case mode of - StopBefore HCc | backend dflags /= ViaC + StopBefore StopC | backend dflags /= ViaC -> throwGhcException $ UsageError $ "the option -C is only available with an unregisterised GHC" - StopBefore (As False) | ghcLink dflags == NoLink + StopBefore StopAs | ghcLink dflags == NoLink -> throwGhcException $ UsageError $ "the options -S and -fno-code are incompatible. Please omit -S" @@ -423,7 +423,7 @@ isShowGhciUsageMode _ = False data PostLoadMode = ShowInterface FilePath -- ghc --show-iface | DoMkDependHS -- ghc -M - | StopBefore Phase -- ghc -E | -C | -S + | StopBefore StopPhase -- ghc -E | -C | -S -- StopBefore StopLn is the default | DoMake -- ghc --make | DoBackpack -- ghc --backpack foo.bkp @@ -433,6 +433,7 @@ data PostLoadMode | ShowPackages -- ghc --show-packages | DoFrontend ModuleName -- ghc --frontend Plugin.Module + doMkDependHSMode, doMakeMode, doInteractiveMode, doAbiHashMode, showUnitsMode :: Mode doMkDependHSMode = mkPostLoadMode DoMkDependHS @@ -444,7 +445,7 @@ showUnitsMode = mkPostLoadMode ShowPackages showInterfaceMode :: FilePath -> Mode showInterfaceMode fp = mkPostLoadMode (ShowInterface fp) -stopBeforeMode :: Phase -> Mode +stopBeforeMode :: StopPhase -> Mode stopBeforeMode phase = mkPostLoadMode (StopBefore phase) doEvalMode :: String -> Mode @@ -464,7 +465,7 @@ isDoInteractiveMode (Right (Right DoInteractive)) = True isDoInteractiveMode _ = False isStopLnMode :: Mode -> Bool -isStopLnMode (Right (Right (StopBefore StopLn))) = True +isStopLnMode (Right (Right (StopBefore NoStop))) = True isStopLnMode _ = False isDoMakeMode :: Mode -> Bool @@ -496,7 +497,7 @@ needsInputsMode _ = False -- True if we are going to attempt to link in this mode. -- (we might not actually link, depending on the GhcLink flag) isLinkMode :: PostLoadMode -> Bool -isLinkMode (StopBefore StopLn) = True +isLinkMode (StopBefore NoStop) = True isLinkMode DoMake = True isLinkMode DoInteractive = True isLinkMode (DoEval _) = True @@ -578,12 +579,12 @@ mode_flags = "--show-iface")) ------- primary modes ------------------------------------------------ - , defFlag "c" (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f + , defFlag "c" (PassFlag (\f -> do setMode (stopBeforeMode NoStop) f addFlag "-no-link" f)) , defFlag "M" (PassFlag (setMode doMkDependHSMode)) - , defFlag "E" (PassFlag (setMode (stopBeforeMode anyHsc))) - , defFlag "C" (PassFlag (setMode (stopBeforeMode HCc))) - , defFlag "S" (PassFlag (setMode (stopBeforeMode (As False)))) + , defFlag "E" (PassFlag (setMode (stopBeforeMode StopPreprocess ))) + , defFlag "C" (PassFlag (setMode (stopBeforeMode StopC))) + , defFlag "S" (PassFlag (setMode (stopBeforeMode StopAs))) , defFlag "-make" (PassFlag (setMode doMakeMode)) , defFlag "-backpack" (PassFlag (setMode doBackpackMode)) , defFlag "-interactive" (PassFlag (setMode doInteractiveMode)) @@ -673,10 +674,10 @@ doMake srcs = do -- This means that "ghc Foo.o Bar.o -o baz" links the program as -- we expect. if (null hs_srcs) - then liftIO (oneShot hsc_env StopLn srcs) + then liftIO (oneShot hsc_env NoStop srcs) else do - o_files <- mapM (\x -> liftIO $ compileFile hsc_env StopLn x) + o_files <- mapMaybeM (\x -> liftIO $ compileFile hsc_env NoStop x) non_hs_srcs dflags <- GHC.getSessionDynFlags let dflags' = dflags { ldInputs = map (FileOption "") o_files |