From c85f4928d4dbb2eb2cf906d08bfe7620d6f04ca5 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Mon, 7 Sep 2020 19:48:03 +0200 Subject: Refactor -dynamic-too handling 1) Don't modify DynFlags (too much) for -dynamic-too: now when we generate dynamic outputs for "-dynamic-too", we only set "dynamicNow" boolean field in DynFlags instead of modifying several other fields. These fields now have accessors that take dynamicNow into account. 2) Use DynamicTooState ADT to represent -dynamic-too state. It's much clearer than the undocumented "DynamicTooConditional" that was used before. As a result, we can finally remove the hscs_iface_dflags field in HscRecomp. There was a comment on this field saying: "FIXME (osa): I don't understand why this is necessary, but I spent almost two days trying to figure this out and I couldn't .. perhaps someone who understands this code better will remove this later." I don't fully understand the details, but it was needed because of the changes made to the DynFlags for -dynamic-too. There is still something very dubious in GHC.Iface.Recomp: we have to disable the "dynamicNow" flag at some point for some Backpack's "heinous hack" to continue to work. It may be because interfaces for indefinite units are always non-dynamic, or because we mix and match dynamic and non-dynamic interfaces (#9176), or something else, who knows? --- compiler/GHC/Data/EnumSet.hs | 4 + compiler/GHC/Driver/Backpack.hs | 7 +- compiler/GHC/Driver/Main.hs | 161 ++++++++++++++--------- compiler/GHC/Driver/Make.hs | 8 +- compiler/GHC/Driver/MakeFile.hs | 10 +- compiler/GHC/Driver/Pipeline.hs | 113 ++++++++++------ compiler/GHC/Driver/Session.hs | 258 ++++++++++++++++++++++++------------- compiler/GHC/HsToCore/Usage.hs | 2 +- compiler/GHC/Iface/Load.hs | 49 ++++--- compiler/GHC/Iface/Recomp.hs | 7 +- compiler/GHC/Linker/Dynamic.hs | 2 +- compiler/GHC/Linker/Loader.hs | 4 +- compiler/GHC/Platform/Ways.hs | 5 + compiler/GHC/Tc/Utils/Monad.hs | 13 +- compiler/GHC/Unit/Module/Status.hs | 7 - 15 files changed, 414 insertions(+), 236 deletions(-) (limited to 'compiler/GHC') diff --git a/compiler/GHC/Data/EnumSet.hs b/compiler/GHC/Data/EnumSet.hs index 61d6bf002b..a7949c7e71 100644 --- a/compiler/GHC/Data/EnumSet.hs +++ b/compiler/GHC/Data/EnumSet.hs @@ -8,6 +8,7 @@ module GHC.Data.EnumSet , toList , fromList , empty + , difference ) where import GHC.Prelude @@ -33,3 +34,6 @@ fromList = EnumSet . IntSet.fromList . map fromEnum empty :: EnumSet a empty = EnumSet IntSet.empty + +difference :: EnumSet a -> EnumSet a -> EnumSet a +difference (EnumSet a) (EnumSet b) = EnumSet (IntSet.difference a b) diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index d35e32cc27..d38ba98622 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -204,8 +204,11 @@ withBkpSession cid insts deps session_type do_this = do hiDir = Just (outdir hiDir), stubDir = Just (outdir stubDir), -- Unset output-file for non exe builds - outputFile = if session_type == ExeSession - then outputFile dflags + outputFile_ = if session_type == ExeSession + then outputFile_ dflags + else Nothing, + dynOutputFile_ = if session_type == ExeSession + then dynOutputFile_ dflags else Nothing, -- Clear the import path so we don't accidentally grab anything importPaths = [], diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index c8905210ab..e924826b0c 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fprof-auto-top #-} ------------------------------------------------------------------------------- @@ -866,8 +867,8 @@ finish summary tc_result mb_old_hash = do hscs_mod_location = ms_location summary, hscs_mod_details = details, hscs_partial_iface = partial_iface, - hscs_old_iface_hash = mb_old_hash, - hscs_iface_dflags = dflags } + hscs_old_iface_hash = mb_old_hash + } -- We are not generating code, so we can skip simplification -- and generate a simple interface. @@ -875,7 +876,7 @@ finish summary tc_result mb_old_hash = do (iface, mb_old_iface_hash, details) <- liftIO $ hscSimpleIface hsc_env tc_result mb_old_hash - liftIO $ hscMaybeWriteIface dflags iface mb_old_iface_hash (ms_location summary) + liftIO $ hscMaybeWriteIface dflags True iface mb_old_iface_hash (ms_location summary) return $ case bcknd of NoBackend -> HscNotGeneratingCode iface details @@ -888,27 +889,110 @@ finish summary tc_result mb_old_hash = do Note [Writing interface files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We write interface files in GHC.Driver.Main and GHC.Driver.Pipeline using -hscMaybeWriteIface, but only once per compilation (twice with dynamic-too). +We write one interface file per module and per compilation, except with +-dynamic-too where we write two interface files (non-dynamic and dynamic). + +We can write two kinds of interfaces (see Note [Interface file stages] in +"GHC.Driver.Types"): + + * simple interface: interface generated after the core pipeline + + * full interface: simple interface completed with information from the + backend + +Depending on the situation, we write one or the other (using +`hscMaybeWriteIface`). We must be careful with `-dynamic-too` because only the +backend is run twice, so if we write a simple interface we need to write both +the non-dynamic and the dynamic interfaces at the same time (with the same +contents). + +Cases for which we generate simple interfaces: + + * GHC.Driver.Main.finish: 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 + bytecode (if interface writing is forced). + + * GHC.Driver.Backpack uses simple interfaces for indefinite units + (units with module holes). It writes them indirectly by forcing the + -fwrite-interface flag while setting backend to NoBackend. + +Cases for which we generate full interfaces: + + * GHC.Driver.Pipeline.runPhase: when we must be compiling to regular hard + code and/or require recompilation. + +By default interface file names are derived from module file names by adding +suffixes. The interface file name can be overloaded with "-ohi", except when +`-dynamic-too` is used. -* If a compilation does NOT require (re)compilation of the hard code we call - hscMaybeWriteIface inside GHC.Driver.Main:finish. -* If we run in One Shot mode and target bytecode we write it in compileOne' -* Otherwise we must be compiling to regular hard code and require recompilation. - In this case we create the interface file inside RunPhase using the interface - generator contained inside the HscRecomp status. -} -hscMaybeWriteIface :: DynFlags -> ModIface -> Maybe Fingerprint -> ModLocation -> IO () -hscMaybeWriteIface dflags iface old_iface location = do + +-- | Write interface files +hscMaybeWriteIface :: DynFlags -> Bool -> ModIface -> Maybe Fingerprint -> ModLocation -> IO () +hscMaybeWriteIface 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 - no_change = old_iface == Just (mi_iface_hash (mi_final_exts iface)) - when (write_interface || force_write_interface) $ - hscWriteIface dflags iface no_change location + -- mod_location only contains the base name, so we rebuild the + -- correct file extension from the dynflags. + baseName = ml_hi_file mod_location + buildIfName suffix + | Just name <- outputHi dflags + = name + | otherwise + = let with_hi = replaceExtension baseName suffix + in addBootSuffix_maybe (mi_boot iface) with_hi + + write_iface dflags' iface = + {-# SCC "writeIface" #-} + writeIface dflags' (buildIfName (hiSuf dflags')) iface + + when (write_interface || force_write_interface) $ do + + -- FIXME: with -dynamic-too, "no_change" is only meaningful for the + -- non-dynamic interface, not for the dynamic one. We should have another + -- flag for the dynamic interface. In the meantime: + -- + -- * when we write a single full interface, we check if we are + -- currently writing the dynamic interface due to -dynamic-too, in + -- which case we ignore "no_change". + -- + -- * when we write two simple interfaces at once because of + -- dynamic-too, we use "no_change" both for the non-dynamic and the + -- dynamic interfaces. Hopefully both the dynamic and the non-dynamic + -- interfaces stay in sync... + -- + let no_change = old_iface == Just (mi_iface_hash (mi_final_exts iface)) + + dt <- dynamicTooState dflags + + when (dopt Opt_D_dump_if_trace dflags) $ putMsg dflags $ + hang (text "Writing interface(s):") 2 $ vcat + [ text "Kind:" <+> if is_simple then text "simple" else text "full" + , text "Hash change:" <+> ppr (not no_change) + , text "DynamicToo state:" <+> text (show dt) + ] + + if is_simple + then unless no_change $ do -- FIXME: see no_change' comment above + write_iface dflags iface + case dt of + DT_Dont -> return () + DT_Failed -> return () + DT_Dyn -> panic "Unexpected DT_Dyn state when writing simple interface" + DT_OK -> write_iface (setDynamicNow dflags) iface + else case dt of + DT_Dont | not no_change -> write_iface dflags iface + DT_OK | not no_change -> write_iface dflags iface + -- FIXME: see no_change' comment above + DT_Dyn -> write_iface dflags iface + DT_Failed | not (dynamicNow dflags) -> write_iface dflags iface + _ -> return () -------------------------------------------------------------- -- NoRecomp handlers @@ -1384,51 +1468,6 @@ hscSimpleIface' tc_result mb_old_iface = do -------------------------------------------------------------- -- BackEnd combinators -------------------------------------------------------------- -{- -Note [Interface filename extensions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -ModLocation only contains the base names, however when generating dynamic files -the actual extension might differ from the default. - -So we only load the base name from ModLocation and replace the actual extension -according to the information in DynFlags. - -If we generate a interface file right after running the core pipeline we will -have set -dynamic-too and potentially generate both interface files at the same -time. - -If we generate a interface file after running the backend then dynamic-too won't -be set, however then the extension will be contained in the dynflags instead so -things still work out fine. --} - -hscWriteIface :: DynFlags -> ModIface -> Bool -> ModLocation -> IO () -hscWriteIface dflags iface no_change mod_location = do - -- mod_location only contains the base name, so we rebuild the - -- correct file extension from the dynflags. - let ifaceBaseFile = ml_hi_file mod_location - unless no_change $ - let ifaceFile = buildIfName ifaceBaseFile (hiSuf dflags) - in {-# SCC "writeIface" #-} - writeIface dflags ifaceFile iface - whenGeneratingDynamicToo dflags $ do - -- TODO: We should do a no_change check for the dynamic - -- interface file too - -- When we generate iface files after core - let dynDflags = dynamicTooMkDynamicDynFlags dflags - -- dynDflags will have set hiSuf correctly. - dynIfaceFile = buildIfName ifaceBaseFile (hiSuf dynDflags) - - writeIface dynDflags dynIfaceFile iface - where - buildIfName :: String -> String -> String - buildIfName baseName suffix - | Just name <- outputHi dflags - = name - | otherwise - = let with_hi = replaceExtension baseName suffix - in addBootSuffix_maybe (mi_boot iface) with_hi -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 53ae5897ed..06f5014684 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -712,9 +712,9 @@ guessOutputFile = modifySession $ \env -> "must specify -o explicitly" else Just name' in - case outputFile dflags of + case outputFile_ dflags of Just _ -> env - Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } } + Nothing -> env { hsc_dflags = dflags { outputFile_ = name_exe } } -- ----------------------------------------------------------------------------- -- @@ -2300,8 +2300,8 @@ enableCodeGenWhen condition should_modify staticLife dynLife bcknd nodemap = -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags then return (ml_hi_file ms_location, ml_obj_file ms_location) - else (,) <$> (new_temp_file (hiSuf dflags) (dynHiSuf dflags)) - <*> (new_temp_file (objectSuf dflags) (dynObjectSuf dflags)) + else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) + <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) return $ ms { ms_location = diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs index 81408ab7c9..c8c4c07d0d 100644 --- a/compiler/GHC/Driver/MakeFile.hs +++ b/compiler/GHC/Driver/MakeFile.hs @@ -67,11 +67,11 @@ doMkDependHS srcs = do -- We therefore do the initial dependency generation with an empty -- way and .o/.hi extensions, regardless of any flags that might -- be specified. - let dflags = dflags0 { - ways = Set.empty, - hiSuf = "hi", - objectSuf = "o" - } + let dflags = dflags0 + { targetWays_ = Set.empty + , hiSuf_ = "hi" + , objectSuf_ = "o" + } GHC.setSessionDynFlags dflags when (null (depSuffixes dflags)) $ liftIO $ diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index d8abadc0e5..c65c54ab12 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -258,12 +259,12 @@ compileOne' m_tc_result mHscMessage hscs_mod_location = mod_location, hscs_mod_details = hmi_details, hscs_partial_iface = partial_iface, - hscs_old_iface_hash = mb_old_iface_hash, - hscs_iface_dflags = iface_dflags }, Interpreter) -> do + 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'{hsc_dflags=iface_dflags} partial_iface Nothing - liftIO $ hscMaybeWriteIface dflags final_iface mb_old_iface_hash (ms_location summary) + final_iface <- mkFullIface hsc_env' partial_iface Nothing + liftIO $ hscMaybeWriteIface dflags True final_iface mb_old_iface_hash (ms_location summary) (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env' cgguts mod_location @@ -773,20 +774,41 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) r <- runPipeline' start_phase hsc_env env input_fn' maybe_loc foreign_os - -- If we are compiling a Haskell module, and doing - -- -dynamic-too, but couldn't do the -dynamic-too fast - -- path, then rerun the pipeline for the dyn way let dflags = hsc_dflags hsc_env - -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987) - when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $ - when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do - debugTraceMsg dflags 4 - (text "Running the pipeline again for -dynamic-too") - let dflags' = dynamicTooMkDynamicDynFlags dflags - hsc_env' <- newHscEnv dflags' - _ <- runPipeline' start_phase hsc_env' env input_fn' - maybe_loc foreign_os - return () + when isHaskellishFile $ + dynamicTooState dflags >>= \case + DT_Dont -> return () + DT_Dyn -> return () + DT_OK -> return () + -- If we are compiling a Haskell module with -dynamic-too, we + -- first try the "fast path": that is we compile the non-dynamic + -- version and at the same time we check that interfaces depended + -- on exist both for the non-dynamic AND the dynamic way. We also + -- check that they have the same hash. + -- If they don't, dynamicTooState is set to DT_Failed. + -- See GHC.Iface.Load.checkBuildDynamicToo + -- If they do, in the end we produce both the non-dynamic and + -- dynamic outputs. + -- + -- If this "fast path" failed, we execute the whole pipeline + -- again, this time for the dynamic way *only*. To do that we + -- just set the dynamicNow bit from the start to ensure that the + -- dynamic DynFlags fields are used and we disable -dynamic-too + -- (its state is already set to DT_Failed so it wouldn't do much + -- anyway). + DT_Failed + -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987) + | OSMinGW32 <- platformOS (targetPlatform dflags) -> return () + | otherwise -> do + debugTraceMsg dflags 4 + (text "Running the full pipeline again for -dynamic-too") + let dflags' = flip gopt_unset Opt_BuildDynamicToo + $ setDynamicNow + $ dflags + hsc_env' <- newHscEnv dflags' + _ <- runPipeline' start_phase hsc_env' env input_fn' + maybe_loc foreign_os + return () return r runPipeline' @@ -850,23 +872,40 @@ pipeLoop phase input_fn = do _ -> do liftIO $ debugTraceMsg dflags 4 (text "Running phase" <+> ppr phase) - (next_phase, output_fn) <- runHookedPhase phase input_fn dflags + case phase of HscOut {} -> do - -- We don't pass Opt_BuildDynamicToo to the backend - -- in DynFlags. - -- Instead it's run twice with flags accordingly set - -- per run. - let noDynToo = pipeLoop next_phase output_fn + let noDynToo = do + (next_phase, output_fn) <- runHookedPhase phase input_fn dflags + pipeLoop next_phase output_fn let dynToo = do - setDynFlags $ gopt_unset dflags Opt_BuildDynamicToo - r <- pipeLoop next_phase output_fn - setDynFlags $ dynamicTooMkDynamicDynFlags dflags - -- TODO shouldn't ignore result: - _ <- pipeLoop phase input_fn - return r - ifGeneratingDynamicToo dflags dynToo noDynToo - _ -> pipeLoop next_phase output_fn + -- if Opt_BuildDynamicToo is set and if the platform + -- supports it, we first run the backend to generate + -- the dynamic objects and then re-run it to generate + -- the non-dynamic ones. + let dflags' = setDynamicNow dflags -- set "dynamicNow" + setDynFlags dflags' + (next_phase, output_fn) <- runHookedPhase phase input_fn dflags' + _ <- pipeLoop next_phase output_fn + -- TODO: we probably shouldn't ignore the result of + -- the dynamic compilation + setDynFlags dflags -- restore flags without "dynamicNow" set + noDynToo + dynamicTooState dflags >>= \case + DT_Dont -> noDynToo + DT_Failed -> noDynToo + DT_OK -> dynToo + DT_Dyn -> noDynToo + -- it shouldn't be possible to be in this last case + -- here. It would mean that we executed the whole + -- pipeline with DynamicNow and Opt_BuildDynamicToo set. + -- + -- When we restart the whole pipeline for -dynamic-too + -- we set DynamicNow but we unset Opt_BuildDynamicToo so + -- it's weird. + _ -> do + (next_phase, output_fn) <- runHookedPhase phase input_fn dflags + pipeLoop next_phase output_fn runHookedPhase :: PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath) @@ -1264,8 +1303,8 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do hscs_mod_location = mod_location, hscs_mod_details = mod_details, hscs_partial_iface = partial_iface, - hscs_old_iface_hash = mb_old_iface_hash, - hscs_iface_dflags = iface_dflags } + hscs_old_iface_hash = mb_old_iface_hash + } -> do output_fn <- phaseOutputFilename next_phase PipeState{hsc_env=hsc_env'} <- getPipeState @@ -1273,17 +1312,17 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do (outputFilename, mStub, foreign_files, cg_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just cg_infos)) + let dflags = hsc_dflags hsc_env' + final_iface <- liftIO (mkFullIface hsc_env' partial_iface (Just cg_infos)) let final_mod_details - | gopt Opt_OmitInterfacePragmas iface_dflags + | gopt Opt_OmitInterfacePragmas dflags = mod_details | otherwise = {-# SCC updateModDetailsIdInfos #-} updateModDetailsIdInfos cg_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] - let if_dflags = dflags `gopt_unset` Opt_BuildDynamicToo - liftIO $ hscMaybeWriteIface if_dflags final_iface mb_old_iface_hash mod_location + liftIO $ hscMaybeWriteIface dflags False final_iface mb_old_iface_hash mod_location stub_o <- liftIO (mapM (compileStub hsc_env') mStub) foreign_os <- liftIO $ diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 2000b9760b..9529b0dea8 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -36,12 +36,11 @@ module GHC.Driver.Session ( xopt, xopt_set, xopt_unset, xopt_set_unlessExplSpec, lang_set, - whenGeneratingDynamicToo, ifGeneratingDynamicToo, - whenCannotGenerateDynamicToo, - dynamicTooMkDynamicDynFlags, + DynamicTooState(..), dynamicTooState, setDynamicNow, setDynamicTooFailed, dynamicOutputFile, sccProfilingEnabled, DynFlags(..), mainModIs, + outputFile, hiSuf, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), RtsOptsEnabled(..), @@ -60,8 +59,9 @@ module GHC.Driver.Session ( positionIndependent, optimisationFlags, setFlagsFromEnvFile, + pprDynFlagsDiff, - addWay', targetProfile, + targetProfile, mkHomeUnitFromFlags, @@ -502,7 +502,7 @@ data DynFlags = DynFlags { homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations -- ways - ways :: Ways, -- ^ Way flags from the command line + targetWays_ :: Ways, -- ^ Target way flags from the command line -- For object splitting splitInfo :: Maybe (String,Int), @@ -515,20 +515,25 @@ data DynFlags = DynFlags { stubDir :: Maybe String, dumpDir :: Maybe String, - objectSuf :: String, + objectSuf_ :: String, hcSuf :: String, - hiSuf :: String, + hiSuf_ :: String, hieSuf :: String, - canGenerateDynamicToo :: IORef Bool, - dynObjectSuf :: String, - dynHiSuf :: String, + dynamicTooFailed :: IORef Bool, + dynObjectSuf_ :: String, + dynHiSuf_ :: String, - outputFile :: Maybe String, - dynOutputFile :: Maybe String, + outputFile_ :: Maybe String, + dynOutputFile_ :: Maybe String, outputHi :: Maybe String, dynLibLoader :: DynLibLoader, + dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output + -- because of -dynamic-too. This predicate is + -- used to query the appropriate fields + -- (outputFile/dynOutputFile, ways, etc.) + -- | This is set by 'GHC.Driver.Pipeline.runPipeline' based on where -- its output is going. dumpPrefix :: Maybe FilePath, @@ -1034,45 +1039,65 @@ data RtsOptsEnabled positionIndependent :: DynFlags -> Bool positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags -whenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m () -whenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ()) - -ifGeneratingDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a -ifGeneratingDynamicToo dflags f g = generateDynamicTooConditional dflags f g g - -whenCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m () -> m () -whenCannotGenerateDynamicToo dflags f - = ifCannotGenerateDynamicToo dflags f (return ()) - -ifCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a -ifCannotGenerateDynamicToo dflags f g - = generateDynamicTooConditional dflags g f g - -generateDynamicTooConditional :: MonadIO m - => DynFlags -> m a -> m a -> m a -> m a -generateDynamicTooConditional dflags canGen cannotGen notTryingToGen - = if gopt Opt_BuildDynamicToo dflags - then do let ref = canGenerateDynamicToo dflags - b <- liftIO $ readIORef ref - if b then canGen else cannotGen - else notTryingToGen - -dynamicTooMkDynamicDynFlags :: DynFlags -> DynFlags -dynamicTooMkDynamicDynFlags dflags0 - = let dflags1 = addWay' WayDyn dflags0 - dflags2 = dflags1 { - outputFile = dynOutputFile dflags1, - hiSuf = dynHiSuf dflags1, - objectSuf = dynObjectSuf dflags1 - } - dflags3 = gopt_unset dflags2 Opt_BuildDynamicToo - in dflags3 +-- Note [-dynamic-too business] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- With -dynamic-too flag, we try to build both the non-dynamic and dynamic +-- objects in a single run of the compiler: the pipeline is the same down to +-- Core optimisation, then the backend (from Core to object code) is executed +-- twice. +-- +-- The implementation is currently rather hacky: recompilation avoidance is +-- broken (#17968), we don't clearly separate non-dynamic and dynamic loaded +-- interfaces (#9176), etc. +-- +-- To make matters worse, we automatically enable -dynamic-too when some modules +-- need Template-Haskell and GHC is dynamically linked (cf +-- GHC.Driver.Pipeline.compileOne'). +-- +-- This somewhat explains why we have "dynamicTooFailed :: IORef Bool" in +-- DynFlags: when -dynamic-too is enabled, we try to build the dynamic objects, +-- but we may fail and we shouldn't abort the whole compilation because the user +-- may not even have asked for -dynamic-too in the first place. So instead we +-- use this global variable to indicate that we can't build dynamic objects and +-- compilation continues to build non-dynamic objects only. At the end of the +-- non-dynamic pipeline, if this value indicates that the dynamic compilation +-- failed, we run the whole pipeline again for the dynamic way (except on +-- Windows...). See GHC.Driver.Pipeline.runPipeline. + +data DynamicTooState + = DT_Dont -- ^ Don't try to build dynamic objects too + | DT_Failed -- ^ Won't try to generate dynamic objects for some reason + | DT_OK -- ^ Will still try to generate dynamic objects + | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) + deriving (Eq,Show,Ord) + +dynamicTooState :: MonadIO m => DynFlags -> m DynamicTooState +dynamicTooState dflags + | not (gopt Opt_BuildDynamicToo dflags) = return DT_Dont + | otherwise = do + failed <- liftIO $ readIORef (dynamicTooFailed dflags) + if failed + then return DT_Failed + else if dynamicNow dflags + then return DT_Dyn + else return DT_OK + +setDynamicNow :: DynFlags -> DynFlags +setDynamicNow dflags0 = + dflags0 + { dynamicNow = True + } + +setDynamicTooFailed :: MonadIO m => DynFlags -> m () +setDynamicTooFailed dflags = + liftIO $ writeIORef (dynamicTooFailed dflags) True -- | Compute the path of the dynamic object corresponding to an object file. dynamicOutputFile :: DynFlags -> FilePath -> FilePath dynamicOutputFile dflags outputFile = dynOut outputFile where - dynOut = flip addExtension (dynObjectSuf dflags) . dropExtension + dynOut = flip addExtension (dynObjectSuf_ dflags) . dropExtension ----------------------------------------------------------------------------- @@ -1084,7 +1109,7 @@ initDynFlags dflags = do -- building dynamically or not. platformCanGenerateDynamicToo = platformOS (targetPlatform dflags) /= OSMinGW32 - refCanGenerateDynamicToo <- newIORef platformCanGenerateDynamicToo + refDynamicTooFailed <- newIORef (not platformCanGenerateDynamicToo) refNextTempSuffix <- newIORef 0 refFilesToClean <- newIORef emptyFilesToClean refDirsToClean <- newIORef Map.empty @@ -1108,7 +1133,7 @@ initDynFlags dflags = do (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) (useColor dflags, colScheme dflags) return dflags{ - canGenerateDynamicToo = refCanGenerateDynamicToo, + dynamicTooFailed = refDynamicTooFailed, nextTempSuffix = refNextTempSuffix, filesToClean = refFilesToClean, dirsToClean = refDirsToClean, @@ -1181,14 +1206,15 @@ defaultDynFlags mySettings llvmConfig = stubDir = Nothing, dumpDir = Nothing, - objectSuf = phaseInputExt StopLn, + objectSuf_ = phaseInputExt StopLn, hcSuf = phaseInputExt HCc, - hiSuf = "hi", + hiSuf_ = "hi", hieSuf = "hie", - canGenerateDynamicToo = panic "defaultDynFlags: No canGenerateDynamicToo", - dynObjectSuf = "dyn_" ++ phaseInputExt StopLn, - dynHiSuf = "dyn_hi", + dynamicTooFailed = panic "defaultDynFlags: No dynamicTooFailed", + dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, + dynHiSuf_ = "dyn_hi", + dynamicNow = False, pluginModNames = [], pluginModNameOpts = [], @@ -1197,8 +1223,8 @@ defaultDynFlags mySettings llvmConfig = staticPlugins = [], hooks = emptyHooks, - outputFile = Nothing, - dynOutputFile = Nothing, + outputFile_ = Nothing, + dynOutputFile_ = Nothing, outputHi = Nothing, dynLibLoader = SystemDependent, dumpPrefix = Nothing, @@ -1222,7 +1248,7 @@ defaultDynFlags mySettings llvmConfig = packageEnv = Nothing, unitDatabases = Nothing, unitState = emptyUnitState, - ways = defaultWays mySettings, + targetWays_ = defaultWays mySettings, splitInfo = Nothing, ghcNameVersion = sGhcNameVersion mySettings, @@ -1567,8 +1593,19 @@ dopt_unset :: DynFlags -> DumpFlag -> DynFlags dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } -- | Test whether a 'GeneralFlag' is set +-- +-- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) +-- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables +-- Opt_SplitSections. +-- gopt :: GeneralFlag -> DynFlags -> Bool -gopt f dflags = f `EnumSet.member` generalFlags dflags +gopt Opt_PIC dflags + | dynamicNow dflags = True +gopt Opt_ExternalDynamicRefs dflags + | dynamicNow dflags = True +gopt Opt_SplitSections dflags + | dynamicNow dflags = False +gopt f dflags = f `EnumSet.member` generalFlags dflags -- | Set a 'GeneralFlag' gopt_set :: DynFlags -> GeneralFlag -> DynFlags @@ -1777,16 +1814,16 @@ setOutputDir f = setObjectDir f . setDumpDir f setDylibInstallName f d = d { dylibInstallName = Just f} -setObjectSuf f d = d { objectSuf = f} -setDynObjectSuf f d = d { dynObjectSuf = f} -setHiSuf f d = d { hiSuf = f} -setHieSuf f d = d { hieSuf = f} -setDynHiSuf f d = d { dynHiSuf = f} -setHcSuf f d = d { hcSuf = f} +setObjectSuf f d = d { objectSuf_ = f} +setDynObjectSuf f d = d { dynObjectSuf_ = f} +setHiSuf f d = d { hiSuf_ = f} +setHieSuf f d = d { hieSuf = f} +setDynHiSuf f d = d { dynHiSuf_ = f} +setHcSuf f d = d { hcSuf = f} -setOutputFile f d = d { outputFile = f} -setDynOutputFile f d = d { dynOutputFile = f} -setOutputHi f d = d { outputHi = f} +setOutputFile f d = d { outputFile_ = f} +setDynOutputFile f d = d { dynOutputFile_ = f} +setOutputHi f d = d { outputHi = f} setJsonLogAction :: DynFlags -> DynFlags setJsonLogAction d = d { log_action = jsonLogAction } @@ -1975,15 +2012,12 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do throwGhcExceptionIO (CmdLineError ("combination not supported: " ++ intercalate "/" (map wayDesc (Set.toAscList theWays)))) - let chooseOutput - | isJust (outputFile dflags2) -- Only iff user specified -o ... - , not (isJust (dynOutputFile dflags2)) -- but not -dyno - = return $ dflags2 { dynOutputFile = Just $ dynamicOutputFile dflags2 outFile } + let dflags3 + | Just outFile <- outputFile_ dflags2 -- Only iff user specified -o ... + , not (isJust (dynOutputFile_ dflags2)) -- but not -dyno + = dflags2 { dynOutputFile_ = Just $ dynamicOutputFile dflags2 outFile } | otherwise - = return dflags2 - where - outFile = fromJust $ outputFile dflags2 - dflags3 <- ifGeneratingDynamicToo dflags2 chooseOutput (return dflags2) + = dflags2 let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3 @@ -2158,20 +2192,20 @@ dynamic_flags_deps = [ d { enableTimeStats = True }))) ------- ways --------------------------------------------------------------- - , make_ord_flag defGhcFlag "prof" (NoArg (addWay WayProf)) - , make_ord_flag defGhcFlag "eventlog" (NoArg (addWay WayTracing)) - , make_ord_flag defGhcFlag "debug" (NoArg (addWay WayDebug)) - , make_ord_flag defGhcFlag "threaded" (NoArg (addWay WayThreaded)) + , make_ord_flag defGhcFlag "prof" (NoArg (addWayDynP WayProf)) + , make_ord_flag defGhcFlag "eventlog" (NoArg (addWayDynP WayTracing)) + , make_ord_flag defGhcFlag "debug" (NoArg (addWayDynP WayDebug)) + , make_ord_flag defGhcFlag "threaded" (NoArg (addWayDynP WayThreaded)) , make_ord_flag defGhcFlag "ticky" - (NoArg (setGeneralFlag Opt_Ticky >> addWay WayDebug)) + (NoArg (setGeneralFlag Opt_Ticky >> addWayDynP WayDebug)) -- -ticky enables ticky-ticky code generation, and also implies -debug which -- is required to get the RTS ticky support. ----- Linker -------------------------------------------------------- , make_ord_flag defGhcFlag "static" (NoArg removeWayDyn) - , make_ord_flag defGhcFlag "dynamic" (NoArg (addWay WayDyn)) + , make_ord_flag defGhcFlag "dynamic" (NoArg (addWayDynP WayDyn)) , make_ord_flag defGhcFlag "rdynamic" $ noArg $ #if defined(linux_HOST_OS) addOptl "-rdynamic" @@ -4258,20 +4292,21 @@ setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags) setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) -------------------------- -addWay :: Way -> DynP () -addWay w = upd (addWay' w) +addWayDynP :: Way -> DynP () +addWayDynP = upd . addWay' addWay' :: Way -> DynFlags -> DynFlags -addWay' w dflags0 = let platform = targetPlatform dflags0 - dflags1 = dflags0 { ways = Set.insert w (ways dflags0) } - dflags2 = foldr setGeneralFlag' dflags1 - (wayGeneralFlags platform w) - dflags3 = foldr unSetGeneralFlag' dflags2 - (wayUnsetGeneralFlags platform w) - in dflags3 +addWay' w dflags0 = + let platform = targetPlatform dflags0 + dflags1 = dflags0 { targetWays_ = addWay w (targetWays_ dflags0) } + dflags2 = foldr setGeneralFlag' dflags1 + (wayGeneralFlags platform w) + dflags3 = foldr unSetGeneralFlag' dflags2 + (wayUnsetGeneralFlags platform w) + in dflags3 removeWayDyn :: DynP () -removeWayDyn = upd (\dfs -> dfs { ways = Set.filter (WayDyn /=) (ways dfs) }) +removeWayDyn = upd (\dfs -> dfs { targetWays_ = Set.filter (WayDyn /=) (targetWays_ dfs) }) -------------------------- setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP () @@ -4866,7 +4901,7 @@ makeDynFlagsConsistent dflags , hostIsProfiled , backendProducesObject (backend dflags) , WayProf `Set.notMember` ways dflags - = loop dflags{ways = Set.insert WayProf (ways dflags)} + = loop dflags{targetWays_ = addWay WayProf (targetWays_ dflags)} "Enabling -prof, because -fobject-code is enabled and GHCi is profiled" | otherwise = (dflags, []) @@ -5059,3 +5094,44 @@ initSDocContext dflags style = SDC -- | Initialize the pretty-printing options using the default user style initDefaultSDocContext :: DynFlags -> SDocContext initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle + +outputFile :: DynFlags -> Maybe String +outputFile dflags + | dynamicNow dflags = dynOutputFile_ dflags + | otherwise = outputFile_ dflags + +hiSuf :: DynFlags -> String +hiSuf dflags + | dynamicNow dflags = dynHiSuf_ dflags + | otherwise = hiSuf_ dflags + +objectSuf :: DynFlags -> String +objectSuf dflags + | dynamicNow dflags = dynObjectSuf_ dflags + | otherwise = objectSuf_ dflags + +ways :: DynFlags -> Ways +ways dflags + | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) + | otherwise = targetWays_ dflags + +-- | Pretty-print the difference between 2 DynFlags. +-- +-- For now only their general flags but it could be extended. +-- Useful mostly for debugging. +pprDynFlagsDiff :: DynFlags -> DynFlags -> SDoc +pprDynFlagsDiff d1 d2 = + let gf_removed = EnumSet.difference (generalFlags d1) (generalFlags d2) + gf_added = EnumSet.difference (generalFlags d2) (generalFlags d1) + ext_removed = EnumSet.difference (extensionFlags d1) (extensionFlags d2) + ext_added = EnumSet.difference (extensionFlags d2) (extensionFlags d1) + in vcat + [ text "Added general flags:" + , text $ show $ EnumSet.toList $ gf_added + , text "Removed general flags:" + , text $ show $ EnumSet.toList $ gf_removed + , text "Added extension flags:" + , text $ show $ EnumSet.toList $ ext_added + , text "Removed extension flags:" + , text $ show $ EnumSet.toList $ ext_removed + ] diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs index 2c49aea43b..bfab4bd661 100644 --- a/compiler/GHC/HsToCore/Usage.hs +++ b/compiler/GHC/HsToCore/Usage.hs @@ -199,7 +199,7 @@ mkPluginUsage hsc_env pluginModule if useDyn then libLocs else - let dflags' = addWay' WayDyn dflags + let dflags' = dflags { targetWays_ = addWay WayDyn (targetWays_ dflags) } dlibLocs = [ searchPath platformHsSOName platform dlibLoc | searchPath <- searchPaths , dlibLoc <- packageHsLibs dflags' pkg diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 55c3b0ce2a..308119327c 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -6,6 +6,8 @@ {-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} + {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Loading interface files @@ -103,7 +105,6 @@ import GHC.Data.FastString import Control.Monad import Control.Exception -import Data.IORef import Data.Map ( toList ) import System.FilePath import System.Directory @@ -875,27 +876,35 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file Failed err -> return (Failed (badIfaceFile file_path err)) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... + + -- Indefinite interfaces are ALWAYS non-dynamic. + checkBuildDynamicToo (Succeeded (iface, _filePath)) + | not (moduleIsDefinite (mi_module iface)) = return () + checkBuildDynamicToo (Succeeded (iface, filePath)) = do + let load_dynamic = do + dflags <- getDynFlags + let dynFilePath = addBootSuffix_maybe hi_boot_file + $ replaceExtension filePath (hiSuf dflags) + r <- read_file dynFilePath + case r of + Succeeded (dynIface, _) + | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface) -> + return () + | otherwise -> + do traceIf (text "Dynamic hash doesn't match") + setDynamicTooFailed dflags + Failed err -> + do traceIf (text "Failed to load dynamic interface file:" $$ err) + setDynamicTooFailed dflags + dflags <- getDynFlags - -- Indefinite interfaces are ALWAYS non-dynamic, and - -- that's OK. - let is_definite_iface = moduleIsDefinite (mi_module iface) - when is_definite_iface $ - whenGeneratingDynamicToo dflags $ withDoDynamicToo $ do - let ref = canGenerateDynamicToo dflags - dynFilePath = addBootSuffix_maybe hi_boot_file - $ replaceExtension filePath (dynHiSuf dflags) - r <- read_file dynFilePath - case r of - Succeeded (dynIface, _) - | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface) -> - return () - | otherwise -> - do traceIf (text "Dynamic hash doesn't match") - liftIO $ writeIORef ref False - Failed err -> - do traceIf (text "Failed to load dynamic interface file:" $$ err) - liftIO $ writeIORef ref False + dynamicTooState dflags >>= \case + DT_Dont -> return () + DT_Failed -> return () + DT_Dyn -> load_dynamic + DT_OK -> withDynamicNow load_dynamic + checkBuildDynamicToo _ = return () -- | Write interface file diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index a21b6dac07..752844054d 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -1384,7 +1384,12 @@ mkHashFun hsc_env eps name -- so there's no guarantee everything is loaded. -- Kind of a heinous hack. initIfaceLoad hsc_env . withException - $ loadInterface (text "lookupVers2") mod ImportBySystem + $ withoutDynamicNow + -- For some unknown reason, we need to reset the + -- dynamicNow bit, otherwise only dynamic + -- interfaces are looked up and some tests fail + -- (e.g. T16219). + $ loadInterface (text "lookupVers2") mod ImportBySystem return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse` pprPanic "lookupVers1" (ppr mod <+> ppr occ)) diff --git a/compiler/GHC/Linker/Dynamic.hs b/compiler/GHC/Linker/Dynamic.hs index 745758f3e5..e1e669ed0d 100644 --- a/compiler/GHC/Linker/Dynamic.hs +++ b/compiler/GHC/Linker/Dynamic.hs @@ -40,7 +40,7 @@ linkDynLib dflags0 o_files dep_packages -- with the same RTS flags that we link GHC with. dflags | OSMinGW32 <- os , hostWays `hasWay` WayDyn - = dflags0 { ways = hostWays } + = dflags0 { targetWays_ = hostWays } | otherwise = dflags0 diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs index d040fe71e5..28e74aa2d9 100644 --- a/compiler/GHC/Linker/Loader.hs +++ b/compiler/GHC/Linker/Loader.hs @@ -956,8 +956,8 @@ dynLoadObjs hsc_env pls@LoaderState{..} objs = do -- Even if we're e.g. profiling, we still want -- the vanilla dynamic libraries, so we set the -- ways / build tag to be just WayDyn. - ways = Set.singleton WayDyn, - outputFile = Just soFile + targetWays_ = Set.singleton WayDyn, + outputFile_ = Just soFile } -- link all "loaded packages" so symbols in those can be resolved -- Note: We are loading packages with local scope, so to see the diff --git a/compiler/GHC/Platform/Ways.hs b/compiler/GHC/Platform/Ways.hs index 9d01ffe878..3759df0021 100644 --- a/compiler/GHC/Platform/Ways.hs +++ b/compiler/GHC/Platform/Ways.hs @@ -24,6 +24,7 @@ module GHC.Platform.Ways ( Way(..) , Ways , hasWay + , addWay , allowed_combination , wayGeneralFlags , wayUnsetGeneralFlags @@ -77,6 +78,10 @@ type Ways = Set Way hasWay :: Ways -> Way -> Bool hasWay ws w = Set.member w ws +-- | Add a way +addWay :: Way -> Ways -> Ways +addWay = Set.insert + -- | Check if a combination of ways is allowed allowed_combination :: Ways -> Bool allowed_combination ways = not disallowed diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index de3c4aeb01..6b66c32ccc 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -28,7 +28,7 @@ module GHC.Tc.Utils.Monad( whenDOptM, whenGOptM, whenWOptM, whenXOptM, unlessXOptM, getGhcMode, - withDoDynamicToo, + withDynamicNow, withoutDynamicNow, getEpsVar, getEps, updateEps, updateEps_, @@ -546,10 +546,15 @@ unlessXOptM flag thing_inside = do b <- xoptM flag getGhcMode :: TcRnIf gbl lcl GhcMode getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) } -withDoDynamicToo :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a -withDoDynamicToo = +withDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a +withDynamicNow = updTopEnv (\top@(HscEnv { hsc_dflags = dflags }) -> - top { hsc_dflags = dynamicTooMkDynamicDynFlags dflags }) + top { hsc_dflags = setDynamicNow dflags }) + +withoutDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a +withoutDynamicNow = + updTopEnv (\top@(HscEnv { hsc_dflags = dflags }) -> + top { hsc_dflags = dflags { dynamicNow = False} }) getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState) getEpsVar = do { env <- getTopEnv; return (hsc_EPS env) } diff --git a/compiler/GHC/Unit/Module/Status.hs b/compiler/GHC/Unit/Module/Status.hs index d7fb83e582..539158fdb1 100644 --- a/compiler/GHC/Unit/Module/Status.hs +++ b/compiler/GHC/Unit/Module/Status.hs @@ -5,8 +5,6 @@ where import GHC.Prelude -import GHC.Driver.Session - import GHC.Unit import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface @@ -38,9 +36,4 @@ data HscStatus -- exists. Pass to `hscMaybeWriteIface` when writing the interface to -- avoid updating the existing interface when the interface isn't -- changed. - , hscs_iface_dflags :: !DynFlags - -- ^ Generate final iface using this DynFlags. - -- FIXME (osa): I don't understand why this is necessary, but I spent - -- almost two days trying to figure this out and I couldn't .. perhaps - -- someone who understands this code better will remove this later. } -- cgit v1.2.1