Ilias Tsitsimpis · Ilias Tsitsimpis · fcfb99be · fcfb99be · fcfb99be · fcfb99be
--- a/p/ghc/debian/changelog
+++ b/p/ghc/debian/changelog
+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@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)

--- a/p/ghc/debian/copyright
+++ b/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@gmail.com>
 Source: https://downloads.haskell.org/~ghc/
+Files-Excluded: libraries/bytestring/tests/data

 Files: *
 License: BSD-3-clause

--- a/p/ghc/debian/patches/haddock-out-of-memory.patch
+++ b/p/ghc/debian/patches/haddock-out-of-memory.patch
+commit 18cb44dfae3f0847447da33c9d7a25d2709d838f
+Author: Alec Theriault <alec.theriault@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@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 ]
+ 
--- a/p/ghc/debian/patches/series
+++ b/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
--- a/p/ghc/debian/watch
+++ b/p/ghc/debian/watch
 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)