diff options
Diffstat (limited to 'haddock-api/src/Haddock/Interface.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Interface.hs | 26 |
1 files changed, 16 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 1501919b..141325be 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -51,15 +51,18 @@ import qualified Data.Set as Set import Text.Printf import GHC.Unit.Module.Env (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet) +import GHC.Unit.Module.ModSummary +import GHC.Unit.Module.Graph +import GHC.Unit.Types import GHC.Data.Graph.Directed import GHC.Driver.Session hiding (verbosity) import GHC hiding (verbosity) -import GHC.Driver.Types +import GHC.Driver.Env import GHC.Data.FastString (unpackFS) import GHC.Tc.Types (tcg_rdr_env) import GHC.Types.Name (nameIsFromExternalPackage, nameOccName) import GHC.Types.Name.Occurrence (isTcOcc) -import GHC.Types.Name.Reader (unQualOK, gre_name, globalRdrEnvElts) +import GHC.Types.Name.Reader (unQualOK, greMangledName, globalRdrEnvElts) import GHC.Utils.Error (withTimingD) import GHC.HsToCore.Docs import GHC.Runtime.Loader (initializePlugins) @@ -136,10 +139,11 @@ createIfaces verbosity modules flags instIfaceMap = do (ifaces, _, !ms) <- foldM f ([], Map.empty, emptyModuleSet) sortedMods return (reverse ifaces, ms) where - f (ifaces, ifaceMap, !ms) modSummary = do + f state (InstantiationNode _) = pure state + f (ifaces, ifaceMap, !ms) (ModuleNode ems) = do x <- {-# SCC processModule #-} withTimingD "processModule" (const ()) $ do - processModule verbosity modSummary flags ifaceMap instIfaceMap + processModule verbosity (emsModSummary ems) flags ifaceMap instIfaceMap return $ case x of Just (iface, ms') -> ( iface:ifaces , Map.insert (ifaceMod iface) iface ifaceMap @@ -155,8 +159,9 @@ processModule verbosity modsum flags modMap instIfaceMap = do -- Since GHC 8.6, plugins are initialized on a per module basis hsc_env' <- getSession - dynflags' <- liftIO (initializePlugins hsc_env' (GHC.ms_hspp_opts modsum)) - let modsum' = modsum { ms_hspp_opts = dynflags' } + hsc_env'' <- liftIO $ initializePlugins (hsc_env' { hsc_dflags = ms_hspp_opts modsum }) + setSession hsc_env'' + let modsum' = modsum { ms_hspp_opts = (hsc_dflags hsc_env'') } tm <- {-# SCC "parse/typecheck/load" #-} loadModule =<< typecheckModule =<< parseModule modsum' @@ -164,10 +169,11 @@ processModule verbosity modsum flags modMap instIfaceMap = do IsBoot -> return Nothing NotBoot -> do + unit_state <- hsc_units <$> getSession out verbosity verbose "Creating interface..." (interface, msgs) <- {-# SCC createIterface #-} withTimingD "createInterface" (const ()) $ do - runWriterGhc $ createInterface tm flags modMap instIfaceMap + runWriterGhc $ createInterface tm unit_state flags modMap instIfaceMap -- We need to keep track of which modules were somehow in scope so that when -- Haddock later looks for instances, it also looks in these modules too. @@ -175,11 +181,11 @@ processModule verbosity modsum flags modMap instIfaceMap = do -- See https://github.com/haskell/haddock/issues/469. hsc_env <- getSession let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm - this_pkg = homeUnit (hsc_dflags hsc_env) + home_unit = hsc_home_unit hsc_env !mods = mkModuleSet [ nameModule name | gre <- globalRdrEnvElts new_rdr_env - , let name = gre_name gre - , nameIsFromExternalPackage this_pkg name + , let name = greMangledName gre + , nameIsFromExternalPackage home_unit name , isTcOcc (nameOccName name) -- Types and classes only , unQualOK gre ] -- In scope unqualified |