diff options
Diffstat (limited to 'compiler/GHC/Driver')
| -rw-r--r-- | compiler/GHC/Driver/Backend.hs | 994 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Backend/Internal.hs | 32 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Backpack.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 18 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Config/Cmm.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Config/StgToCmm.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Config/Tidy.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 25 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Make.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 47 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 105 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 61 |
12 files changed, 1077 insertions, 236 deletions
diff --git a/compiler/GHC/Driver/Backend.hs b/compiler/GHC/Driver/Backend.hs index 2642a2a9af..a27a2e7b4a 100644 --- a/compiler/GHC/Driver/Backend.hs +++ b/compiler/GHC/Driver/Backend.hs @@ -1,95 +1,205 @@ {-# LANGUAGE MultiWayIf #-} --- | Code generation backends +{-| +Module : GHC.Driver.Backend +Description : Back ends for code generation + +This module exports the `Backend` type and all the available values +of that type. The type is abstract, and GHC assumes a "closed world": +all the back ends are known and are known here. The compiler driver +chooses a `Backend` value based on how it is asked to generate code. + +A `Backend` value encapsulates the knowledge needed to take Cmm, STG, +or Core and write assembly language to a file. A back end also +provides a function that enables the compiler driver to run an +assembler on the code that is written, if any (the "post-backend +pipeline"). Finally, a back end has myriad /properties/. Properties +mediate interactions between a back end and the rest of the compiler, +especially the driver. Examples include the following: + + * Property `backendValidityOfCImport` says whether the back end can + import foreign C functions. + + * Property `backendForcesOptimization0` says whether the back end can + be used with optimization levels higher than `-O0`. + + * Property `backendCDefs` tells the compiler driver, "if you're using + this back end, then these are the command-line flags you should add + to any invocation of the C compiler." + +These properties are use elsewhere in GHC, primarily in the driver, to +fine-tune operations according to the capabilities of the chosen back +end. You might use a property to make GHC aware of a potential +limitation of certain back ends, or a special feature available only +in certain back ends. If your client code needs to know a fact that +is not exposed in an existing property, you would define and export a +new property. Conditioning client code on the /identity/ or /name/ of +a back end is Not Done. + +For full details, see the documentation of each property. +-} + module GHC.Driver.Backend - ( Backend (..) + ( -- * The @Backend@ type + Backend -- note: type is abstract + -- * Available back ends + , ncgBackend + , llvmBackend + , viaCBackend + , interpreterBackend + , noBackend + , allBackends + + -- * Types used to specify properties of back ends + , PrimitiveImplementation(..) + -- ** Properties that stand for functions + -- *** Back-end function for code generation + , DefunctionalizedCodeOutput(..) + -- *** Back-end functions for assembly + , DefunctionalizedPostHscPipeline(..) + , DefunctionalizedAssemblerProg(..) + , DefunctionalizedAssemblerInfoGetter(..) + -- *** Other back-end functions + , DefunctionalizedCDefs(..) + -- ** Names of back ends (for API clients of version 9.4 or earlier) + , BackendName + + + + -- * Properties of back ends + , backendDescription + , backendWritesFiles + , backendPipelineOutput + , backendCanReuseLoadedCode + , backendGeneratesCode + , backendSupportsInterfaceWriting + , backendRespectsSpecialise + , backendWantsGlobalBindings + , backendHasNativeSwitch + , backendPrimitiveImplementation + , backendSimdValidity + , backendSupportsEmbeddedBlobs + , backendNeedsPlatformNcgSupport + , backendSupportsUnsplitProcPoints + , backendSwappableWithViaC + , backendUnregisterisedAbiOnly + , backendGeneratesHc + , backendSptIsDynamic + , backendWantsBreakpointTicks + , backendForcesOptimization0 + , backendNeedsFullWays + , backendSpecialModuleSource + , backendSupportsHpc + , backendSupportsCImport + , backendSupportsCExport + , backendAssemblerProg + , backendAssemblerInfoGetter + , backendCDefs + , backendCodeOutput + , backendPostHscPipeline + , backendNormalSuccessorPhase + , backendName + , backendValidityOfCImport + , backendValidityOfCExport + + -- * Other functions of back ends , platformDefaultBackend , platformNcgSupported - , backendProducesObject - , backendRetainsAllBindings ) + where + import GHC.Prelude + +import GHC.Driver.Backend.Internal (BackendName(..)) +import GHC.Driver.Phases + + +import GHC.Utils.Error +import GHC.Utils.Panic + +import GHC.Driver.Pipeline.Monad import GHC.Platform --- | Code generation backends. --- --- GHC supports several code generation backends serving different purposes --- (producing machine code, producing ByteCode for the interpreter) and --- supporting different platforms. --- -data Backend - = NCG -- ^ Native code generator backend. - -- - -- Compiles Cmm code into textual assembler, then relies on - -- an external assembler toolchain to produce machine code. - -- - -- Only supports a few platforms (X86, PowerPC, SPARC). - -- - -- See "GHC.CmmToAsm". - - - | LLVM -- ^ LLVM backend. - -- - -- Compiles Cmm code into LLVM textual IR, then relies on - -- LLVM toolchain to produce machine code. - -- - -- It relies on LLVM support for the calling convention used - -- by the NCG backend to produce code objects ABI compatible - -- with it (see "cc 10" or "ghccc" calling convention in - -- https://llvm.org/docs/LangRef.html#calling-conventions). - -- - -- Support a few platforms (X86, AArch64, s390x, ARM). - -- - -- See "GHC.CmmToLlvm" - - - | ViaC -- ^ Via-C backend. - -- - -- Compiles Cmm code into C code, then relies on a C compiler - -- to produce machine code. - -- - -- It produces code objects that are *not* ABI compatible - -- with those produced by NCG and LLVM backends. - -- - -- Produced code is expected to be less efficient than the - -- one produced by NCG and LLVM backends because STG - -- registers are not pinned into real registers. On the - -- other hand, it supports more target platforms (those - -- having a valid C toolchain). - -- - -- See "GHC.CmmToC" - - - | Interpreter -- ^ ByteCode interpreter. - -- - -- Produce ByteCode objects (BCO, see "GHC.ByteCode") that - -- can be interpreted. It is used by GHCi. - -- - -- Currently some extensions are not supported - -- (foreign primops). - -- - -- See "GHC.StgToByteCode" - - - | NoBackend -- ^ No code generated. - -- - -- Use this to disable code generation. It is particularly - -- useful when GHC is used as a library for other purpose - -- than generating code (e.g. to generate documentation with - -- Haddock) or when the user requested it (via -fno-code) for - -- some reason. - - deriving (Eq,Ord,Show,Read) - --- | Default backend to use for the given platform. + +--------------------------------------------------------------------------------- +-- +-- DESIGN CONSIDERATIONS +-- +-- +-- +-- The `Backend` type is made abstract in order to make it possible to +-- add new back ends without having to inspect or modify much code +-- elsewhere in GHC. Adding a new back end would be /easiest/ if +-- `Backend` were represented as a record type, but in peer review, +-- the clear will of the majority was to use a sum type. As a result, +-- when adding a new back end it is necessary to modify /every/ +-- function in this module that expects `Backend` as its first argument. +-- **By design, these functions have no default/wildcard cases.** This +-- design forces the author of a new back end to consider the semantics +-- in every case, rather than relying on a default that may be wrong. +-- The names and documentation of the functions defined in the `Backend` +-- record are sufficiently descriptive that the author of a new back +-- end will be able to identify correct result values without having to go +-- spelunking throughout the compiler. +-- +-- While the design localizes /most/ back-end logic in this module, +-- the author of a new back end will still have to make changes +-- elsewhere in the compiler: +-- +-- * For reasons described in Note [Backend Defunctionalization], +-- code-generation and post-backend pipeline functions, among other +-- functions, cannot be placed in the `Backend` record itself. +-- Instead, the /names/ of those functions are placed. Each name is +-- a value constructor in one of the algebraic data types defined in +-- this module. The named function is then defined near its point +-- of use. +-- +-- The author of a new back end will have to consider whether an +-- existing function will do or whether a new function needs to be +-- defined. When a new function needs to be defined, the author +-- must take two steps: +-- +-- - Add a value constructor to the relevant data type here +-- in the `Backend` module +-- +-- - Add a case to the location in the compiler (there should be +-- exactly one) where the value constructors of the relevant +-- data type are used +-- +-- * When a new back end is defined, it's quite possible that the +-- compiler driver will have to be changed in some way. Just because +-- the driver supports five back ends doesn't mean it will support a sixth +-- without changes. +-- +-- The collection of functions exported from this module hasn't +-- really been "designed"; it's what emerged from a refactoring of +-- older code. The real design criterion was "make it crystal clear +-- what has to be done to add a new back end." +-- +-- One issue remains unresolved: some of the error messages and +-- warning messages used in the driver assume a "closed world": they +-- think they know all the back ends that exist, and they are not shy +-- about enumerating them. Just one set of error messages has been +-- ported to have an open-world assumption: these are the error +-- messages associated with type checking of foreign imports and +-- exports. To allow other errors to be issued with an open-world +-- assumption, use functions `backendValidityOfCImport` and +-- `backendValidityOfCExport` as models, and have a look at how the +-- 'expected back ends' are used in modules "GHC.Tc.Gen.Foreign" and +-- "GHC.Tc.Errors.Ppr" +-- +--------------------------------------------------------------------------------- + + + + platformDefaultBackend :: Platform -> Backend platformDefaultBackend platform = if - | platformUnregisterised platform -> ViaC - | platformNcgSupported platform -> NCG - | otherwise -> LLVM - + | platformUnregisterised platform -> viaCBackend + | platformNcgSupported platform -> ncgBackend + | otherwise -> llvmBackend -- | Is the platform supported by the Native Code Generator? platformNcgSupported :: Platform -> Bool @@ -106,26 +216,706 @@ platformNcgSupported platform = if ArchAArch64 -> True _ -> False --- | Will this backend produce an object file on the disk? -backendProducesObject :: Backend -> Bool -backendProducesObject ViaC = True -backendProducesObject NCG = True -backendProducesObject LLVM = True -backendProducesObject Interpreter = False -backendProducesObject NoBackend = False - --- | Does this backend retain *all* top-level bindings for a module, --- rather than just the exported bindings, in the TypeEnv and compiled --- code (if any)? --- --- Interpreter backend does this, so that GHCi can call functions inside a --- module. --- --- When no backend is used we also do it, so that Haddock can get access to the --- GlobalRdrEnv for a module after typechecking it. -backendRetainsAllBindings :: Backend -> Bool -backendRetainsAllBindings Interpreter = True -backendRetainsAllBindings NoBackend = True -backendRetainsAllBindings ViaC = False -backendRetainsAllBindings NCG = False -backendRetainsAllBindings LLVM = False + + +-- | A value of type @Backend@ represents one of GHC's back ends. +-- The set of back ends cannot be extended except by modifying the +-- definition of @Backend@ in this module. +-- +-- The @Backend@ type is abstract; that is, its value constructors are +-- not exported. It's crucial that they not be exported, because a +-- value of type @Backend@ carries only the back end's /name/, not its +-- behavior or properties. If @Backend@ were not abstract, then code +-- elsewhere in the compiler could depend directly on the name, not on +-- the semantics, which would make it challenging to create a new back end. +-- Because @Backend@ /is/ abstract, all the obligations of a new back +-- end are enumerated in this module, in the form of functions that +-- take @Backend@ as an argument. +-- +-- The issue of abstraction is discussed at great length in #20927 and !7442. + + +newtype Backend = Named BackendName + -- Must be a newtype so that it has no `Eq` instance and + -- a different `Show` instance. + +-- | The Show instance is for messages /only/. If code depends on +-- what's in the string, you deserve what happens to you. + +instance Show Backend where + show = backendDescription + + +ncgBackend, llvmBackend, viaCBackend, interpreterBackend, noBackend + :: Backend + +-- | The native code generator. +-- Compiles Cmm code into textual assembler, then relies on +-- an external assembler toolchain to produce machine code. +-- +-- Only supports a few platforms (X86, PowerPC, SPARC). +-- +-- See "GHC.CmmToAsm". +ncgBackend = Named NCG + +-- | The LLVM backend. +-- +-- Compiles Cmm code into LLVM textual IR, then relies on +-- LLVM toolchain to produce machine code. +-- +-- It relies on LLVM support for the calling convention used +-- by the NCG backend to produce code objects ABI compatible +-- with it (see "cc 10" or "ghccc" calling convention in +-- https://llvm.org/docs/LangRef.html#calling-conventions). +-- +-- Supports a few platforms (X86, AArch64, s390x, ARM). +-- +-- See "GHC.CmmToLlvm" +llvmBackend = Named LLVM + +-- | Via-C ("unregisterised") backend. +-- +-- Compiles Cmm code into C code, then relies on a C compiler +-- to produce machine code. +-- +-- It produces code objects that are /not/ ABI compatible +-- with those produced by NCG and LLVM backends. +-- +-- Produced code is expected to be less efficient than the +-- one produced by NCG and LLVM backends because STG +-- registers are not pinned into real registers. On the +-- other hand, it supports more target platforms (those +-- having a valid C toolchain). +-- +-- See "GHC.CmmToC" +viaCBackend = Named ViaC + +-- | The ByteCode interpreter. +-- +-- Produce ByteCode objects (BCO, see "GHC.ByteCode") that +-- can be interpreted. It is used by GHCi. +-- +-- Currently some extensions are not supported +-- (foreign primops). +-- +-- See "GHC.StgToByteCode" +interpreterBackend = Named Interpreter + +-- | A dummy back end that generates no code. +-- +-- Use this back end to disable code generation. It is particularly +-- useful when GHC is used as a library for other purpose than +-- generating code (e.g. to generate documentation with Haddock) or +-- when the user requested it (via `-fno-code`) for some reason. +noBackend = Named NoBackend + +--------------------------------------------------------------------------------- + + + + +-- | This enumeration type specifies how the back end wishes GHC's +-- primitives to be implemented. (Module "GHC.StgToCmm.Prim" provides +-- a generic implementation of every primitive, but some primitives, +-- like `IntQuotRemOp`, can be implemented more efficiently by +-- certain back ends on certain platforms. For example, by using a +-- machine instruction that simultaneously computes quotient and remainder.) +-- +-- For the meaning of each alternative, consult +-- "GHC.StgToCmm.Config". (In a perfect world, type +-- `PrimitiveImplementation` would be defined there, in the module +-- that determines its meaning. But I could not figure out how to do +-- it without mutual recursion across module boundaries.) + +data PrimitiveImplementation + = LlvmPrimitives -- ^ Primitives supported by LLVM + | NcgPrimitives -- ^ Primitives supported by the native code generator + | GenericPrimitives -- ^ Primitives supported by all back ends + deriving Show + + +-- | Names a function that runs the assembler, of this type: +-- +-- > Logger -> DynFlags -> Platform -> [Option] -> IO () +-- +-- The functions so named are defined in "GHC.Driver.Pipeline.Execute". + +data DefunctionalizedAssemblerProg + = StandardAssemblerProg + -- ^ Use the standard system assembler + | DarwinClangAssemblerProg + -- ^ If running on Darwin, use the assembler from the @clang@ + -- toolchain. Otherwise use the standard system assembler. + + + +-- | Names a function that discover from what toolchain the assembler +-- is coming, of this type: +-- +-- > Logger -> DynFlags -> Platform -> IO CompilerInfo +-- +-- The functions so named are defined in "GHC.Driver.Pipeline.Execute". + +data DefunctionalizedAssemblerInfoGetter + = StandardAssemblerInfoGetter + -- ^ Interrogate the standard system assembler + | DarwinClangAssemblerInfoGetter + -- ^ If running on Darwin, return `Clang`; otherwise + -- interrogate the standard system assembler. + + +-- | Names a function that generates code and writes the results to a +-- file, of this type: +-- +-- > Logger +-- > -> DynFlags +-- > -> Module -- ^ module being compiled +-- > -> ModLocation +-- > -> FilePath -- ^ Where to write output +-- > -> Set UnitId -- ^ dependencies +-- > -> Stream IO RawCmmGroup a -- results from `StgToCmm` +-- > -> IO a +-- +-- The functions so named are defined in "GHC.Driver.CodeOutput". +-- +-- We expect one function per back end—or more precisely, one function +-- for each back end that writes code to a file. (The interpreter +-- does not write to files; its output lives only in memory.) + +data DefunctionalizedCodeOutput + = NcgCodeOutput + | ViaCCodeOutput + | LlvmCodeOutput + + +-- | Names a function that tells the driver what should happen after +-- assembly code is written. This might include running a C compiler, +-- running LLVM, running an assembler, or various similar activities. +-- The function named normally has this type: +-- +-- > TPipelineClass TPhase m +-- > => PipeEnv +-- > -> HscEnv +-- > -> Maybe ModLocation +-- > -> FilePath +-- > -> m (Maybe FilePath) +-- +-- The functions so named are defined in "GHC.Driver.Pipeline". + +data DefunctionalizedPostHscPipeline + = NcgPostHscPipeline + | ViaCPostHscPipeline + | LlvmPostHscPipeline + | NoPostHscPipeline -- ^ After code generation, nothing else need happen. + +-- | Names a function that tells the driver what command-line options +-- to include when invoking a C compiler. It's meant for @-D@ options that +-- define symbols for the C preprocessor. Because the exact symbols +-- defined might depend on versions of tools located in the file +-- system (/cough/ LLVM /cough/), the function requires an `IO` action. +-- The function named has this type: +-- +-- > Logger -> DynFlags -> IO [String] + +data DefunctionalizedCDefs + = NoCDefs -- ^ No additional command-line options are needed + + | LlvmCDefs -- ^ Return command-line options that tell GHC about the + -- LLVM version. + +--------------------------------------------------------------------------------- + + + +-- | An informal description of the back end, for use in +-- issuing warning messages /only/. If code depends on +-- what's in the string, you deserve what happens to you. +backendDescription :: Backend -> String +backendDescription (Named NCG) = "native code generator" +backendDescription (Named LLVM) = "LLVM" +backendDescription (Named ViaC) = "compiling via C" +backendDescription (Named Interpreter) = "byte-code interpreter" +backendDescription (Named NoBackend) = "no code generated" + +-- | This flag tells the compiler driver whether the back +-- end will write files: interface files and object files. +-- It is typically true for "real" back ends that generate +-- code into the filesystem. (That means, not the interpreter.) +backendWritesFiles :: Backend -> Bool +backendWritesFiles (Named NCG) = True +backendWritesFiles (Named LLVM) = True +backendWritesFiles (Named ViaC) = True +backendWritesFiles (Named Interpreter) = False +backendWritesFiles (Named NoBackend) = False + +-- | When the back end does write files, this value tells +-- the compiler in what manner of file the output should go: +-- temporary, persistent, or specific. +backendPipelineOutput :: Backend -> PipelineOutput +backendPipelineOutput (Named NCG) = Persistent +backendPipelineOutput (Named LLVM) = Persistent +backendPipelineOutput (Named ViaC) = Persistent +backendPipelineOutput (Named Interpreter) = NoOutputFile +backendPipelineOutput (Named NoBackend) = NoOutputFile + +-- | This flag tells the driver whether the back end can +-- reuse code (bytecode or object code) that has been +-- loaded dynamically. Likely true only of the interpreter. +backendCanReuseLoadedCode :: Backend -> Bool +backendCanReuseLoadedCode (Named NCG) = False +backendCanReuseLoadedCode (Named LLVM) = False +backendCanReuseLoadedCode (Named ViaC) = False +backendCanReuseLoadedCode (Named Interpreter) = True +backendCanReuseLoadedCode (Named NoBackend) = False + +-- | It is is true of every back end except @-fno-code@ +-- that it "generates code." Surprisingly, this property +-- influences the driver in a ton of ways. Some examples: +-- +-- * If the back end does not generate code, then the +-- driver needs to turn on code generation for +-- Template Haskell (because that code needs to be +-- generated and run at compile time). +-- +-- * If the back end does not generate code, then the +-- driver does not need to deal with an output file. +-- +-- * If the back end /does/ generated code, then the +-- driver supports `HscRecomp`. If not, recompilation +-- does not need a linkable (and is automatically up +-- to date). +-- +backendGeneratesCode :: Backend -> Bool +backendGeneratesCode (Named NCG) = True +backendGeneratesCode (Named LLVM) = True +backendGeneratesCode (Named ViaC) = True +backendGeneratesCode (Named Interpreter) = True +backendGeneratesCode (Named NoBackend) = False + +-- | When set, this flag turns on interface writing for +-- Backpack. It should probably be the same as +-- `backendGeneratesCode`, but it is kept distinct for +-- reasons described in Note [-fno-code mode]. +backendSupportsInterfaceWriting :: Backend -> Bool +backendSupportsInterfaceWriting (Named NCG) = True +backendSupportsInterfaceWriting (Named LLVM) = True +backendSupportsInterfaceWriting (Named ViaC) = True +backendSupportsInterfaceWriting (Named Interpreter) = True +backendSupportsInterfaceWriting (Named NoBackend) = False + +-- | When preparing code for this back end, the type +-- checker should pay attention to SPECIALISE pragmas. If +-- this flag is `False`, then the type checker ignores +-- SPECIALISE pragmas (for imported things?). +backendRespectsSpecialise :: Backend -> Bool +backendRespectsSpecialise (Named NCG) = True +backendRespectsSpecialise (Named LLVM) = True +backendRespectsSpecialise (Named ViaC) = True +backendRespectsSpecialise (Named Interpreter) = False +backendRespectsSpecialise (Named NoBackend) = False + +-- | This back end wants the `mi_globals` field of a +-- `ModIface` to be populated (with the top-level bindings +-- of the original source). True for the interpreter, and +-- also true for "no backend", which is used by Haddock. +-- (After typechecking a module, Haddock wants access to +-- the module's `GlobalRdrEnv`.) +backendWantsGlobalBindings :: Backend -> Bool +backendWantsGlobalBindings (Named NCG) = False +backendWantsGlobalBindings (Named LLVM) = False +backendWantsGlobalBindings (Named ViaC) = False +backendWantsGlobalBindings (Named Interpreter) = True +backendWantsGlobalBindings (Named NoBackend) = True + +-- | The back end targets a technology that implements +-- `switch` natively. (For example, LLVM or C.) Therefore +-- it is not necessary for GHC to ccompile a Cmm `Switch` +-- form into a decision tree with jump tables at the +-- leaves. +backendHasNativeSwitch :: Backend -> Bool +backendHasNativeSwitch (Named NCG) = False +backendHasNativeSwitch (Named LLVM) = True +backendHasNativeSwitch (Named ViaC) = True +backendHasNativeSwitch (Named Interpreter) = False +backendHasNativeSwitch (Named NoBackend) = False + +-- | As noted in the documentation for +-- `PrimitiveImplementation`, certain primitives have +-- multiple implementations, depending on the capabilities +-- of the back end. This field signals to module +-- "GHC.StgToCmm.Prim" what implementations to use with +-- this back end. +backendPrimitiveImplementation :: Backend -> PrimitiveImplementation +backendPrimitiveImplementation (Named NCG) = NcgPrimitives +backendPrimitiveImplementation (Named LLVM) = LlvmPrimitives +backendPrimitiveImplementation (Named ViaC) = GenericPrimitives +backendPrimitiveImplementation (Named Interpreter) = GenericPrimitives +backendPrimitiveImplementation (Named NoBackend) = GenericPrimitives + +-- | When this value is `IsValid`, the back end is +-- compatible with vector instructions. When it is +-- `NotValid`, it carries a message that is shown to +-- users. +backendSimdValidity :: Backend -> Validity' String +backendSimdValidity (Named NCG) = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."] +backendSimdValidity (Named LLVM) = IsValid +backendSimdValidity (Named ViaC) = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."] +backendSimdValidity (Named Interpreter) = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."] +backendSimdValidity (Named NoBackend) = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."] + +-- | This flag says whether the back end supports large +-- binary blobs. See Note [Embedding large binary blobs] +-- in "GHC.CmmToAsm.Ppr". +backendSupportsEmbeddedBlobs :: Backend -> Bool +backendSupportsEmbeddedBlobs (Named NCG) = True +backendSupportsEmbeddedBlobs (Named LLVM) = False +backendSupportsEmbeddedBlobs (Named ViaC) = False +backendSupportsEmbeddedBlobs (Named Interpreter) = False +backendSupportsEmbeddedBlobs (Named NoBackend) = False + +-- | This flag tells the compiler driver that the back end +-- does not support every target platform; it supports +-- only platforms that claim NCG support. (It's set only +-- for the native code generator.) Crufty. If the driver +-- tries to use the native code generator /without/ +-- platform support, the driver fails over to the LLVM +-- back end. +backendNeedsPlatformNcgSupport :: Backend -> Bool +backendNeedsPlatformNcgSupport (Named NCG) = True +backendNeedsPlatformNcgSupport (Named LLVM) = False +backendNeedsPlatformNcgSupport (Named ViaC) = False +backendNeedsPlatformNcgSupport (Named Interpreter) = False +backendNeedsPlatformNcgSupport (Named NoBackend) = False + +-- | This flag is set if the back end can generate code +-- for proc points. If the flag is not set, then a Cmm +-- pass needs to split proc points (that is, turn each +-- proc point into a standalone procedure). +backendSupportsUnsplitProcPoints :: Backend -> Bool +backendSupportsUnsplitProcPoints (Named NCG) = True +backendSupportsUnsplitProcPoints (Named LLVM) = False +backendSupportsUnsplitProcPoints (Named ViaC) = False +backendSupportsUnsplitProcPoints (Named Interpreter) = False +backendSupportsUnsplitProcPoints (Named NoBackend) = False + +-- | This flag guides the driver in resolving issues about +-- API support on the target platform. If the flag is set, +-- then these things are true: +-- +-- * When the target platform supports /only/ an unregisterised API, +-- this backend can be replaced with compilation via C. +-- +-- * When the target does /not/ support an unregisterised API, +-- this back end can replace compilation via C. +-- +backendSwappableWithViaC :: Backend -> Bool +backendSwappableWithViaC (Named NCG) = True +backendSwappableWithViaC (Named LLVM) = True +backendSwappableWithViaC (Named ViaC) = False +backendSwappableWithViaC (Named Interpreter) = False +backendSwappableWithViaC (Named NoBackend) = False + +-- | This flag is true if the back end works *only* with +-- the unregisterised ABI. +backendUnregisterisedAbiOnly :: Backend -> Bool +backendUnregisterisedAbiOnly (Named NCG) = False +backendUnregisterisedAbiOnly (Named LLVM) = False +backendUnregisterisedAbiOnly (Named ViaC) = True +backendUnregisterisedAbiOnly (Named Interpreter) = False +backendUnregisterisedAbiOnly (Named NoBackend) = False + +-- | This flag is set if the back end generates C code in +-- a @.hc@ file. The flag lets the compiler driver know +-- if the command-line flag @-C@ is meaningful. +backendGeneratesHc :: Backend -> Bool +backendGeneratesHc (Named NCG) = False +backendGeneratesHc (Named LLVM) = False +backendGeneratesHc (Named ViaC) = True +backendGeneratesHc (Named Interpreter) = False +backendGeneratesHc (Named NoBackend) = False + +-- | This flag says whether SPT (static pointer table) +-- entries will be inserted dynamically if needed. If +-- this flag is `False`, then "GHC.Iface.Tidy" should emit C +-- stubs that initialize the SPT entries. +backendSptIsDynamic :: Backend -> Bool +backendSptIsDynamic (Named NCG) = False +backendSptIsDynamic (Named LLVM) = False +backendSptIsDynamic (Named ViaC) = False +backendSptIsDynamic (Named Interpreter) = True +backendSptIsDynamic (Named NoBackend) = False + +-- | If this flag is set, then "GHC.HsToCore.Coverage" +-- inserts `Breakpoint` ticks. Used only for the +-- interpreter. +backendWantsBreakpointTicks :: Backend -> Bool +backendWantsBreakpointTicks (Named NCG) = False +backendWantsBreakpointTicks (Named LLVM) = False +backendWantsBreakpointTicks (Named ViaC) = False +backendWantsBreakpointTicks (Named Interpreter) = True +backendWantsBreakpointTicks (Named NoBackend) = False + +-- | If this flag is set, then the driver forces the +-- optimization level to 0, issuing a warning message if +-- the command line requested a higher optimization level. +backendForcesOptimization0 :: Backend -> Bool +backendForcesOptimization0 (Named NCG) = False +backendForcesOptimization0 (Named LLVM) = False +backendForcesOptimization0 (Named ViaC) = False +backendForcesOptimization0 (Named Interpreter) = True +backendForcesOptimization0 (Named NoBackend) = False + +-- | I don't understand exactly how this works. But if +-- this flag is set *and* another condition is met, then +-- @ghc/Main.hs@ will alter the `DynFlags` so that all the +-- `hostFullWays` are asked for. It is set only for the interpreter. +backendNeedsFullWays :: Backend -> Bool +backendNeedsFullWays (Named NCG) = False +backendNeedsFullWays (Named LLVM) = False +backendNeedsFullWays (Named ViaC) = False +backendNeedsFullWays (Named Interpreter) = True +backendNeedsFullWays (Named NoBackend) = False + +-- | This flag is also special for the interpreter: if a +-- message about a module needs to be shown, do we know +-- anything special about where the module came from? The +-- Boolean argument is a `recomp` flag. +backendSpecialModuleSource :: Backend -> Bool -> Maybe String +backendSpecialModuleSource (Named NCG) = const Nothing +backendSpecialModuleSource (Named LLVM) = const Nothing +backendSpecialModuleSource (Named ViaC) = const Nothing +backendSpecialModuleSource (Named Interpreter) = \b -> if b then Just "interpreted" else Nothing +backendSpecialModuleSource (Named NoBackend) = const (Just "nothing") + +-- | This flag says whether the back end supports Haskell +-- Program Coverage (HPC). If not, the compiler driver +-- will ignore the `-fhpc` option (and will issue a +-- warning message if it is used). +backendSupportsHpc :: Backend -> Bool +backendSupportsHpc (Named NCG) = True +backendSupportsHpc (Named LLVM) = True +backendSupportsHpc (Named ViaC) = True +backendSupportsHpc (Named Interpreter) = False +backendSupportsHpc (Named NoBackend) = True + +-- | This flag says whether the back end supports foreign +-- import of C functions. ("Supports" means "does not +-- barf on," so @-fno-code@ supports foreign C imports.) +backendSupportsCImport :: Backend -> Bool +backendSupportsCImport (Named NCG) = True +backendSupportsCImport (Named LLVM) = True +backendSupportsCImport (Named ViaC) = True +backendSupportsCImport (Named Interpreter) = True +backendSupportsCImport (Named NoBackend) = True + +-- | This flag says whether the back end supports foreign +-- export of Haskell functions to C. +backendSupportsCExport :: Backend -> Bool +backendSupportsCExport (Named NCG) = True +backendSupportsCExport (Named LLVM) = True +backendSupportsCExport (Named ViaC) = True +backendSupportsCExport (Named Interpreter) = False +backendSupportsCExport (Named NoBackend) = True + +-- | This (defunctionalized) function runs the assembler +-- used on the code that is written by this back end. A +-- program determined by a combination of back end, +-- `DynFlags`, and `Platform` is run with the given +-- `Option`s. +-- +-- The function's type is +-- @ +-- Logger -> DynFlags -> Platform -> [Option] -> IO () +-- @ +-- +-- This field is usually defaulted. +backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg +backendAssemblerProg (Named NCG) = StandardAssemblerProg +backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg +backendAssemblerProg (Named ViaC) = StandardAssemblerProg +backendAssemblerProg (Named Interpreter) = StandardAssemblerProg +backendAssemblerProg (Named NoBackend) = StandardAssemblerProg + +-- | This (defunctionalized) function is used to retrieve +-- an enumeration value that characterizes the C/assembler +-- part of a toolchain. The function caches the info in a +-- mutable variable that is part of the `DynFlags`. +-- +-- The function's type is +-- @ +-- Logger -> DynFlags -> Platform -> IO CompilerInfo +-- @ +-- +-- This field is usually defaulted. +backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter +backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter +backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter +backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter +backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter +backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter + +-- | When using this back end, it may be necessary or +-- advisable to pass some `-D` options to a C compiler. +-- This (defunctionalized) function produces those +-- options, if any. An IO action may be necessary in +-- order to interrogate external tools about what version +-- they are, for example. +-- +-- The function's type is +-- @ +-- Logger -> DynFlags -> IO [String] +-- @ +-- +-- This field is usually defaulted. +backendCDefs :: Backend -> DefunctionalizedCDefs +backendCDefs (Named NCG) = NoCDefs +backendCDefs (Named LLVM) = LlvmCDefs +backendCDefs (Named ViaC) = NoCDefs +backendCDefs (Named Interpreter) = NoCDefs +backendCDefs (Named NoBackend) = NoCDefs + +-- | This (defunctionalized) function generates code and +-- writes it to a file. The type of the function is +-- +-- > Logger +-- > -> DynFlags +-- > -> Module -- ^ module being compiled +-- > -> ModLocation +-- > -> FilePath -- ^ Where to write output +-- > -> Set UnitId -- ^ dependencies +-- > -> Stream IO RawCmmGroup a -- results from `StgToCmm` +-- > -> IO a +backendCodeOutput :: Backend -> DefunctionalizedCodeOutput +backendCodeOutput (Named NCG) = NcgCodeOutput +backendCodeOutput (Named LLVM) = LlvmCodeOutput +backendCodeOutput (Named ViaC) = ViaCCodeOutput +backendCodeOutput (Named Interpreter) = panic "backendCodeOutput: interpreterBackend" +backendCodeOutput (Named NoBackend) = panic "backendCodeOutput: noBackend" + +-- | This (defunctionalized) function tells the compiler +-- driver what else has to be run after code output. +-- The type of the function is +-- +-- > +-- > TPipelineClass TPhase m +-- > => PipeEnv +-- > -> HscEnv +-- > -> Maybe ModLocation +-- > -> FilePath +-- > -> m (Maybe FilePath) +backendPostHscPipeline :: Backend -> DefunctionalizedPostHscPipeline +backendPostHscPipeline (Named NCG) = NcgPostHscPipeline +backendPostHscPipeline (Named LLVM) = LlvmPostHscPipeline +backendPostHscPipeline (Named ViaC) = ViaCPostHscPipeline +backendPostHscPipeline (Named Interpreter) = NoPostHscPipeline +backendPostHscPipeline (Named NoBackend) = NoPostHscPipeline + +-- | Somewhere in the compiler driver, when compiling +-- Haskell source (as opposed to a boot file or a sig +-- file), it needs to know what to do with the code that +-- the `backendCodeOutput` writes to a file. This `Phase` +-- value gives instructions like "run the C compiler", +-- "run the assembler," or "run the LLVM Optimizer." +backendNormalSuccessorPhase :: Backend -> Phase +backendNormalSuccessorPhase (Named NCG) = As False +backendNormalSuccessorPhase (Named LLVM) = LlvmOpt +backendNormalSuccessorPhase (Named ViaC) = HCc +backendNormalSuccessorPhase (Named Interpreter) = StopLn +backendNormalSuccessorPhase (Named NoBackend) = StopLn + +-- | Name of the back end, if any. Used to migrate legacy +-- clients of the GHC API. Code within the GHC source +-- tree should not refer to a back end's name. +backendName :: Backend -> BackendName +backendName (Named NCG) = NCG +backendName (Named LLVM) = LLVM +backendName (Named ViaC) = ViaC +backendName (Named Interpreter) = Interpreter +backendName (Named NoBackend) = NoBackend + + + +-- | A list of all back ends. They are ordered as we wish them to +-- appear when they are enumerated in error messages. + +allBackends :: [Backend] +allBackends = [ ncgBackend + , llvmBackend + , viaCBackend + , interpreterBackend + , noBackend + ] + +-- | When foreign C import or export is invalid, the carried value +-- enumerates the /valid/ back ends. + +backendValidityOfCImport, backendValidityOfCExport :: Backend -> Validity' [Backend] + +backendValidityOfCImport backend = + if backendSupportsCImport backend then + IsValid + else + NotValid $ filter backendSupportsCImport allBackends + +backendValidityOfCExport backend = + if backendSupportsCExport backend then + IsValid + else + NotValid $ filter backendSupportsCExport allBackends + + + + +{- +Note [Backend Defunctionalization] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +I had hoped to include code-output and post-hsc-pipeline functions +directly in the `Backend` record itself. But this agenda was derailed +by mutual recursion in the types: + + - A `DynFlags` record contains a back end of type `Backend`. + - A `Backend` contains a code-output function. + - A code-output function takes Cmm as input. + - Cmm can include a `CLabel`. + - A `CLabel` can have elements that are defined in + `GHC.Driver.Session`, where `DynFlags` is defined. + +There is also a nasty issue in the values: a typical post-backend +pipeline function both depends on and is depended upon by functions in +"GHC.Driver.Pipeline". + +I'm cut the Gordian not by removing the function types from the +`Backend` record. Instead, a function is represented by its /name/. +This representation is an example of an old trick called +/defunctionalization/, which has been used in both compilers and +interpreters for languages with first-class, nested functions. Here, +a function's name is a value of an algebraic data type. For example, +a code-output function is represented by a value of this type: + + data DefunctionalizedCodeOutput + = NcgCodeOutput + | ViaCCodeOutput + | LlvmCodeOutput + +Such a function may be applied in one of two ways: + + - In this particular example, a `case` expression in module + "GHC.Driver.CodeOutput" discriminates on the value and calls the + designated function. + + - In another example, a function of type `DefunctionalizedCDefs` is + applied by calling function `applyCDefs`, which has this type: + + @ + applyCDefs :: DefunctionalizedCDefs -> Logger -> DynFlags -> IO [String] + @ + + Function `applyCDefs` is defined in module "GHC.Driver.Pipeline.Execute". + +I don't love this solution, but defunctionalization is a standard +thing, and it makes the meanings of the enumeration values clear. + +Anyone defining a new back end will need to extend both the +`DefunctionalizedCodeOutput` type and the corresponding apply +function. +-} diff --git a/compiler/GHC/Driver/Backend/Internal.hs b/compiler/GHC/Driver/Backend/Internal.hs new file mode 100644 index 0000000000..99484b752e --- /dev/null +++ b/compiler/GHC/Driver/Backend/Internal.hs @@ -0,0 +1,32 @@ +{-| +Module : GHC.Driver.Backend.Internal +Description : Interface for migrating legacy clients of the GHC API + +In versions of GHC up through 9.2, a `Backend` was represented only by +its name. This module is meant to aid clients written against the GHC +API, versions 9.2 and older. The module provides an alternative way +to name any back end found in GHC 9.2. /Code within the GHC source +tree should not import this module./ (#20927). + +Only back ends found in version 9.2 have names. + +-} + +module GHC.Driver.Backend.Internal + ( -- * Name of a back end + BackendName(..) + ) + +where + + + +import GHC.Prelude + +data BackendName + = NCG -- ^ Names the native code generator backend. + | LLVM -- ^ Names the LLVM backend. + | ViaC -- ^ Names the Via-C backend. + | Interpreter -- ^ Names the ByteCode interpreter. + | NoBackend -- ^ Names the `-fno-code` backend. + deriving (Eq, Show) diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index a5fb1dc168..06fdbb34e8 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -20,6 +20,7 @@ module GHC.Driver.Backpack (doBackpack) where import GHC.Prelude +import GHC.Driver.Backend -- In a separate module because it hooks into the parser. import GHC.Driver.Backpack.Syntax import GHC.Driver.Config.Finder (initFinderOpts) @@ -188,7 +189,7 @@ withBkpSession cid insts deps session_type do_this = do hscUpdateFlags (\dflags -> mk_temp_dflags (hsc_units hsc_env) dflags) hsc_env mk_temp_dflags unit_state dflags = dflags { backend = case session_type of - TcSession -> NoBackend + TcSession -> noBackend _ -> backend dflags , ghcLink = case session_type of TcSession -> NoLink @@ -214,7 +215,7 @@ withBkpSession cid insts deps session_type do_this = do -- Make sure to write interfaces when we are type-checking -- indefinite packages. TcSession - | backend dflags /= NoBackend + | backendSupportsInterfaceWriting $ backend dflags -> EnumSet.insert Opt_WriteInterface (generalFlags dflags) _ -> generalFlags dflags diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index c073c40323..5b3f614d8e 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -43,7 +43,6 @@ import GHC.Utils.TmpFs import GHC.Utils.Error import GHC.Utils.Outputable -import GHC.Utils.Panic import GHC.Utils.Logger import GHC.Utils.Exception (bracket) import GHC.Utils.Ppr (Mode(..)) @@ -120,13 +119,11 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g ; emitInitializerDecls this_mod stubs ; return (stubs, a) } - ; (stubs, a) <- case backend dflags of - NCG -> outputAsm logger dflags this_mod location filenm - final_stream - ViaC -> outputC logger dflags filenm final_stream pkg_deps - LLVM -> outputLlvm logger llvm_config dflags filenm final_stream - Interpreter -> panic "codeOutput: Interpreter" - NoBackend -> panic "codeOutput: NoBackend" + ; (stubs, a) <- case backendCodeOutput (backend dflags) of + NcgCodeOutput -> outputAsm logger dflags this_mod location filenm + final_stream + ViaCCodeOutput -> outputC logger dflags filenm final_stream pkg_deps + LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm final_stream ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs ; return (filenm, stubs_exist, foreign_fps, a) } @@ -313,8 +310,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n" --- Don't use doOutput for dumping the f. export stubs --- since it is more than likely that the stubs file will +-- It is more than likely that the stubs file will -- turn out to be empty, in which case no file should be created. outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool outputForeignStubs_help _fname "" _header _footer = return False @@ -392,5 +388,3 @@ ipInitCode do_info_table platform this_mod ents | ipe <- ipes ] ++ [text "NULL"]) <> semi - - diff --git a/compiler/GHC/Driver/Config/Cmm.hs b/compiler/GHC/Driver/Config/Cmm.hs index 38bab62048..5e7ebf72dd 100644 --- a/compiler/GHC/Driver/Config/Cmm.hs +++ b/compiler/GHC/Driver/Config/Cmm.hs @@ -3,7 +3,6 @@ module GHC.Driver.Config.Cmm ) where import GHC.Cmm.Config -import GHC.Cmm.Switch (backendSupportsSwitch) import GHC.Driver.Session import GHC.Driver.Backend @@ -21,8 +20,8 @@ initCmmConfig dflags = CmmConfig , cmmOptSink = gopt Opt_CmmSink dflags , cmmGenStackUnwindInstr = debugLevel dflags > 0 , cmmExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags - , cmmDoCmmSwitchPlans = not . backendSupportsSwitch . backend $ dflags - , cmmSplitProcPoints = (backend dflags /= NCG) + , cmmDoCmmSwitchPlans = not . backendHasNativeSwitch . backend $ dflags + , cmmSplitProcPoints = not (backendSupportsUnsplitProcPoints (backend dflags)) || not (platformTablesNextToCode platform) || usingInconsistentPicReg } diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs index 7ec80f24d3..b0b28bf158 100644 --- a/compiler/GHC/Driver/Config/StgToCmm.hs +++ b/compiler/GHC/Driver/Config/StgToCmm.hs @@ -8,6 +8,7 @@ import GHC.Driver.Backend import GHC.Driver.Session import GHC.Platform import GHC.Platform.Profile +import GHC.Utils.Error import GHC.Unit.Module import GHC.Utils.Outputable @@ -60,9 +61,11 @@ initStgToCmmConfig dflags mod = StgToCmmConfig } where profile = targetProfile dflags platform = profilePlatform profile bk_end = backend dflags - ncg = bk_end == NCG - llvm = bk_end == LLVM b_blob = if not ncg then Nothing else binBlobThreshold dflags + (ncg, llvm) = case backendPrimitiveImplementation bk_end of + GenericPrimitives -> (False, False) + NcgPrimitives -> (True, False) + LlvmPrimitives -> (False, True) x86ish = case platformArch platform of ArchX86 -> True ArchX86_64 -> True @@ -71,6 +74,6 @@ initStgToCmmConfig dflags mod = StgToCmmConfig ArchPPC -> True ArchPPC_64 _ -> True _ -> False - vec_err = case backend dflags of - LLVM -> Nothing - _ -> Just (unlines ["SIMD vector instructions require the LLVM back-end.", "Please use -fllvm."]) + vec_err = case backendSimdValidity (backend dflags) of + IsValid -> Nothing + NotValid msg -> Just msg diff --git a/compiler/GHC/Driver/Config/Tidy.hs b/compiler/GHC/Driver/Config/Tidy.hs index d7ad76fc87..89bdf31b2c 100644 --- a/compiler/GHC/Driver/Config/Tidy.hs +++ b/compiler/GHC/Driver/Config/Tidy.hs @@ -62,12 +62,8 @@ initStaticPtrOpts hsc_env = do -- If we are compiling for the interpreter we will insert any necessary -- SPT entries dynamically, otherwise we add a C stub to do so - , opt_gen_cstub = case backend dflags of - Interpreter -> False - _ -> True - + , opt_gen_cstub = backendWritesFiles (backend dflags) , opt_mk_string = mk_string , opt_static_ptr_info_datacon = static_ptr_info_datacon , opt_static_ptr_datacon = static_ptr_datacon } - diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index ddc86ac3e3..36dcf24237 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -824,24 +824,24 @@ hscRecompStatus return $ HscRecompNeeded $ fmap (mi_iface_hash . mi_final_exts) mb_checked_iface UpToDateItem checked_iface -> do let lcl_dflags = ms_hspp_opts mod_summary - case backend lcl_dflags of - -- No need for a linkable, we're good to go - NoBackend -> do - msg $ UpToDate - return $ HscUpToDate checked_iface Nothing + if not (backendGeneratesCode (backend lcl_dflags)) then + -- No need for a linkable, we're good to go + do msg $ UpToDate + return $ HscUpToDate checked_iface Nothing + else -- Do need linkable - _ -> do + do -- Check to see whether the expected build products already exist. -- If they don't exists then we trigger recompilation. recomp_linkable_result <- case () of -- Interpreter can use either already loaded bytecode or loaded object code - _ | Interpreter <- backend lcl_dflags -> do + _ | backendCanReuseLoadedCode (backend lcl_dflags) -> do let res = checkByteCode old_linkable case res of UpToDateItem _ -> pure res _ -> liftIO $ checkObjects lcl_dflags old_linkable mod_summary -- Need object files for making object files - | backendProducesObject (backend lcl_dflags) -> liftIO $ checkObjects lcl_dflags old_linkable mod_summary + | backendWritesFiles (backend lcl_dflags) -> liftIO $ checkObjects lcl_dflags old_linkable mod_summary | otherwise -> pprPanic "hscRecompStatus" (text $ show $ backend lcl_dflags) case recomp_linkable_result of UpToDateItem linkable -> do @@ -1001,7 +1001,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h -- interface file. case mb_desugar of -- Just cause we desugared doesn't mean we are generating code, see above. - Just desugared_guts | bcknd /= NoBackend -> do + Just desugared_guts | backendGeneratesCode bcknd -> do plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result) simplified_guts <- hscSimplify' plugins desugared_guts @@ -1088,10 +1088,7 @@ hscMaybeWriteIface -> IO () hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do let force_write_interface = gopt Opt_WriteInterface dflags - write_interface = case backend dflags of - NoBackend -> False - Interpreter -> False - _ -> True + write_interface = backendWritesFiles (backend dflags) write_iface dflags' iface = let !iface_name = if dynamicNow dflags' then ml_dyn_hi_file mod_location else ml_hi_file mod_location @@ -2397,4 +2394,4 @@ showModuleIndex (i,n) = text "[" <> pad <> int i <> text " of " <> int n <> text writeInterfaceOnlyMode :: DynFlags -> Bool writeInterfaceOnlyMode dflags = gopt Opt_WriteInterface dflags && - NoBackend == backend dflags + not (backendGeneratesCode (backend dflags)) diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index dfc0af7e38..efaefd84f5 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -1758,7 +1758,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = enable_code_gen ms = return ms nocode_enable ms@(ModSummary { ms_hspp_opts = dflags }) = - backend dflags == NoBackend && + not (backendGeneratesCode (backend dflags)) && -- Don't enable codegen for TH on indefinite packages; we -- can't compile anything anyway! See #16219. isHomeUnitDefinite (ue_unitHomeUnit (ms_unitid ms) unit_env) diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 89a4329745..e988979df2 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -251,10 +251,7 @@ compileOne' mHscMessage input_fn = expectJust "compile:hs" (ml_hs_file location) input_fnpp = ms_hspp_file summary - pipelineOutput = case bcknd of - Interpreter -> NoOutputFile - NoBackend -> NoOutputFile - _ -> Persistent + pipelineOutput = backendPipelineOutput bcknd logger = hsc_logger hsc_env0 tmpfs = hsc_tmpfs hsc_env0 @@ -278,7 +275,10 @@ compileOne' mHscMessage -- was set), force it to generate byte-code. This is NOT transitive and -- only applies to direct targets. | loadAsByteCode - = (Interpreter, gopt_set (lcl_dflags { backend = Interpreter }) Opt_ForceRecomp) + = ( interpreterBackend + , gopt_set (lcl_dflags { backend = interpreterBackend }) Opt_ForceRecomp + ) + | otherwise = (backend dflags, lcl_dflags) -- See Note [Filepaths and Multiple Home Units] @@ -526,7 +526,7 @@ 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 - | NoBackend <- backend dflags, notStopPreprocess = NoOutputFile + | not (backendGeneratesCode (backend dflags)), notStopPreprocess = NoOutputFile -- avoid -E -fno-code undesirable interactions. see #20439 | NoStop <- stop_phase, not (isNoLink ghc_link) = Persistent -- -o foo applies to linker @@ -728,19 +728,19 @@ hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, Maybe Linkable) hscBackendPipeline pipe_env hsc_env mod_sum result = - case backend (hsc_dflags hsc_env) of - NoBackend -> - case result of - HscUpdate iface -> return (iface, Nothing) - HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing - -- TODO: Why is there not a linkable? - -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing - _ -> do + if backendGeneratesCode (backend (hsc_dflags hsc_env)) then + do res <- hscGenBackendPipeline pipe_env hsc_env mod_sum result when (gopt Opt_BuildDynamicToo (hsc_dflags hsc_env)) $ do let dflags' = setDynamicNow (hsc_dflags hsc_env) -- set "dynamicNow" () <$ hscGenBackendPipeline pipe_env (hscSetFlags dflags' hsc_env) mod_sum result return res + else + case result of + HscUpdate iface -> return (iface, Nothing) + HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing + -- TODO: Why is there not a linkable? + -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing hscGenBackendPipeline :: P m => PipeEnv @@ -811,12 +811,19 @@ hscPostBackendPipeline :: P m => PipeEnv -> HscEnv -> HscSource -> Backend -> Ma hscPostBackendPipeline _ _ HsBootFile _ _ _ = return Nothing hscPostBackendPipeline _ _ HsigFile _ _ _ = return Nothing hscPostBackendPipeline pipe_env hsc_env _ bcknd ml input_fn = - case bcknd of - ViaC -> viaCPipeline HCc pipe_env hsc_env ml input_fn - NCG -> Just <$> asPipeline False pipe_env hsc_env ml input_fn - LLVM -> Just <$> llvmPipeline pipe_env hsc_env ml input_fn - NoBackend -> return Nothing - Interpreter -> return Nothing + applyPostHscPipeline (backendPostHscPipeline bcknd) pipe_env hsc_env ml input_fn + +applyPostHscPipeline + :: TPipelineClass TPhase m + => DefunctionalizedPostHscPipeline + -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) +applyPostHscPipeline NcgPostHscPipeline = + \pe he ml fp -> Just <$> asPipeline False pe he ml fp +applyPostHscPipeline ViaCPostHscPipeline = viaCPipeline HCc +applyPostHscPipeline LlvmPostHscPipeline = + \pe he ml fp -> Just <$> llvmPipeline pe he ml fp +applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing + -- Pipeline from a given suffix pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 58bc1e6907..86ba305461 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -44,7 +44,6 @@ import GHC.Utils.TmpFs import GHC.Platform import Data.List (intercalate, isInfixOf) import GHC.Unit.Env -import GHC.SysTools.Info import GHC.Utils.Error import Data.Maybe import GHC.CmmToLlvm.Mangler @@ -287,13 +286,11 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- LLVM from version 3.0 onwards doesn't support the OS X system -- assembler, so we use clang as the assembler instead. (#5636) - let (as_prog, get_asm_info) | backend dflags == LLVM - , platformOS platform == OSDarwin - = (GHC.SysTools.runClang, pure Clang) - | otherwise - = (GHC.SysTools.runAs, getAssemblerInfo logger dflags) - - asmInfo <- get_asm_info + let (as_prog, get_asm_info) = + ( applyAssemblerProg $ backendAssemblerProg (backend dflags) + , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags) + ) + asmInfo <- get_asm_info logger dflags platform let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -313,6 +310,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do = withAtomicRename outputFilename $ \temp_outputFilename -> as_prog logger dflags + platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -340,6 +338,29 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do return output_fn +applyAssemblerInfoGetter + :: DefunctionalizedAssemblerInfoGetter + -> Logger -> DynFlags -> Platform -> IO CompilerInfo +applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform = + getAssemblerInfo logger dflags +applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform = + if platformOS platform == OSDarwin then + pure Clang + else + getAssemblerInfo logger dflags + +applyAssemblerProg + :: DefunctionalizedAssemblerProg + -> Logger -> DynFlags -> Platform -> [Option] -> IO () +applyAssemblerProg StandardAssemblerProg logger dflags _platform = + runAs logger dflags +applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = + if platformOS platform == OSDarwin then + runClang logger dflags + else + runAs logger dflags + + runCcPhase :: Phase -> PipeEnv -> HscEnv -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env input_fn = do @@ -501,28 +522,10 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do hscs_partial_iface = partial_iface, hscs_old_iface_hash = mb_old_iface_hash } - -> case backend dflags of - NoBackend -> panic "HscRecomp not relevant for NoBackend" - 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 - hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location - - (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 <- getCurrentTime - let !linkable = LM unlinked_time (mkHomeModule (hsc_home_unit hsc_env) mod_name) - (hs_unlinked ++ stub_o) - return ([], final_iface, Just linkable, panic "interpreter") - _ -> do + -> if not (backendGeneratesCode (backend dflags)) then + panic "HscRecomp not relevant for NoBackend" + else if backendWritesFiles (backend dflags) then + do output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location) (outputFilename, mStub, foreign_files, mb_cg_infos) <- hscGenHardCode hsc_env cgguts mod_location output_fn @@ -542,6 +545,27 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- is in TPipeline and in this branch we can invoke the rest of the backend phase. return (fos, final_iface, Nothing, outputFilename) + else + -- In interpreted mode the regular codeGen backend is not run so we + -- generate a interface without codeGen info. + do + final_iface <- mkFullIface hsc_env partial_iface Nothing + hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location + + (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 <- getCurrentTime + let !linkable = LM unlinked_time (mkHomeModule (hsc_home_unit hsc_env) mod_name) + (hs_unlinked ++ stub_o) + return ([], final_iface, Just linkable, panic "interpreter") + runUnlitPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath runUnlitPhase hsc_env input_fn output_fn = do @@ -991,7 +1015,7 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++ [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ] - backend_defs <- getBackendDefs logger dflags + backend_defs <- applyCDefs (backendCDefs $ backend dflags) logger dflags let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ] -- Default CPP defines in Haskell source @@ -1043,8 +1067,9 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do , GHC.SysTools.FileOption "" output_fn ]) -getBackendDefs :: Logger -> DynFlags -> IO [String] -getBackendDefs logger dflags | backend dflags == LLVM = do +applyCDefs :: DefunctionalizedCDefs -> Logger -> DynFlags -> IO [String] +applyCDefs NoCDefs _ _ = return [] +applyCDefs LlvmCDefs logger dflags = do llvmVer <- figureLlvmVersion logger dflags return $ case fmap llvmVersionList llvmVer of Just [m] -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,0) ] @@ -1052,23 +1077,15 @@ getBackendDefs logger dflags | backend dflags == LLVM = do _ -> [] where format (major, minor) - | minor >= 100 = error "getBackendDefs: Unsupported minor version" - | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int + | minor >= 100 = error "backendCDefs: Unsupported minor version" + | otherwise = show (100 * major + minor :: Int) -- Contract is Int -getBackendDefs _ _ = - return [] -- | What phase to run after one of the backend code generators has run hscPostBackendPhase :: HscSource -> Backend -> Phase hscPostBackendPhase HsBootFile _ = StopLn hscPostBackendPhase HsigFile _ = StopLn -hscPostBackendPhase _ bcknd = - case bcknd of - ViaC -> HCc - NCG -> As False - LLVM -> LlvmOpt - NoBackend -> StopLn - Interpreter -> StopLn +hscPostBackendPhase _ bcknd = backendNormalSuccessorPhase bcknd compileStub :: HscEnv -> FilePath -> IO FilePath diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 0f1a4b6e02..f765bb44ce 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -2295,9 +2295,9 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "keep-s-files" (NoArg (setGeneralFlag Opt_KeepSFiles)) , make_ord_flag defGhcFlag "keep-llvm-file" - (NoArg $ setObjBackend LLVM >> setGeneralFlag Opt_KeepLlvmFiles) + (NoArg $ setObjBackend llvmBackend >> setGeneralFlag Opt_KeepLlvmFiles) , make_ord_flag defGhcFlag "keep-llvm-files" - (NoArg $ setObjBackend LLVM >> setGeneralFlag Opt_KeepLlvmFiles) + (NoArg $ setObjBackend llvmBackend >> setGeneralFlag Opt_KeepLlvmFiles) -- This only makes sense as plural , make_ord_flag defGhcFlag "keep-tmp-files" (NoArg (setGeneralFlag Opt_KeepTmpFiles)) @@ -2473,7 +2473,7 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats) , make_ord_flag defGhcFlag "ddump-llvm" - (NoArg $ setObjBackend LLVM >> setDumpFlag' Opt_D_dump_llvm) + (NoArg $ setObjBackend llvmBackend >> setDumpFlag' Opt_D_dump_llvm) , make_ord_flag defGhcFlag "ddump-c-backend" (NoArg $ setDumpFlag' Opt_D_dump_c_backend) , make_ord_flag defGhcFlag "ddump-deriv" @@ -2902,20 +2902,20 @@ dynamic_flags_deps = [ (NoArg (setGeneralFlag Opt_InfoTableMap)) ------ Compiler flags ----------------------------------------------- - , make_ord_flag defGhcFlag "fasm" (NoArg (setObjBackend NCG)) + , make_ord_flag defGhcFlag "fasm" (NoArg (setObjBackend ncgBackend)) , make_ord_flag defGhcFlag "fvia-c" (NoArg (deprecate $ "The -fvia-c flag does nothing; " ++ "it will be removed in a future GHC release")) , make_ord_flag defGhcFlag "fvia-C" (NoArg (deprecate $ "The -fvia-C flag does nothing; " ++ "it will be removed in a future GHC release")) - , make_ord_flag defGhcFlag "fllvm" (NoArg (setObjBackend LLVM)) + , make_ord_flag defGhcFlag "fllvm" (NoArg (setObjBackend llvmBackend)) , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> - d { ghcLink=NoLink }) >> setBackend NoBackend)) + d { ghcLink=NoLink }) >> setBackend noBackend)) , make_ord_flag defFlag "fbyte-code" (noArgM $ \dflags -> do - setBackend Interpreter + setBackend interpreterBackend pure $ gopt_set dflags Opt_ByteCode) , make_ord_flag defFlag "fobject-code" $ NoArg $ do dflags <- liftEwM getCmdLineState @@ -4415,7 +4415,7 @@ addReexportedModule p = -- code are allowed (requests for other target types are ignored). setBackend :: Backend -> DynP () setBackend l = upd $ \ dfs -> - if ghcLink dfs /= LinkBinary || backendProducesObject l + if ghcLink dfs /= LinkBinary || backendWritesFiles l then dfs{ backend = l } else dfs @@ -4427,7 +4427,7 @@ setObjBackend :: Backend -> DynP () setObjBackend l = updM set where set dflags - | backendProducesObject (backend dflags) + | backendWritesFiles (backend dflags) = return $ dflags { backend = l } | otherwise = return dflags @@ -4774,30 +4774,33 @@ makeDynFlagsConsistent dflags -- Via-C backend only supports unregisterised ABI. Switch to a backend -- supporting it if possible. - | backend dflags == ViaC && + | backendUnregisterisedAbiOnly (backend dflags) && not (platformUnregisterised (targetPlatform dflags)) - = case platformDefaultBackend (targetPlatform dflags) of - NCG -> let dflags' = dflags { backend = NCG } - warn = "Target platform doesn't use unregisterised ABI, so using native code generator rather than compiling via C" - in loop dflags' warn - LLVM -> let dflags' = dflags { backend = LLVM } - warn = "Target platform doesn't use unregisterised ABI, so using LLVM rather than compiling via C" - in loop dflags' warn - _ -> pgmError "Compiling via C only supports unregisterised ABI but target platform doesn't use it." - - | gopt Opt_Hpc dflags && backend dflags == Interpreter + = let b = platformDefaultBackend (targetPlatform dflags) + in if backendSwappableWithViaC b then + let dflags' = dflags { backend = b } + warn = "Target platform doesn't use unregisterised ABI, so using " ++ + backendDescription b ++ " rather than " ++ + backendDescription (backend dflags) + in loop dflags' warn + else + pgmError (backendDescription (backend dflags) ++ + " supports only unregisterised ABI but target platform doesn't use it.") + + | gopt Opt_Hpc dflags && not (backendSupportsHpc (backend dflags)) = let dflags' = gopt_unset dflags Opt_Hpc - warn = "Hpc can't be used with byte-code interpreter. Ignoring -fhpc." + warn = "Hpc can't be used with " ++ backendDescription (backend dflags) ++ + ". Ignoring -fhpc." in loop dflags' warn - | backend dflags `elem` [NCG, LLVM] && + | backendSwappableWithViaC (backend dflags) && platformUnregisterised (targetPlatform dflags) - = loop (dflags { backend = ViaC }) + = loop (dflags { backend = viaCBackend }) "Target platform uses unregisterised ABI, so compiling via C" - | backend dflags == NCG && + | backendNeedsPlatformNcgSupport (backend dflags) && not (platformNcgSupported $ targetPlatform dflags) - = let dflags' = dflags { backend = LLVM } + = let dflags' = dflags { backend = llvmBackend } warn = "Native code generator doesn't support target platform, so using LLVM" in loop dflags' warn @@ -4810,15 +4813,17 @@ makeDynFlagsConsistent dflags = loop (gopt_set dflags Opt_PIC) "Enabling -fPIC as it is always on for this platform" - | backend dflags == Interpreter + | backendForcesOptimization0 (backend dflags) , let (dflags', changed) = updOptLevelChanged 0 dflags , changed - = loop dflags' "Optimization flags conflict with --interactive; optimization flags ignored." + = loop dflags' ("Optimization flags are incompatible with the " ++ + backendDescription (backend dflags) ++ + "; optimization flags ignored.") | LinkInMemory <- ghcLink dflags , not (gopt Opt_ExternalInterpreter dflags) , hostIsProfiled - , backendProducesObject (backend dflags) + , backendWritesFiles (backend dflags) , ways dflags `hasNotWay` WayProf = loop dflags{targetWays_ = addWay WayProf (targetWays_ dflags)} "Enabling -prof, because -fobject-code is enabled and GHCi is profiled" |