diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 68c9750555e95fa45b77566e0e511db58969ab50..96b8f810d2624f988a61ad18ba3b753bc577eb1e 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-} - {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} @@ -295,13 +294,13 @@ import Data.Time import System.IO.Unsafe ( unsafeInterleaveIO ) import GHC.Iface.Env ( trace_if ) +import GHC.Platform.Ways import GHC.Stg.InferTags.TagSig (seqTagSig) import GHC.StgToCmm.Utils (IPEStats) import GHC.Types.Unique.FM import GHC.Types.Unique.DFM import GHC.Cmm.Config (CmmConfig) - {- ********************************************************************** %* * Initialisation @@ -990,6 +989,27 @@ initModDetails hsc_env iface = -- in make mode, since this HMI will go into the HPT. genModDetails hsc_env' iface +-- | Modify flags such that objects are compiled for the interpreter's way. +-- This is necessary when building foreign objects for Template Haskell, since +-- those are object code built outside of the pipeline, which means they aren't +-- subject to the mechanism in 'enableCodeGenWhen' that requests dynamic build +-- outputs for dependencies when the interpreter used for TH is dynamic but the +-- main outputs aren't. +-- Furthermore, the HPT only stores one set of objects with different names for +-- bytecode linking in 'HomeModLinkable', so the usual hack for switching +-- between ways in 'get_link_deps' doesn't work. +compile_for_interpreter :: HscEnv -> (HscEnv -> IO a) -> IO a +compile_for_interpreter hsc_env use = + use (hscUpdateFlags update hsc_env) + where + update dflags = dflags { + targetWays_ = adapt_way interpreterDynamic WayDyn $ + adapt_way interpreterProfiled WayProf $ + targetWays_ dflags + } + + adapt_way want = if want (hscInterp hsc_env) then addWay else removeWay + -- | If the 'Linkable' contains Core bindings loaded from an interface, replace -- them with a lazy IO thunk that compiles them to bytecode and foreign objects. -- @@ -2063,9 +2083,10 @@ generateByteCode :: HscEnv -> IO (CompiledByteCode, [FilePath]) generateByteCode hsc_env cgguts mod_location = do (hasStub, comp_bc) <- hscInteractive hsc_env cgguts mod_location - stub_o <- traverse (compileForeign hsc_env LangC) hasStub - foreign_files_o <- traverse (uncurry (compileForeign hsc_env)) (cgi_foreign_files cgguts) - pure (comp_bc, maybeToList stub_o ++ foreign_files_o) + compile_for_interpreter hsc_env $ \ i_env -> do + stub_o <- traverse (compileForeign i_env LangC) hasStub + foreign_files_o <- traverse (uncurry (compileForeign i_env)) (cgi_foreign_files cgguts) + pure (comp_bc, maybeToList stub_o ++ foreign_files_o) generateFreshByteCode :: HscEnv -> ModuleName diff --git a/compiler/GHC/Unit/Module/WholeCoreBindings.hs b/compiler/GHC/Unit/Module/WholeCoreBindings.hs index 2b1f716133d7712fbe34ff87bd797084cec0a33c..5f9058239ceef239c206ebcf75582625f6e38aa5 100644 --- a/compiler/GHC/Unit/Module/WholeCoreBindings.hs +++ b/compiler/GHC/Unit/Module/WholeCoreBindings.hs @@ -190,13 +190,9 @@ Even if that wasn't an issue, they are compiled for the session's 'Way', not its associated module's, so the dynamic variant wouldn't be available when building only static outputs. -For now, this doesn't have much of an impact, since we're only supporting -foreign imports initially, which produce very simple objects that can easily be -handled by the linker when 'GHC.Linker.Loader.dynLoadObjs' creates a shared -library from all object file inputs. -However, for more complex circumstances, we should compile foreign stubs -specially for TH according to the interpreter 'Way', or request dynamic products -for TH dependencies like it happens for the conventional case. +To mitigate this, we instead build foreign objects specially for the +interpreter, updating the build flags in 'compile_for_interpreter' to use the +interpreter's way. Problem 4: