Switch back to bytecode (#873)

* Switch back to bytecode

* return a HomeModInfo even if we can't generate a linkable

* set target to HscNothing

* add rule for GetModIfaceWithoutLinkable

* use IdeGlobal for compiled linkables

session-loader/Development/IDE/Session.hs

@@ -645,7 +645,7 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do
 setLinkerOptions :: DynFlags -> DynFlags
 setLinkerOptions df = df {
     ghcLink   = LinkInMemory
-  , hscTarget = HscAsm
+  , hscTarget = HscNothing
   , ghcMode = CompManager
   }
 

src/Development/IDE/Core/Compile.hs

@@ -26,8 +26,7 @@ module Development.IDE.Core.Compile
   , getModSummaryFromImports
   , loadHieFile
   , loadInterface
-  , loadDepModule
-  , loadModuleHome
+  , loadModulesHome
   , setupFinderCache
   , getDocsBatch
   , lookupName
@@ -71,7 +70,7 @@ import qualified HeaderInfo                     as Hdr
 import           HscMain                        (makeSimpleDetails, hscDesugar, hscTypecheckRename, hscSimplify, hscGenHardCode, hscInteractive)
 import           MkIface
 import           StringBuffer                   as SB
-import           TcRnMonad (finalSafeMode, TcGblEnv, tct_id, TcTyThing(AGlobal, ATcId), initTc, initIfaceLoad, tcg_th_coreplugins, tcg_binds)
+import           TcRnMonad
 import           TcIface                        (typecheckIface)
 import           TidyPgm
 
@@ -92,8 +91,8 @@ import           System.IO.Extra
 import Control.Exception (evaluate)
 import Exception (ExceptionMonad)
 import TcEnv (tcLookup)
-import Data.Time (UTCTime)
-
+import Data.Time (UTCTime, getCurrentTime)
+import Linker (unload)
 
 -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
 parseModule
@@ -126,9 +125,10 @@ computePackageDeps env pkg = do
 
 typecheckModule :: IdeDefer
                 -> HscEnv
+                -> Maybe [Linkable] -- ^ linkables not to unload, if Nothing don't unload anything
                 -> ParsedModule
                 -> IO (IdeResult (HscEnv, TcModuleResult))
-typecheckModule (IdeDefer defer) hsc pm = do
+typecheckModule (IdeDefer defer) hsc keep_lbls pm = do
     fmap (\(hsc, res) -> case res of Left d -> (d,Nothing); Right (d,res) -> (d,fmap (hsc,) res)) $
       runGhcEnv hsc $
       catchSrcErrors "typecheck" $ do
@@ -138,7 +138,7 @@ typecheckModule (IdeDefer defer) hsc pm = do
 
         modSummary' <- initPlugins modSummary
         (warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
-            tcRnModule $ enableTopLevelWarnings
+            tcRnModule keep_lbls $ enableTopLevelWarnings
                                  $ enableUnnecessaryAndDeprecationWarnings
                                  $ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
         let errorPipeline = unDefer . hideDiag dflags . tagDiag
@@ -148,13 +148,15 @@ typecheckModule (IdeDefer defer) hsc pm = do
     where
         demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id
 
-tcRnModule :: GhcMonad m => ParsedModule -> m TcModuleResult
-tcRnModule pmod = do
+tcRnModule :: GhcMonad m => Maybe [Linkable] -> ParsedModule -> m TcModuleResult
+tcRnModule keep_lbls pmod = do
   let ms = pm_mod_summary pmod
   hsc_env <- getSession
   let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
   (tc_gbl_env, mrn_info)
-        <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
+        <- liftIO $ do
+             whenJust keep_lbls $ unload hsc_env_tmp
+             hscTypecheckRename hsc_env_tmp ms $
                        HsParsedModule { hpm_module = parsedSource pmod,
                                         hpm_src_files = pm_extra_src_files pmod,
                                         hpm_annotations = pm_annotations pmod }
@@ -182,33 +184,28 @@ mkHiFileResultCompile
     :: HscEnv
     -> TcModuleResult
     -> ModGuts
+    -> LinkableType -- ^ use object code or byte code?
     -> IO (IdeResult HiFileResult)
-mkHiFileResultCompile session' tcm simplified_guts = catchErrs $ do
+mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do
   let session = session' { hsc_dflags = ms_hspp_opts ms }
       ms = pm_mod_summary $ tmrParsed tcm
   -- give variables unique OccNames
   (guts, details) <- tidyProgram session simplified_guts
 
-  (diags, obj_res) <- generateObjectCode session ms guts
-  case obj_res of
-    Nothing -> do
+  let genLinkable = case ltype of
+        ObjectLinkable -> generateObjectCode
+        BCOLinkable -> generateByteCode
+
+  (diags, linkable) <- genLinkable session ms guts
 #if MIN_GHC_API_VERSION(8,10,0)
   let !partial_iface = force (mkPartialIface session details simplified_guts)
   final_iface <- mkFullIface session partial_iface
 #else
   (final_iface,_) <- mkIface session Nothing details simplified_guts
 #endif
-      let mod_info = HomeModInfo final_iface details Nothing
-      pure (diags, Just $ HiFileResult ms mod_info)
-    Just linkable -> do
-#if MIN_GHC_API_VERSION(8,10,0)
-      let !partial_iface = force (mkPartialIface session details simplified_guts)
-      final_iface <- mkFullIface session partial_iface
-#else
-      (final_iface,_) <- mkIface session Nothing details simplified_guts
-#endif
-      let mod_info = HomeModInfo final_iface details (Just linkable)
+  let mod_info = HomeModInfo final_iface details linkable
   pure (diags, Just $! HiFileResult ms mod_info)
+
   where
     dflags = hsc_dflags session'
     source = "compile"
@@ -221,7 +218,7 @@ mkHiFileResultCompile session' tcm simplified_guts = catchErrs $ do
 initPlugins :: GhcMonad m => ModSummary -> m ModSummary
 initPlugins modSummary = do
     session <- getSession
-    dflags <- liftIO $ initializePlugins session (ms_hspp_opts modSummary)
+    dflags <- liftIO $ initializePlugins session $ ms_hspp_opts modSummary
     return modSummary{ms_hspp_opts = dflags}
 
 -- | Whether we should run the -O0 simplifier when generating core.
@@ -261,7 +258,8 @@ generateObjectCode hscEnv summary guts = do
           catchSrcErrors "object" $ do
               session <- getSession
               let dot_o =  ml_obj_file (ms_location summary)
-              let session' = session { hsc_dflags = (hsc_dflags session) { outputFile = Just dot_o }}
+                  mod = ms_mod summary
+                  session' = session { hsc_dflags = (hsc_dflags session) { outputFile = Just dot_o }}
                   fp = replaceExtension dot_o "s"
               liftIO $ createDirectoryIfMissing True (takeDirectory fp)
               (warnings, dot_o_fp) <-
@@ -275,7 +273,10 @@ generateObjectCode hscEnv summary guts = do
                                 fp
                       compileFile session' StopLn (outputFilename, Just (As False))
               let unlinked = DotO dot_o_fp
-              let linkable = LM (ms_hs_date summary) (ms_mod summary) [unlinked]
+              -- Need time to be the modification time for recompilation checking
+              t <- liftIO $ getModificationTime dot_o_fp
+              let linkable = LM t mod [unlinked]
+
               pure (map snd warnings, linkable)
 
 generateByteCode :: HscEnv -> ModSummary -> CgGuts -> IO (IdeResult Linkable)
@@ -293,7 +294,9 @@ generateByteCode hscEnv summary guts = do
                                 (_tweak summary)
 #endif
               let unlinked = BCOs bytecode sptEntries
-              let linkable = LM (ms_hs_date summary) (ms_mod summary) [unlinked]
+              time <- liftIO getCurrentTime
+              let linkable = LM time (ms_mod summary) [unlinked]
+
               pure (map snd warnings, linkable)
 
 demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule
@@ -443,56 +446,44 @@ handleGenerationErrors' dflags source action =
 
 -- | Initialise the finder cache, dependencies should be topologically
 -- sorted.
-setupFinderCache :: GhcMonad m => [ModSummary] -> m ()
-setupFinderCache mss = do
-    session <- getSession
-
-    -- set the target and module graph in the session
-    let graph = mkModuleGraph mss
-    setSession session { hsc_mod_graph = graph }
+setupFinderCache :: [ModSummary] -> HscEnv -> IO HscEnv
+setupFinderCache mss session = do
 
     -- Make modules available for others that import them,
     -- by putting them in the finder cache.
     let ims  = map (InstalledModule (thisInstalledUnitId $ hsc_dflags session) . moduleName . ms_mod) mss
         ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) mss ims
+    -- set the target and module graph in the session
+        graph = mkModuleGraph mss
+
     -- We have to create a new IORef here instead of modifying the existing IORef as
     -- it is shared between concurrent compilations.
-    prevFinderCache <- liftIO $ readIORef $ hsc_FC session
+    prevFinderCache <- readIORef $ hsc_FC session
     let newFinderCache =
             foldl'
                 (\fc (im, ifr) -> GHC.extendInstalledModuleEnv fc im ifr) prevFinderCache
                 $ zip ims ifrs
-    newFinderCacheVar <- liftIO $ newIORef $! newFinderCache
-    modifySession $ \s -> s { hsc_FC = newFinderCacheVar }
+    newFinderCacheVar <- newIORef $! newFinderCache
+
+    pure $ session { hsc_FC = newFinderCacheVar, hsc_mod_graph = graph }
 
 
--- | Load a module, quickly. Input doesn't need to be desugared.
+-- | Load modules, quickly. Input doesn't need to be desugared.
 -- A module must be loaded before dependent modules can be typechecked.
 -- This variant of loadModuleHome will *never* cause recompilation, it just
 -- modifies the session.
---
 -- The order modules are loaded is important when there are hs-boot files.
 -- In particular you should make sure to load the .hs version of a file after the
 -- .hs-boot version.
-loadModuleHome
-    :: HomeModInfo
+loadModulesHome
+    :: [HomeModInfo]
     -> HscEnv
     -> HscEnv
-loadModuleHome mod_info e =
-    e { hsc_HPT = addToHpt (hsc_HPT e) mod_name mod_info }
+loadModulesHome mod_infos e =
+    e { hsc_HPT = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos]
+      , hsc_type_env_var = Nothing }
     where
-      mod_name = moduleName $ mi_module $ hm_iface mod_info
-
--- | Load module interface.
-loadDepModuleIO :: HomeModInfo -> HscEnv -> IO HscEnv
-loadDepModuleIO mod_info hsc = do
-    return $ loadModuleHome mod_info hsc
-
-loadDepModule :: GhcMonad m => HomeModInfo -> m ()
-loadDepModule mod_info = do
-  e <- getSession
-  e' <- liftIO $ loadDepModuleIO mod_info e
-  setSession e'
+      mod_name = moduleName . mi_module . hm_iface
 
 -- | GhcMonad function to chase imports of a module given as a StringBuffer. Returns given module's
 -- name and its imports.
@@ -717,10 +708,10 @@ loadInterface
   :: MonadIO m => HscEnv
   -> ModSummary
   -> SourceModified
-  -> Bool
-  -> (Bool -> m ([FileDiagnostic], Maybe HiFileResult)) -- ^ Action to regenerate an interface
+  -> Maybe LinkableType
+  -> (Maybe LinkableType -> m ([FileDiagnostic], Maybe HiFileResult)) -- ^ Action to regenerate an interface
   -> m ([FileDiagnostic], Maybe HiFileResult)
-loadInterface session ms sourceMod objNeeded regen = do
+loadInterface session ms sourceMod linkableNeeded regen = do
     res <- liftIO $ checkOldIface session ms sourceMod Nothing
     case res of
           (UpToDate, Just iface)
@@ -740,19 +731,20 @@ loadInterface session ms sourceMod objNeeded regen = do
             -- one-shot mode.
             | not (mi_used_th iface) || SourceUnmodifiedAndStable == sourceMod
             -> do
-             linkable <-
-               if objNeeded
-               then liftIO $ findObjectLinkableMaybe (ms_mod ms) (ms_location ms)
-               else pure Nothing
-             let objUpToDate = not objNeeded || case linkable of
+             linkable <- case linkableNeeded of
+               Just ObjectLinkable -> liftIO $ findObjectLinkableMaybe (ms_mod ms) (ms_location ms)
+               _ -> pure Nothing
+
+             -- We don't need to regenerate if the object is up do date, or we don't need one
+             let objUpToDate = isNothing linkableNeeded || case linkable of
                    Nothing -> False
                    Just (LM obj_time _ _) -> obj_time > ms_hs_date ms
              if objUpToDate
              then do
                hmi <- liftIO $ mkDetailsFromIface session iface linkable
                return ([], Just $ HiFileResult ms hmi)
-             else regen objNeeded
-          (_reason, _) -> regen objNeeded
+             else regen linkableNeeded
+          (_reason, _) -> regen linkableNeeded
 
 mkDetailsFromIface :: HscEnv -> ModIface -> Maybe Linkable -> IO HomeModInfo
 mkDetailsFromIface session iface linkable = do

src/Development/IDE/Core/RuleTypes.hs

@@ -27,7 +27,7 @@ import           Development.Shake
 import           GHC.Generics                             (Generic)
 
 import Module (InstalledUnitId)
-import HscTypes (ModGuts, hm_iface, HomeModInfo)
+import HscTypes (ModGuts, hm_iface, HomeModInfo, hm_linkable)
 
 import           Development.IDE.Spans.Common
 import           Development.IDE.Spans.LocalBindings
@@ -35,6 +35,10 @@ import           Development.IDE.Import.FindImports (ArtifactsLocation)
 import Data.ByteString (ByteString)
 import Language.Haskell.LSP.Types (NormalizedFilePath)
 import TcRnMonad (TcGblEnv)
+import qualified Data.ByteString.Char8 as BS
+
+data LinkableType = ObjectLinkable | BCOLinkable
+  deriving (Eq,Ord,Show)
 
 -- NOTATION
 --   Foo+ means Foo for the dependencies
@@ -54,9 +58,6 @@ type instance RuleResult GetDependencies = TransitiveDependencies
 
 type instance RuleResult GetModuleGraph = DependencyInformation
 
--- | Does this module need object code?
-type instance RuleResult NeedsObjectCode = Bool
-
 data GetKnownTargets = GetKnownTargets
   deriving (Show, Generic, Eq, Ord)
 instance Hashable GetKnownTargets
@@ -111,7 +112,12 @@ data HiFileResult = HiFileResult
     }
 
 hiFileFingerPrint :: HiFileResult -> ByteString
-hiFileFingerPrint = fingerprintToBS . getModuleHash . hirModIface
+hiFileFingerPrint hfr = ifaceBS <> linkableBS
+  where
+    ifaceBS = fingerprintToBS . getModuleHash . hirModIface $ hfr -- will always be two bytes
+    linkableBS = case hm_linkable $ hirHomeMod hfr of
+      Nothing -> ""
+      Just l -> BS.pack $ show $ linkableTime l
 
 hirModIface :: HiFileResult -> ModIface
 hirModIface = hm_iface . hirHomeMod
@@ -179,6 +185,10 @@ type instance RuleResult GetModIfaceFromDisk = HiFileResult
 -- | Get a module interface details, either from an interface file or a typechecked module
 type instance RuleResult GetModIface = HiFileResult
 
+-- | Get a module interface details, without the Linkable
+-- For better early cuttoff
+type instance RuleResult GetModIfaceWithoutLinkable = HiFileResult
+
 data FileOfInterestStatus = OnDisk | Modified
   deriving (Eq, Show, Typeable, Generic)
 instance Hashable FileOfInterestStatus
@@ -213,11 +223,14 @@ instance Hashable GetLocatedImports
 instance NFData   GetLocatedImports
 instance Binary   GetLocatedImports
 
-data NeedsObjectCode = NeedsObjectCode
+-- | Does this module need to be compiled?
+type instance RuleResult NeedsCompilation = Bool
+
+data NeedsCompilation = NeedsCompilation
     deriving (Eq, Show, Typeable, Generic)
-instance Hashable NeedsObjectCode
-instance NFData   NeedsObjectCode
-instance Binary   NeedsObjectCode
+instance Hashable NeedsCompilation
+instance NFData   NeedsCompilation
+instance Binary   NeedsCompilation
 
 data GetDependencyInformation = GetDependencyInformation
     deriving (Eq, Show, Typeable, Generic)
@@ -290,6 +303,12 @@ instance Hashable GetModIface
 instance NFData   GetModIface
 instance Binary   GetModIface
 
+data GetModIfaceWithoutLinkable = GetModIfaceWithoutLinkable
+    deriving (Eq, Show, Typeable, Generic)
+instance Hashable GetModIfaceWithoutLinkable
+instance NFData   GetModIfaceWithoutLinkable
+instance Binary   GetModIfaceWithoutLinkable
+
 data IsFileOfInterest = IsFileOfInterest
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable IsFileOfInterest

src/Development/IDE/Core/Rules.hs

@@ -96,6 +96,8 @@ import qualified Data.HashSet as HashSet
 import qualified Data.HashMap.Strict as HM
 import TcRnMonad (tcg_dependent_files)
 import Data.IORef
+import Control.Concurrent.Extra
+import Module
 
 -- | This is useful for rules to convert rules that can only produce errors or
 -- a result into the more general IdeResult type that supports producing
@@ -606,8 +608,11 @@ typeCheckRuleDefinition
 typeCheckRuleDefinition hsc pm = do
   setPriority priorityTypeCheck
   IdeOptions { optDefer = defer } <- getIdeOptions
+
+  linkables_to_keep <- currentLinkables
+
   addUsageDependencies $ fmap (second (fmap snd)) $ liftIO $
-    typecheckModule defer hsc pm
+    typecheckModule defer hsc (Just linkables_to_keep) pm
   where
     addUsageDependencies :: Action (a, Maybe TcModuleResult) -> Action (a, Maybe TcModuleResult)
     addUsageDependencies a = do
@@ -617,6 +622,16 @@ typeCheckRuleDefinition hsc pm = do
         void $ uses_ GetModificationTime (map toNormalizedFilePath' used_files)
       return r
 
+-- | Get all the linkables stored in the graph, i.e. the ones we *do not* need to unload.
+-- Doesn't actually contain the code, since we don't need it to unload
+currentLinkables :: Action [Linkable]
+currentLinkables = do
+    compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction
+    hm <- liftIO $ readVar compiledLinkables
+    pure $ map go $ moduleEnvToList hm
+  where
+    go (mod, time) = LM time mod []
+
 -- A local rule type to get caching. We want to use newCache, but it has
 -- thread killed exception issues, so we lift it to a full rule.
 -- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547
@@ -667,18 +682,22 @@ ghcSessionDepsDefinition :: NormalizedFilePath -> Action (IdeResult HscEnvEq)
 ghcSessionDepsDefinition file = do
         env <- use_ GhcSession file
         let hsc = hscEnv env
+        (ms,_) <- useWithStale_ GetModSummaryWithoutTimestamps file
         (deps,_) <- useWithStale_ GetDependencies file
         let tdeps = transitiveModuleDeps deps
-        ifaces <- uses_ GetModIface tdeps
+            uses_th_qq =
+              xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
+            dflags = ms_hspp_opts ms
+        ifaces <- if uses_th_qq
+                  then uses_ GetModIface tdeps
+                  else uses_ GetModIfaceWithoutLinkable tdeps
 
         -- Currently GetDependencies returns things in topological order so A comes before B if A imports B.
         -- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.
         -- Long-term we might just want to change the order returned by GetDependencies
         let inLoadOrder = reverse (map hirHomeMod ifaces)
 
-        (session',_) <- liftIO $ runGhcEnv hsc $ do
-            setupFinderCache (map hirModSummary ifaces)
-            mapM_ loadDepModule inLoadOrder
+        session' <- liftIO $ loadModulesHome inLoadOrder <$> setupFinderCache (map hirModSummary ifaces) hsc
 
         res <- liftIO $ newHscEnvEqWithImportPaths (envImportPaths env) session' []
         return ([], Just res)
@@ -691,8 +710,8 @@ getModIfaceFromDiskRule = defineEarlyCutoff $ \GetModIfaceFromDisk f -> do
       Nothing -> return (Nothing, (diags_session, Nothing))
       Just session -> do
         sourceModified <- use_ IsHiFileStable f
-        needsObj <- use_ NeedsObjectCode f
-        r <- loadInterface (hscEnv session) ms sourceModified needsObj (regenerateHiFile session f)
+        linkableType <- getLinkableType f
+        r <- loadInterface (hscEnv session) ms sourceModified linkableType (regenerateHiFile session f)
         case r of
             (diags, Just x) -> do
                 let fp = Just (hiFileFingerPrint x)
@@ -779,14 +798,14 @@ getModIfaceRule :: Rules ()
 getModIfaceRule = defineEarlyCutoff $ \GetModIface f -> do
 #if !defined(GHC_LIB)
   fileOfInterest <- use_ IsFileOfInterest f
-  case fileOfInterest of
+  res@(_,(_,mhmi)) <- case fileOfInterest of
     IsFOI status -> do
       -- Never load from disk for files of interest
       tmr <- use_ TypeCheck f
-      needsObj <- use_ NeedsObjectCode f
+      linkableType <- getLinkableType f
       hsc <- hscEnv <$> use_ GhcSessionDeps f
       let compile = fmap ([],) $ use GenerateCore f
-      (diags, !hiFile) <- compileToObjCodeIfNeeded hsc needsObj compile tmr
+      (diags, !hiFile) <- compileToObjCodeIfNeeded hsc linkableType compile tmr
       let fp = hiFileFingerPrint <$> hiFile
       hiDiags <- case hiFile of
         Just hiFile
@@ -798,16 +817,29 @@ getModIfaceRule = defineEarlyCutoff $ \GetModIface f -> do
       hiFile <- use GetModIfaceFromDisk f
       let fp = hiFileFingerPrint <$> hiFile
       return (fp, ([], hiFile))
+
+  -- Record the linkable so we know not to unload it
+  whenJust (hm_linkable . hirHomeMod =<< mhmi) $ \(LM time mod _) -> do
+      compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction
+      liftIO $ modifyVar_ compiledLinkables $ \old -> pure $ extendModuleEnv old mod time
+  pure res
 #else
     tm <- use_ TypeCheck f
     hsc <- hscEnv <$> use_ GhcSessionDeps f
-    (diags, !hiFile) <- liftIO $ compileToObjCodeIfNeeded hsc False (error "can't compile with ghc-lib") tm
+    (diags, !hiFile) <- liftIO $ compileToObjCodeIfNeeded hsc Nothing (error "can't compile with ghc-lib") tm
     let fp = hiFileFingerPrint <$> hiFile
     return (fp, (diags, hiFile))
 #endif
 
-regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> Bool -> Action ([FileDiagnostic], Maybe HiFileResult)
-regenerateHiFile sess f objNeeded = do
+getModIfaceWithoutLinkableRule :: Rules ()
+getModIfaceWithoutLinkableRule = defineEarlyCutoff $ \GetModIfaceWithoutLinkable f -> do
+  mhfr <- use GetModIface f
+  let mhfr' = fmap (\x -> x{ hirHomeMod = (hirHomeMod x){ hm_linkable = Just (error msg) } }) mhfr
+      msg = "tried to look at linkable for GetModIfaceWithoutLinkable for " ++ show f
+  pure (fingerprintToBS . getModuleHash . hirModIface <$> mhfr', ([],mhfr'))
+
+regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult)
+regenerateHiFile sess f compNeeded = do
     let hsc = hscEnv sess
         -- After parsing the module remove all package imports referring to
         -- these packages as we have already dealt with what they map to.
@@ -837,7 +869,7 @@ regenerateHiFile sess f objNeeded = do
                 let compile = compileModule (RunSimplifier True) hsc (pm_mod_summary pm) $ tmrTypechecked tmr
 
                 -- Bang pattern is important to avoid leaking 'tmr'
-                (diags'', !res) <- liftIO $ compileToObjCodeIfNeeded hsc objNeeded compile tmr
+                (diags'', !res) <- liftIO $ compileToObjCodeIfNeeded hsc compNeeded compile tmr
 
                 -- Write hi file
                 hiDiags <- case res of
@@ -857,16 +889,16 @@ regenerateHiFile sess f objNeeded = do
 type CompileMod m = m (IdeResult ModGuts)
 
 -- | HscEnv should have deps included already
-compileToObjCodeIfNeeded :: MonadIO m => HscEnv -> Bool -> CompileMod m -> TcModuleResult -> m (IdeResult HiFileResult)
-compileToObjCodeIfNeeded hsc False _ tmr = liftIO $ do
+compileToObjCodeIfNeeded :: MonadIO m => HscEnv -> Maybe LinkableType -> CompileMod m -> TcModuleResult -> m (IdeResult HiFileResult)
+compileToObjCodeIfNeeded hsc Nothing _ tmr = liftIO $ do
   res <- mkHiFileResultNoCompile hsc tmr
   pure ([], Just $! res)
-compileToObjCodeIfNeeded hsc True getGuts tmr = do
+compileToObjCodeIfNeeded hsc (Just linkableType) getGuts tmr = do
   (diags, mguts) <- getGuts
   case mguts of
     Nothing -> pure (diags, Nothing)
     Just guts -> do
-      (diags', !res) <- liftIO $ mkHiFileResultCompile hsc tmr guts
+      (diags', !res) <- liftIO $ mkHiFileResultCompile hsc tmr guts linkableType
       pure (diags++diags', res)
 
 getClientSettingsRule :: Rules ()
@@ -875,24 +907,36 @@ getClientSettingsRule = defineEarlyCutOffNoFile $ \GetClientSettings -> do
   settings <- clientSettings <$> getIdeConfiguration
   return (BS.pack . show . hash $ settings, settings)
 
-needsObjectCodeRule :: Rules ()
-needsObjectCodeRule = defineEarlyCutoff $ \NeedsObjectCode file -> do
+-- | For now we always use bytecode
+getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
+getLinkableType f = do
+  needsComp <- use_ NeedsCompilation f
+  pure $ if needsComp then Just BCOLinkable else Nothing
+
+needsCompilationRule :: Rules ()
+needsCompilationRule = defineEarlyCutoff $ \NeedsCompilation file -> do
   (ms,_) <- useWithStale_ GetModSummaryWithoutTimestamps file
   -- A file needs object code if it uses TH or any file that depends on it uses TH
   res <-
     if uses_th_qq ms
     then pure True
     -- Treat as False if some reverse dependency header fails to parse
-    else anyM (fmap (fromMaybe False) . use NeedsObjectCode) . maybe [] (immediateReverseDependencies file)
+    else anyM (fmap (fromMaybe False) . use NeedsCompilation) . maybe [] (immediateReverseDependencies file)
            =<< useNoFile GetModuleGraph
   pure (Just $ BS.pack $ show $ hash res, ([], Just res))
   where
     uses_th_qq (ms_hspp_opts -> dflags) =
       xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
 
+-- | Tracks which linkables are current, so we don't need to unload them
+newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) }
+instance IsIdeGlobal CompiledLinkables
+
 -- | A rule that wires per-file rules together
 mainRule :: Rules ()
 mainRule = do
+    linkables <- liftIO $ newVar emptyModuleEnv
+    addIdeGlobal $ CompiledLinkables linkables
     getParsedModuleRule
     getLocatedImportsRule
     getDependencyInformationRule
@@ -903,6 +947,7 @@ mainRule = do
     loadGhcSession
     getModIfaceFromDiskRule
     getModIfaceRule
+    getModIfaceWithoutLinkableRule
     getModSummaryRule
     isHiFileStableRule
     getModuleGraphRule
@@ -910,7 +955,7 @@ mainRule = do
     getClientSettingsRule
     getHieAstsRule
     getBindingsRule
-    needsObjectCodeRule
+    needsCompilationRule
     generateCoreRule
     getImportMapRule
 

src/Development/IDE/GHC/Compat.hs

@@ -47,9 +47,11 @@ module Development.IDE.GHC.Compat(
 
 #if MIN_GHC_API_VERSION(8,10,0)
     module GHC.Hs.Extension,
+    module LinkerTypes,
 #else
     module HsExtension,
     noExtField,
+    linkableTime,
 #endif
 
     module GHC,
@@ -65,6 +67,10 @@ module Development.IDE.GHC.Compat(
 
     ) where
 
+#if MIN_GHC_API_VERSION(8,10,0)
+import LinkerTypes
+#endif
+
 import StringBuffer
 import DynFlags
 import Fingerprint (Fingerprint)

src/Development/IDE/Plugin/Completions.hs

@@ -90,7 +90,7 @@ produceCompletions = do
                                     , pm_extra_src_files = [] -- src imports not allowed
                                     , pm_annotations = mempty
                                     }
-                        tm <- liftIO $ typecheckModule (IdeDefer True) env pm
+                        tm <- liftIO $ typecheckModule (IdeDefer True) env Nothing pm
                         case tm of
                             (_, Just (_,tcm)) -> do
                                 cdata <- liftIO $ cacheDataProducer env tcm parsedDeps

test/exe/Main.hs

@@ -2504,9 +2504,9 @@ thTests =
         _ <- createDoc "A.hs" "haskell" sourceA
         _ <- createDoc "B.hs" "haskell" sourceB
         return ()
-    , ignoreInWindowsForGHC88 (thReloadingTest `xfail` "expect broken (#672)")
+    , thReloadingTest
     -- Regression test for https://github.com/digital-asset/ghcide/issues/614
-    , thLinkingTest `xfail` "expect broken"
+    , thLinkingTest
     , testSessionWait "findsTHIdentifiers" $ do
         let sourceA =
               T.unlines
@@ -2566,6 +2566,7 @@ thReloadingTest = testCase "reloading-th-test" $ withoutStackEnv $ runWithExtraF
     expectDiagnostics
         [("THC.hs", [(DsError, (4, 4), "Couldn't match expected type '()' with actual type 'Bool'")])
         ,("THC.hs", [(DsWarning, (6,0), "Top-level binding")])
+        ,("THB.hs", [(DsWarning, (4,0), "Top-level binding")])
         ]
 
     closeDoc adoc