[Git][haskell-team/DHG_packages][experimental] 2 commits: ghc: Backport fix for high memory usage in Haddock
Ilias Tsitsimpis
gitlab at salsa.debian.org
Mon Sep 24 17:48:06 BST 2018
Ilias Tsitsimpis pushed to branch experimental at Debian Haskell Group / DHG_packages
Commits:
196fd11a by Ilias Tsitsimpis at 2018-09-21T19:41:23Z
ghc: Backport fix for high memory usage in Haddock
- - - - -
fcfb99be by Ilias Tsitsimpis at 2018-09-21T20:14:00Z
ghc: Remove DFSG incompatible file
- - - - -
5 changed files:
- p/ghc/debian/changelog
- p/ghc/debian/copyright
- + p/ghc/debian/patches/haddock-out-of-memory.patch
- p/ghc/debian/patches/series
- p/ghc/debian/watch
Changes:
=====================================
p/ghc/debian/changelog
=====================================
@@ -1,3 +1,12 @@
+ghc (8.4.3+dfsg1-1) experimental; urgency=medium
+
+ * Backport upstream commit 18cb44dfae3f.
+ This fixes upstream bug #15213 (32 bit Haddock runs out of memory
+ compiling 32 bit GHC).
+ * Remove DFSG incompatible file (Closes: #870683).
+
+ -- Ilias Tsitsimpis <iliastsi at debian.org> Fri, 21 Sep 2018 23:05:59 +0300
+
ghc (8.4.3-7) experimental; urgency=medium
* Backport upstream commit ec9aacf3eb2 (add -latomic to ghc-prim)
=====================================
p/ghc/debian/copyright
=====================================
@@ -2,6 +2,7 @@ Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
Upstream-Name: ghc
Upstream-Contact: Simon Marlow <marlowsd at gmail.com>
Source: https://downloads.haskell.org/~ghc/
+Files-Excluded: libraries/bytestring/tests/data
Files: *
License: BSD-3-clause
=====================================
p/ghc/debian/patches/haddock-out-of-memory.patch
=====================================
@@ -0,0 +1,248 @@
+commit 18cb44dfae3f0847447da33c9d7a25d2709d838f
+Author: Alec Theriault <alec.theriault at gmail.com>
+Date: Tue Aug 21 16:03:40 2018 -0400
+
+ Explicitly tell 'getNameToInstances' mods to load
+
+ Calculating which modules to load based on the InteractiveContext means
+ maintaining a potentially very large GblRdrEnv.
+
+ In Haddock's case, it is much cheaper (from a memory perspective) to
+ just keep track of which modules interfaces we want loaded then hand
+ these off explicitly to 'getNameToInstancesIndex'.
+
+ Bumps haddock submodule (commit 40eb5aabed0ae)
+
+ Reviewers: alexbiehl, bgamari
+
+ Reviewed By: alexbiehl
+
+ Subscribers: rwbarton, thomie, carter
+
+ Differential Revision: https://phabricator.haskell.org/D5003
+
+ (cherry picked from commit c971e1193fa44bb507d1806d5bb61768670dc912)
+
+Index: b/compiler/main/GHC.hs
+===================================================================
+--- a/compiler/main/GHC.hs
++++ b/compiler/main/GHC.hs
+@@ -117,6 +117,7 @@ module GHC (
+ showModule,
+ moduleIsBootOrNotObjectLinkable,
+ getNameToInstancesIndex,
++ getNameToInstancesIndex2,
+
+ -- ** Inspecting types and kinds
+ exprType, TcRnExprMode(..),
+@@ -297,7 +298,8 @@ import HscMain
+ import GhcMake
+ import DriverPipeline ( compileOne' )
+ import GhcMonad
+-import TcRnMonad ( finalSafeMode, fixSafeInstances )
++import TcRnMonad ( finalSafeMode, fixSafeInstances, initIfaceTcRn )
++import LoadIface ( loadSysInterface )
+ import TcRnTypes
+ import Packages
+ import NameSet
+@@ -1247,10 +1249,27 @@ getNameToInstancesIndex :: GhcMonad m
+ => [Module] -- ^ visible modules. An orphan instance will be returned if and
+ -- only it is visible from at least one module in the list.
+ -> m (Messages, Maybe (NameEnv ([ClsInst], [FamInst])))
+-getNameToInstancesIndex visible_mods = do
++getNameToInstancesIndex visible_mods =
++ getNameToInstancesIndex2 visible_mods Nothing
++
++-- | Retrieve all type and family instances in the environment, indexed
++-- by 'Name'. Each name's lists will contain every instance in which that name
++-- is mentioned in the instance head.
++getNameToInstancesIndex2 :: GhcMonad m
++ => [Module] -- ^ visible modules. An orphan instance will be returned
++ -- if it is visible from at least one module in the list.
++ -> Maybe [Module] -- ^ modules to load. If this is not specified, we load
++ -- modules for everything that is in scope unqualified.
++ -> m (Messages, Maybe (NameEnv ([ClsInst], [FamInst])))
++getNameToInstancesIndex2 visible_mods mods_to_load = do
+ hsc_env <- getSession
+ liftIO $ runTcInteractive hsc_env $
+- do { loadUnqualIfaces hsc_env (hsc_IC hsc_env)
++ do { case mods_to_load of
++ Nothing -> loadUnqualIfaces hsc_env (hsc_IC hsc_env)
++ Just mods ->
++ let doc = text "Need interface for reporting instances in scope"
++ in initIfaceTcRn $ mapM_ (loadSysInterface doc) mods
++
+ ; InstEnvs {ie_global, ie_local} <- tcGetInstEnvs
+ ; let visible_mods' = mkModuleSet visible_mods
+ ; (pkg_fie, home_fie) <- tcGetFamInstEnvs
+Index: b/utils/haddock/haddock-api/src/Haddock/Interface.hs
+===================================================================
+--- a/utils/haddock/haddock-api/src/Haddock/Interface.hs
++++ b/utils/haddock/haddock-api/src/Haddock/Interface.hs
+@@ -1,4 +1,4 @@
+-{-# LANGUAGE CPP, OverloadedStrings #-}
++{-# LANGUAGE CPP, OverloadedStrings, BangPatterns #-}
+ -----------------------------------------------------------------------------
+ -- |
+ -- Module : Haddock.Interface
+@@ -51,6 +51,7 @@ import System.Directory
+ import System.FilePath
+ import Text.Printf
+
++import Module (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet)
+ import Digraph
+ import DynFlags hiding (verbosity)
+ import Exception
+@@ -59,7 +60,9 @@ import HscTypes
+ import FastString (unpackFS)
+ import MonadUtils (liftIO)
+ import TcRnTypes (tcg_rdr_env)
+-import RdrName (plusGlobalRdrEnv)
++import Name (nameIsFromExternalPackage, nameOccName)
++import OccName (isTcOcc)
++import RdrName (unQualOK, gre_name, globalRdrEnvElts)
+ import ErrUtils (withTiming)
+
+ #if defined(mingw32_HOST_OS)
+@@ -87,7 +90,7 @@ processModules verbosity modules flags e
+ out verbosity verbose "Creating interfaces..."
+ let instIfaceMap = Map.fromList [ (instMod iface, iface) | ext <- extIfaces
+ , iface <- ifInstalledIfaces ext ]
+- interfaces <- createIfaces0 verbosity modules flags instIfaceMap
++ (interfaces, ms) <- createIfaces0 verbosity modules flags instIfaceMap
+
+ let exportedNames =
+ Set.unions $ map (Set.fromList . ifaceExports) $
+@@ -96,7 +99,7 @@ processModules verbosity modules flags e
+ out verbosity verbose "Attaching instances..."
+ interfaces' <- {-# SCC attachInstances #-}
+ withTiming getDynFlags "attachInstances" (const ()) $ do
+- attachInstances (exportedNames, mods) interfaces instIfaceMap
++ attachInstances (exportedNames, mods) interfaces instIfaceMap ms
+
+ out verbosity verbose "Building cross-linking environment..."
+ -- Combine the link envs of the external packages into one
+@@ -120,7 +123,7 @@ processModules verbosity modules flags e
+ --------------------------------------------------------------------------------
+
+
+-createIfaces0 :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc [Interface]
++createIfaces0 :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc ([Interface], ModuleSet)
+ createIfaces0 verbosity modules flags instIfaceMap =
+ -- Output dir needs to be set before calling depanal since depanal uses it to
+ -- compute output file names that are stored in the DynFlags of the
+@@ -150,43 +153,52 @@ createIfaces0 verbosity modules flags in
+ depanal [] False
+
+
+-createIfaces :: Verbosity -> [Flag] -> InstIfaceMap -> ModuleGraph -> Ghc [Interface]
++createIfaces :: Verbosity -> [Flag] -> InstIfaceMap -> ModuleGraph -> Ghc ([Interface], ModuleSet)
+ createIfaces verbosity flags instIfaceMap mods = do
+ let sortedMods = flattenSCCs $ topSortModuleGraph False mods Nothing
+ out verbosity normal "Haddock coverage:"
+- (ifaces, _) <- foldM f ([], Map.empty) sortedMods
+- return (reverse ifaces)
++ (ifaces, _, !ms) <- foldM f ([], Map.empty, emptyModuleSet) sortedMods
++ return (reverse ifaces, ms)
+ where
+- f (ifaces, ifaceMap) modSummary = do
++ f (ifaces, ifaceMap, !ms) modSummary = do
+ x <- {-# SCC processModule #-}
+ withTiming getDynFlags "processModule" (const ()) $ do
+ processModule verbosity modSummary flags ifaceMap instIfaceMap
+ return $ case x of
+- Just iface -> (iface:ifaces, Map.insert (ifaceMod iface) iface ifaceMap)
+- Nothing -> (ifaces, ifaceMap) -- Boot modules don't generate ifaces.
++ Just (iface, ms') -> ( iface:ifaces
++ , Map.insert (ifaceMod iface) iface ifaceMap
++ , unionModuleSet ms ms' )
++ Nothing -> ( ifaces
++ , ifaceMap
++ , ms ) -- Boot modules don't generate ifaces.
+
+
+-processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe Interface)
++processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe (Interface, ModuleSet))
+ processModule verbosity modsum flags modMap instIfaceMap = do
+ out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..."
+ tm <- {-# SCC "parse/typecheck/load" #-} loadModule =<< typecheckModule =<< parseModule modsum
+
+- -- We need to modify the interactive context's environment so that when
+- -- Haddock later looks for instances, it also looks in the modules it
+- -- encountered while typechecking.
+- --
+- -- See https://github.com/haskell/haddock/issues/469.
+- hsc_env at HscEnv{ hsc_IC = old_IC } <- getSession
+- let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm
+- setSession hsc_env{ hsc_IC = old_IC {
+- ic_rn_gbl_env = ic_rn_gbl_env old_IC `plusGlobalRdrEnv` new_rdr_env
+- } }
+-
+ if not $ isBootSummary modsum then do
+ out verbosity verbose "Creating interface..."
+ (interface, msg) <- {-# SCC createIterface #-}
+ withTiming getDynFlags "createInterface" (const ()) $ do
+ runWriterGhc $ createInterface tm flags modMap instIfaceMap
++
++ -- We need to modify the interactive context's environment so that when
++ -- Haddock later looks for instances, it also looks in the modules it
++ -- encountered while typechecking.
++ --
++ -- 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 = thisPackage (hsc_dflags hsc_env)
++ !mods = mkModuleSet [ nameModule name
++ | gre <- globalRdrEnvElts new_rdr_env
++ , let name = gre_name gre
++ , nameIsFromExternalPackage this_pkg name
++ , isTcOcc (nameOccName name) -- Types and classes only
++ , unQualOK gre ] -- In scope unqualified
++
+ liftIO $ mapM_ putStrLn msg
+ dflags <- getDynFlags
+ let (haddockable, haddocked) = ifaceHaddockCoverage interface
+@@ -220,7 +232,7 @@ processModule verbosity modsum flags mod
+ unless header $ out verbosity normal " Module header"
+ mapM_ (out verbosity normal . (" " ++)) undocumentedExports
+ interface' <- liftIO $ evaluate interface
+- return (Just interface')
++ return (Just (interface', mods))
+ else
+ return Nothing
+
+Index: b/utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
+===================================================================
+--- a/utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
++++ b/utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
+@@ -1,4 +1,4 @@
+-{-# LANGUAGE CPP, MagicHash #-}
++{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
+ {-# LANGUAGE TypeFamilies #-}
+ -----------------------------------------------------------------------------
+ -- |
+@@ -34,6 +34,7 @@ import FamInstEnv
+ import FastString
+ import GHC
+ import InstEnv
++import Module ( ModuleSet, moduleSetElts )
+ import MonadUtils (liftIO)
+ import Name
+ import NameEnv
+@@ -51,11 +52,13 @@ type Modules = Set.Set Module
+ type ExportInfo = (ExportedNames, Modules)
+
+ -- Also attaches fixities
+-attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]
+-attachInstances expInfo ifaces instIfaceMap = do
+- (_msgs, mb_index) <- getNameToInstancesIndex (map ifaceMod ifaces)
++attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> ModuleSet -> Ghc [Interface]
++attachInstances expInfo ifaces instIfaceMap mods = do
++ (_msgs, mb_index) <- getNameToInstancesIndex2 (map ifaceMod ifaces) mods'
+ mapM (attach $ fromMaybe emptyNameEnv mb_index) ifaces
+ where
++ mods' = Just (moduleSetElts mods)
++
+ -- TODO: take an IfaceMap as input
+ ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]
+
=====================================
p/ghc/debian/patches/series
=====================================
@@ -13,3 +13,4 @@ risc-support.patch
armel-revert-ghci-fixes.patch
fix-build-using-unregisterized-v8.2
add_-latomic_to_ghc-prim
+haddock-out-of-memory.patch
=====================================
p/ghc/debian/watch
=====================================
@@ -1,4 +1,4 @@
version=3
-opts=pgpsigurlmangle=s/$/.sig/,dirversionmangle=s/-rc/~rc/ \
+opts="pgpsigurlmangle=s/$/.sig/,dirversionmangle=s/-rc/~rc/,repacksuffix=+dfsg1,dversionmangle=s/\+dfsg\d*$//" \
https://downloads.haskell.org/~ghc/(\d[\d.rc-]*)/ghc-(\d[\d.]*)-src.tar.(?:bz2|xz|gz)
View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/compare/e29b92f5a3ac07b1baa9031f9b3e152bcc4de3fe...fcfb99beb8c98090d034643af06b91cf2205b769
--
View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/compare/e29b92f5a3ac07b1baa9031f9b3e152bcc4de3fe...fcfb99beb8c98090d034643af06b91cf2205b769
You're receiving this email because of your account on salsa.debian.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://alioth-lists.debian.net/pipermail/pkg-haskell-commits/attachments/20180924/9fd7e090/attachment-0001.html>
More information about the Pkg-haskell-commits
mailing list