From 36aa7cf1c29e3acc9bc15b3bd8fc17d3ece50397 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 10 May 2024 10:32:07 +0200
Subject: [PATCH] Add run-time configurability of `.hi` file compression
Introduce the flag `-fwrite-if-compression=<n>` which allows to
configure the compression level of writing .hi files.
The motivation is that some deduplication operations are too expensive
for the average use case. Hence, we introduce multiple compression
levels with variable impact on performance, but still reduce the
memory residency and `.hi` file size on disk considerably.
We introduce three compression levels:
* `1`: `Normal` mode. This is the least amount of compression.
It deduplicates only `Name` and `FastString`s, and is naturally the
fastest compression mode.
* `2`: `Safe` mode. It has a noticeable impact on .hi file size and is
marginally slower than `Normal` mode. In general, it should be safe to
always use `Safe` mode.
* `3`: `Full` deduplication mode. Deduplicate as much as we can,
resulting in minimal .hi files, but at the cost of additional
compilation time.
Reading .hi files doesn't need to know the initial compression level,
and can always deserialise a `ModIface`, as we write out a byte that
indicates the next value has been deduplicated.
This allows users to experiment with different compression levels for
packages, without recompilation of dependencies.
Note, the deduplication also has an additional side effect of reduced
memory consumption to implicit sharing of deduplicated elements.
See https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for example where
that matters.
-------------------------
Metric Decrease:
MultiLayerModulesDefsGhciWithCore
T16875
T21839c
T24471
hard_hole_fits
libdir
-------------------------
---
compiler/GHC/Driver/DynFlags.hs | 2 +
compiler/GHC/Driver/Main.hs | 4 +-
compiler/GHC/Driver/Session.hs | 3 +
compiler/GHC/Iface/Binary.hs | 83 +++++++++++++++++++------
compiler/GHC/Iface/Ext/Binary.hs | 34 ++++------
compiler/GHC/Iface/Load.hs | 15 ++++-
compiler/GHC/Iface/Type.hs | 43 ++++++++++---
docs/users_guide/using-optimisation.rst | 20 ++++++
8 files changed, 149 insertions(+), 55 deletions(-)
diff --git a/compiler/GHC/Driver/DynFlags.hs b/compiler/GHC/Driver/DynFlags.hs
index c79b0e2dd9b3..85fb5c99dcb0 100644
--- a/compiler/GHC/Driver/DynFlags.hs
+++ b/compiler/GHC/Driver/DynFlags.hs
@@ -207,6 +207,7 @@ data DynFlags = DynFlags {
dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an
-- Unboxed demand on returned products with at most
-- this number of fields
+ ifCompression :: Int,
specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types
@@ -546,6 +547,7 @@ defaultDynFlags mySettings =
maxPmCheckModels = 30,
simplTickFactor = 100,
dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple
+ ifCompression = 2, -- Default: Apply safe compressions
specConstrThreshold = Just 2000,
specConstrCount = Just 3,
specConstrRecursive = 3,
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index e6d3e0339703..08e2aafb4364 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -163,7 +163,7 @@ import GHC.JS.Syntax
import GHC.IfaceToCore ( typecheckIface, typecheckWholeCoreBindings )
-import GHC.Iface.Load ( ifaceStats, writeIface )
+import GHC.Iface.Load ( ifaceStats, writeIface, flagsToIfCompression )
import GHC.Iface.Make
import GHC.Iface.Recomp
import GHC.Iface.Tidy
@@ -1207,7 +1207,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
withTiming logger
(text "WriteIface"<+>brackets (text iface_name))
(const ())
- (writeIface logger profile iface_name iface)
+ (writeIface logger profile (flagsToIfCompression dflags) iface_name iface)
if (write_interface || force_write_interface) then do
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 7b3a1bc0945f..5ee4dadbec22 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1718,6 +1718,9 @@ dynamic_flags_deps = [
, make_ord_flag defFlag "fno-refinement-level-hole-fits"
(noArg (\d -> d { refLevelHoleFits = Nothing }))
+ , make_ord_flag defFlag "fwrite-if-compression"
+ (intSuffix (\n d -> d { ifCompression = n }))
+
, make_dep_flag defGhcFlag "fllvm-pass-vectors-in-regs"
(noArg id)
"vectors registers are now passed in registers by default."
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 9abf76ce2c74..1d46ada3df20 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -14,6 +14,7 @@ module GHC.Iface.Binary (
writeBinIface,
readBinIface,
readBinIfaceHeader,
+ CompressionIFace(..),
getSymtabName,
CheckHiWay(..),
TraceBinIFace(..),
@@ -48,7 +49,7 @@ import GHC.Types.SrcLoc
import GHC.Platform
import GHC.Settings.Constants
import GHC.Utils.Fingerprint
-import GHC.Iface.Type (IfaceType, getIfaceType, putIfaceType)
+import GHC.Iface.Type (IfaceType(..), getIfaceType, putIfaceType, ifaceTypeSharedByte)
import Control.Monad
import Data.Array
@@ -73,6 +74,30 @@ data TraceBinIFace
= TraceBinIFace (SDoc -> IO ())
| QuietBinIFace
+-- | The compression/deduplication level of 'ModIface' files.
+--
+-- A 'ModIface' contains many duplicated symbols and names. To keep interface
+-- files small, we deduplicate them during serialisation.
+-- It is impossible to write an interface file with *no* compression/deduplication.
+--
+-- We support different levels of compression/deduplication, with different
+-- trade-offs for run-time performance and memory usage.
+-- If you don't have any specific requirements, then 'SafeExtraCompression' is a good default.
+data CompressionIFace
+ = NormalCompression
+ -- ^ Perform the normal compression operations,
+ -- such as deduplicating 'Name's and 'FastString's
+ | SafeExtraCompression
+ -- ^ Perform some extra compression steps that have minimal impact
+ -- on the run-time of 'ghc'.
+ --
+ -- This reduces the size of '.hi' files significantly in some cases
+ -- and reduces overall memory usage in certain scenarios.
+ | MaximumCompression
+ -- ^ Try to compress as much as possible.
+ --
+ -- Yields the smallest '.hi' files but at the cost of additional run-time.
+
-- | Read an interface file header, checking the magic number, version, and
-- way. Returns the hash of the source file and a BinHandle which points at the
-- start of the rest of the interface file data.
@@ -200,8 +225,8 @@ getTables name_cache bh = do
-- | Write an interface file.
--
-- See Note [Deduplication during iface binary serialisation] for details.
-writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO ()
-writeBinIface profile traceBinIface hi_path mod_iface = do
+writeBinIface :: Profile -> TraceBinIFace -> CompressionIFace -> FilePath -> ModIface -> IO ()
+writeBinIface profile traceBinIface compressionLevel hi_path mod_iface = do
bh <- openBinMem initBinMemSize
let platform = profilePlatform profile
put_ bh (binaryInterfaceMagic platform)
@@ -215,7 +240,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do
extFields_p_p <- tellBinWriter bh
put_ bh extFields_p_p
- putWithUserData traceBinIface bh mod_iface
+ putWithUserData traceBinIface compressionLevel bh mod_iface
extFields_p <- tellBinWriter bh
putAt bh extFields_p_p extFields_p
@@ -229,9 +254,9 @@ writeBinIface profile traceBinIface hi_path mod_iface = do
-- is necessary if you want to serialise Names or FastStrings.
-- It also writes a symbol table and the dictionary.
-- This segment should be read using `getWithUserData`.
-putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO ()
-putWithUserData traceBinIface bh payload = do
- (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload)
+putWithUserData :: Binary a => TraceBinIFace -> CompressionIFace -> WriteBinHandle -> a -> IO ()
+putWithUserData traceBinIface compressionLevel bh payload = do
+ (name_count, fs_count, ifacetype_count, _b) <- putWithTables compressionLevel bh (\bh' -> put bh' payload)
case traceBinIface of
QuietBinIFace -> return ()
@@ -240,26 +265,30 @@ putWithUserData traceBinIface bh payload = do
<+> text "Names")
printer (text "writeBinIface:" <+> int fs_count
<+> text "dict entries")
+ printer (text "writeBinIface:" <+> int ifacetype_count
+ <+> text "dict entries")
--- | Write name/symbol tables
+-- | Write name/symbol/ifacetype tables
--
--- 1. setup the given BinHandle with Name/FastString table handling
+-- 1. setup the given BinHandle with Name/FastString/IfaceType table handling
-- 2. write the following
-- - FastString table pointer
-- - Name table pointer
+-- - IfaceType table pointer
-- - payload
+-- - IfaceType table
-- - Name table
-- - FastString table
--
--- It returns (number of names, number of FastStrings, payload write result)
+-- It returns (number of names, number of FastStrings, number of IfaceTypes, payload write result)
--
-- See Note [Order of deduplication tables during iface binary serialisation]
-putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b)
-putWithTables bh' put_payload = do
+putWithTables :: CompressionIFace -> WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, Int, b)
+putWithTables compressionLevel bh' put_payload = do
-- Initialise deduplicating tables.
(fast_wt, fsWriter) <- initFastStringWriterTable
(name_wt, nameWriter) <- initNameWriterTable
- (ifaceType_wt, ifaceTypeWriter) <- initWriteIfaceType
+ (ifaceType_wt, ifaceTypeWriter) <- initWriteIfaceType compressionLevel
-- Initialise the 'WriterUserData'.
let writerUserData = mkWriterUserData
@@ -275,14 +304,14 @@ putWithTables bh' put_payload = do
]
let bh = setWriterUserData bh' writerUserData
- (fs_count : name_count : _, r) <-
+ ([fs_count, name_count, ifacetype_count] , r) <-
-- The order of these entries matters!
--
-- See Note [Order of deduplication tables during iface binary serialisation] for details.
putAllTables bh [fast_wt, name_wt, ifaceType_wt] $ do
put_payload bh
- return (name_count, fs_count, r)
+ return (name_count, fs_count, ifacetype_count, r)
-- | Write all deduplication tables to disk after serialising the
-- main payload.
@@ -526,15 +555,33 @@ initReadIfaceTypeTable ud = do
, mkReaderFromTable = \tbl -> mkReader (getGenericSymtab tbl)
}
-initWriteIfaceType :: IO (WriterTable, BinaryWriter IfaceType)
-initWriteIfaceType = do
+initWriteIfaceType :: CompressionIFace -> IO (WriterTable, BinaryWriter IfaceType)
+initWriteIfaceType compressionLevel = do
sym_tab <- initGenericSymbolTable @(Map IfaceType)
pure
( WriterTable
{ putTable = putGenericSymbolTable sym_tab (lazyPut' putIfaceType)
}
- , mkWriter $ putGenericSymTab sym_tab
+ , mkWriter $ ifaceWriter sym_tab
)
+ where
+ ifaceWriter sym_tab = case compressionLevel of
+ NormalCompression -> literalIfaceTypeSerialiser
+ SafeExtraCompression -> ifaceTyConAppSerialiser sym_tab
+ MaximumCompression -> fullIfaceTypeSerialiser sym_tab
+
+ ifaceTyConAppSerialiser sym_tab bh ty = case ty of
+ IfaceTyConApp {} -> do
+ put_ bh ifaceTypeSharedByte
+ putGenericSymTab sym_tab bh ty
+ _ -> putIfaceType bh ty
+
+
+ fullIfaceTypeSerialiser sym_tab bh ty = do
+ put_ bh ifaceTypeSharedByte
+ putGenericSymTab sym_tab bh ty
+
+ literalIfaceTypeSerialiser = putIfaceType
initNameReaderTable :: NameCache -> IO (ReaderTable Name)
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 3b117b4d9a97..276c709627c4 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -15,20 +15,24 @@ module GHC.Iface.Ext.Binary
)
where
+import GHC.Prelude
+
+import GHC.Builtin.Utils
import GHC.Settings.Utils ( maybeRead )
import GHC.Settings.Config ( cProjectVersion )
-import GHC.Prelude
import GHC.Utils.Binary
import GHC.Data.FastMutInt
import GHC.Data.FastString ( FastString )
+import GHC.Iface.Ext.Types
+import GHC.Iface.Binary ( putAllTables )
import GHC.Types.Name
import GHC.Types.Name.Cache
-import GHC.Utils.Outputable
-import GHC.Utils.Panic
-import GHC.Builtin.Utils
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Unique
import GHC.Types.Unique.FM
+import qualified GHC.Utils.Binary as Binary
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
import qualified Data.Array as A
import qualified Data.Array.IO as A
@@ -42,12 +46,6 @@ import Control.Monad ( replicateM, when, forM_, foldM )
import System.Directory ( createDirectoryIfMissing )
import System.FilePath ( takeDirectory )
-import GHC.Iface.Ext.Types
-import GHC.Iface.Binary (initWriteIfaceType, putAllTables, initReadIfaceTypeTable)
-import GHC.Iface.Type (IfaceType)
-import System.IO.Unsafe (unsafeInterleaveIO)
-import qualified GHC.Utils.Binary as Binary
-
data HieSymbolTable = HieSymbolTable
{ hie_symtab_next :: !FastMutInt
, hie_symtab_map :: !(IORef (UniqFM Name (Int, HieName)))
@@ -72,7 +70,7 @@ putBinLine bh xs = do
putByte bh 10 -- newline char
-- | Write a `HieFile` to the given `FilePath`, with a proper header and
--- symbol tables for `Name`s and `FastString`s
+-- symbol tables for `Name`s and `FastString`s.
writeHieFile :: FilePath -> HieFile -> IO ()
writeHieFile hie_file_path hiefile = do
bh0 <- openBinMem initBinMemSize
@@ -85,18 +83,16 @@ writeHieFile hie_file_path hiefile = do
(fs_tbl, fs_w) <- initFastStringWriterTable
(name_tbl, name_w) <- initWriteNameTable
- (iface_tbl, iface_w) <- initWriteIfaceType
let bh = setWriterUserData bh0 $ mkWriterUserData
- [ mkSomeBinaryWriter @IfaceType iface_w
- , mkSomeBinaryWriter @Name name_w
+ [ mkSomeBinaryWriter @Name name_w
, mkSomeBinaryWriter @BindingName (simpleBindingNameWriter name_w)
, mkSomeBinaryWriter @FastString fs_w
]
-- Discard number of written elements
-- Order matters! See Note [Order of deduplication tables during iface binary serialisation]
- _ <- putAllTables bh [fs_tbl, name_tbl, iface_tbl] $ do
+ _ <- putAllTables bh [fs_tbl, name_tbl] $ do
put_ bh hiefile
-- and send the result to the file
@@ -215,14 +211,8 @@ readHieFileHeader file bh0 = do
readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile
readHieFileContents bh0 name_cache = do
- bhRef <- newIORef (error "used too soon")
- -- It is important this is passed to 'getTable'
- -- See Note [Lazy ReaderUserData during IfaceType serialisation]
- ud <- unsafeInterleaveIO (readIORef bhRef)
-
fsReaderTable <- initFastStringReaderTable
nameReaderTable <- initReadNameTable name_cache
- ifaceTypeReaderTable <- initReadIfaceTypeTable ud
-- read the symbol table so we are capable of reading the actual data
bh1 <-
@@ -232,10 +222,8 @@ readHieFileContents bh0 name_cache = do
-- See Note [Order of deduplication tables during iface binary serialisation] for details.
[ get_dictionary fsReaderTable
, get_dictionary nameReaderTable
- , get_dictionary ifaceTypeReaderTable
]
- writeIORef bhRef (getReaderUserData bh1)
-- load the actual data
get bh1
where
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 04a7d9331a7e..31f79ca52038 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -26,6 +26,7 @@ module GHC.Iface.Load (
loadInterface,
loadSysInterface, loadUserInterface, loadPluginInterface,
findAndReadIface, readIface, writeIface,
+ flagsToIfCompression,
moduleFreeHolesPrecise,
needWiredInHomeIface, loadWiredInHomeIface,
@@ -965,11 +966,19 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do
-- | Write interface file
-writeIface :: Logger -> Profile -> FilePath -> ModIface -> IO ()
-writeIface logger profile hi_file_path new_iface
+writeIface :: Logger -> Profile -> CompressionIFace -> FilePath -> ModIface -> IO ()
+writeIface logger profile compression_level hi_file_path new_iface
= do createDirectoryIfMissing True (takeDirectory hi_file_path)
let printer = TraceBinIFace (debugTraceMsg logger 3)
- writeBinIface profile printer hi_file_path new_iface
+ writeBinIface profile printer compression_level hi_file_path new_iface
+
+flagsToIfCompression :: DynFlags -> CompressionIFace
+flagsToIfCompression dflags
+ | n <= 1 = NormalCompression
+ | n == 2 = SafeExtraCompression
+ -- n >= 3
+ | otherwise = MaximumCompression
+ where n = ifCompression dflags
-- | @readIface@ tries just the one file.
--
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 9605e712cfba..bf219a8bbb4b 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -34,7 +34,7 @@ module GHC.Iface.Type (
ifTyConBinderVar, ifTyConBinderName,
-- Binary utilities
- putIfaceType, getIfaceType,
+ putIfaceType, getIfaceType, ifaceTypeSharedByte,
-- Equality testing
isIfaceLiftedTypeKind,
@@ -92,12 +92,13 @@ import GHC.Utils.Misc
import GHC.Utils.Panic
import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar )
-import Control.DeepSeq
+import Data.Maybe (isJust)
import Data.Proxy
-import Control.Monad ((<$!>))
-import Control.Arrow (first)
import qualified Data.Semigroup as Semi
-import Data.Maybe (isJust)
+import Data.Word (Word8)
+import Control.Arrow (first)
+import Control.DeepSeq
+import Control.Monad ((<$!>))
{-
************************************************************************
@@ -2225,12 +2226,36 @@ ppr_parend_preds :: [IfacePredType] -> SDoc
ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))
instance Binary IfaceType where
- put_ bh tyCon = case findUserDataWriter Proxy bh of
- tbl -> putEntry tbl bh tyCon
+ put_ bh ty =
+ case findUserDataWriter Proxy bh of
+ tbl -> putEntry tbl bh ty
- get bh = case findUserDataReader Proxy bh of
- tbl -> getEntry tbl bh
+ get bh = getIfaceTypeShared bh
+-- | This is the byte tag we expect to read when the next
+-- value is not an 'IfaceType' value, but an offset into a
+-- lookup table.
+-- See Note [Deduplication during iface binary serialisation].
+--
+-- Must not overlap with any byte tag in 'getIfaceType'.
+ifaceTypeSharedByte :: Word8
+ifaceTypeSharedByte = 99
+
+-- | Like 'getIfaceType' but checks for a specific byte tag
+-- that indicates that we won't be able to read a 'IfaceType' value
+-- but rather an offset into a lookup table. Consequentially,
+-- we look up the value for the 'IfaceType' in the look up table.
+--
+-- See Note [Deduplication during iface binary serialisation]
+-- for details.
+getIfaceTypeShared :: ReadBinHandle -> IO IfaceType
+getIfaceTypeShared bh = do
+ start <- tellBinReader bh
+ tag <- getByte bh
+ if ifaceTypeSharedByte == tag
+ then case findUserDataReader Proxy bh of
+ tbl -> getEntry tbl bh
+ else seekBinReader bh start >> getIfaceType bh
-- | Serialises an 'IfaceType' to the given 'WriteBinHandle'.
--
diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst
index fc777f3381e0..fbb254b10c6d 100644
--- a/docs/users_guide/using-optimisation.rst
+++ b/docs/users_guide/using-optimisation.rst
@@ -1814,3 +1814,23 @@ as such you shouldn't need to set any of them explicitly. A flag
This flag sets the size (in bytes) threshold above which the second approach
is used. You can disable the second approach entirely by setting the
threshold to 0.
+
+.. ghc-flag:: -fwrite-if-compression=⟨n⟩
+ :shortdesc: *default: 2.* Tweak the level of interface file compression.
+ :type: dynamic
+ :category: optimization
+
+ :default: 2
+
+ This flag defines the level of compression of interface files when writing to disk.
+ The higher the flag, the more we deduplicate the interface file, at the cost of a higher compilation time.
+ Deduplication (when applied to :ghc-flag:`--make` mode and :ghc-flag:`--interactive` mode) decreases the size of interface files as well as reducing
+ the overall memory usage of GHC.
+
+ Compression cannot be fully turned off, GHC always compresses interface files to a certain degree.
+ Currently, we support values of ``1``, ``2`` and ``3``.
+ Lower or higher values are clamped to ``1`` and ``3`` respectively.
+
+ * ``1``: Compress as little as possible. No run-time impact, at the cost of interface file size and memory usage.
+ * ``2``: Apply compression with minimal run-time overhead, reducing the interface file size and memory usage.
+ * ``3``: Apply all possible compressions, minimal interface file sizes and memory usage, at the cost of run-time overhead.
--
GitLab