Commit 7036fde9 authored by Simon Marlow's avatar Simon Marlow
Browse files

Overhaul of Compact Regions (#12455)

Summary:
This commit makes various improvements and addresses some issues with
Compact Regions (aka Compact Normal Forms).

This was the most important thing I wanted to fix.  Compaction
previously prevented GC from running until it was complete, which
would be a problem in a multicore setting.  Now, we compact using a
hand-written Cmm routine that can be interrupted at any point.  When a
GC is triggered during a sharing-enabled compaction, the GC has to
traverse and update the hash table, so this hash table is now stored
in the StgCompactNFData object.

Previously, compaction consisted of a deepseq using the NFData class,
followed by a traversal in C code to copy the data.  This is now done
in a single pass with hand-written Cmm (see rts/Compact.cmm). We no
longer use the NFData instances, instead the Cmm routine evaluates
components directly as it compacts.

The new compaction is about 50% faster than the old one with no
sharing, and a little faster on average with sharing (the cost of the
hash table dominates when we're doing sharing).

Static objects that don't (transitively) refer to any CAFs don't need
to be copied into the compact region.  In particular this means we
often avoid copying Char values and small Int values, because these
are static closures in the runtime.

Each Compact# object can support a single compactAdd# operation at any
given time, so the Data.Compact library now enforces mutual exclusion
using an MVar stored in the Compact object.

We now get exceptions rather than killing everything with a barf()
when we encounter an object that cannot be compacted (a function, or a
mutable object).  We now also detect pinned objects, which can't be
compacted either.

The Data.Compact API has been refactored and cleaned up.  A new
compactSize operation returns the size (in bytes) of the compact
object.

Most of the documentation is in the Haddock docs for the compact
library, which I've expanded and improved here.

Various comments in the code have been improved, especially the main
Note [Compact Normal Forms] in rts/sm/CNF.c.

I've added a few tests, and expanded a few of the tests that were
there.  We now also run the tests with GHCi, and in a new test way
that enables sanity checking (+RTS -DS).

There's a benchmark in libraries/compact/tests/compact_bench.hs for
measuring compaction speed and comparing sharing vs. no sharing.

The field totalDataW in StgCompactNFData was unnecessary.

Test Plan:
* new unit tests
* validate
* tested manually that we can compact Data.Aeson data

Reviewers: gcampax, bgamari, ezyang, austin, niteria, hvr, erikd

Subscribers: thomie, simonpj

Differential Revision: https://phabricator.haskell.org/D2751

GHC Trac Issues: #12455
parent 4dd6b37f
...@@ -2444,14 +2444,6 @@ primop CompactNewOp "compactNew#" GenPrimOp ...@@ -2444,14 +2444,6 @@ primop CompactNewOp "compactNew#" GenPrimOp
has_side_effects = True has_side_effects = True
out_of_line = True out_of_line = True
primop CompactAppendOp "compactAppend#" GenPrimOp
Compact# -> a -> Int# -> State# RealWorld -> (# State# RealWorld, a #)
{ Append an object to a compact, return the new address in the Compact.
The third argument is 1 if sharing should be preserved, 0 otherwise. }
with
has_side_effects = True
out_of_line = True
primop CompactResizeOp "compactResize#" GenPrimOp primop CompactResizeOp "compactResize#" GenPrimOp
Compact# -> Word# -> State# RealWorld -> Compact# -> Word# -> State# RealWorld ->
State# RealWorld State# RealWorld
...@@ -2515,6 +2507,34 @@ primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp ...@@ -2515,6 +2507,34 @@ primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp
has_side_effects = True has_side_effects = True
out_of_line = True out_of_line = True
primop CompactAdd "compactAdd#" GenPrimOp
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
{ Recursively add a closure and its transitive closure to a
{\texttt Compact\#}, evaluating any unevaluated components at the
same time. Note: {\texttt compactAdd\#} is not thread-safe, so
only one thread may call {\texttt compactAdd\#} with a particular
{\texttt Compact#} at any given time. The primop does not
enforce any mutual exclusion; the caller is expected to
arrange this. }
with
has_side_effects = True
out_of_line = True
primop CompactAddWithSharing "compactAddWithSharing#" GenPrimOp
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
{ Like {\texttt compactAdd\#}, but retains sharing and cycles
during compaction. }
with
has_side_effects = True
out_of_line = True
primop CompactSize "compactSize#" GenPrimOp
Compact# -> State# RealWorld -> (# State# RealWorld, Word# #)
{ Return the size (in bytes) of the total amount of data in the Compact# }
with
has_side_effects = True
out_of_line = True
------------------------------------------------------------------------ ------------------------------------------------------------------------
section "Unsafe pointer equality" section "Unsafe pointer equality"
-- (#1 Bad Guy: Alastair Reid :) -- (#1 Bad Guy: Alastair Reid :)
......
...@@ -311,6 +311,13 @@ Use a bigger heap! ...@@ -311,6 +311,13 @@ Use a bigger heap!
consume, or perhaps try passing :ghc-flag:`-H` without any argument to let GHC consume, or perhaps try passing :ghc-flag:`-H` without any argument to let GHC
calculate a value based on the amount of live data. calculate a value based on the amount of live data.
Compact your data:
The ``Data.Compact`` library (in the ``compact`` package) provides
a way to make garbage collection more efficient for long-lived
data structures. Compacting a data structure collects the objects
together in memory, where they are treated as a single object by
the garbage collector and not traversed individually.
.. _smaller: .. _smaller:
Smaller: producing a program that is smaller Smaller: producing a program that is smaller
......
...@@ -95,6 +95,7 @@ typedef struct _DEBUG_FLAGS { ...@@ -95,6 +95,7 @@ typedef struct _DEBUG_FLAGS {
bool hpc; /* 'c' coverage */ bool hpc; /* 'c' coverage */
bool sparks; /* 'r' */ bool sparks; /* 'r' */
bool numa; /* '--debug-numa' */ bool numa; /* '--debug-numa' */
bool compact; /* 'C' */
} DEBUG_FLAGS; } DEBUG_FLAGS;
/* See Note [Synchronization of flags and base APIs] */ /* See Note [Synchronization of flags and base APIs] */
......
...@@ -421,12 +421,6 @@ closure_sizeW_ (const StgClosure *p, const StgInfoTable *info) ...@@ -421,12 +421,6 @@ closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)
return bco_sizeW((StgBCO *)p); return bco_sizeW((StgBCO *)p);
case TREC_CHUNK: case TREC_CHUNK:
return sizeofW(StgTRecChunk); return sizeofW(StgTRecChunk);
case COMPACT_NFDATA:
// Nothing should ever call closure_sizeW() on a StgCompactNFData
// because CompactNFData is a magical object/list-of-objects that
// requires special paths pretty much everywhere in the GC
barf("closure_sizeW() called on a StgCompactNFData. "
"This should never happen.");
default: default:
return sizeW_fromITBL(info); return sizeW_fromITBL(info);
} }
......
...@@ -419,49 +419,61 @@ typedef struct MessageBlackHole_ { ...@@ -419,49 +419,61 @@ typedef struct MessageBlackHole_ {
StgClosure *bh; StgClosure *bh;
} MessageBlackHole; } MessageBlackHole;
// This is not a closure, it a bare /* ----------------------------------------------------------------------------
// structure that lives at the beginning of Compact Regions
// each consecutive block group in a ------------------------------------------------------------------------- */
// compact structure
//
// A compact region is a list of blocks. Each block starts with an
// StgCompactNFDataBlock structure, and the list is chained through the next
// field of these structs. (the link field of the bdescr is used to chain
// together multiple compact region on the compact_objects field of a
// generation).
// //
// See Note [Compact Normal Forms] for details // See Note [Compact Normal Forms] for details
//
typedef struct StgCompactNFDataBlock_ { typedef struct StgCompactNFDataBlock_ {
struct StgCompactNFDataBlock_ *self; // the address of this block struct StgCompactNFDataBlock_ *self;
// this is copied over to the receiving // the address of this block this is copied over to the
// end when serializing a compact, so // receiving end when serializing a compact, so the receiving
// the receiving end can allocate the // end can allocate the block at best as it can, and then
// block at best as it can, and then // verify if pointer adjustment is needed or not by comparing
// verify if pointer adjustment is // self with the actual address; the same data is sent over as
// needed or not by comparing self with // SerializedCompact metadata, but having it here simplifies
// the actual address; the same data // the fixup implementation.
// is sent over as SerializedCompact struct StgCompactNFData_ *owner;
// metadata, but having it here // the closure who owns this block (used in objectGetCompact)
// simplifies the fixup implementation struct StgCompactNFDataBlock_ *next;
struct StgCompactNFData_ *owner; // the closure who owns this // chain of blocks used for serialization and freeing
// block (used in objectGetCompact)
struct StgCompactNFDataBlock_ *next; // chain of blocks used for
// serialization and freeing
} StgCompactNFDataBlock; } StgCompactNFDataBlock;
//
// This is the Compact# primitive object.
//
typedef struct StgCompactNFData_ { typedef struct StgCompactNFData_ {
StgHeader header; // for sanity and other checks in practice, StgHeader header;
// nothing should ever need the compact info // for sanity and other checks in practice, nothing should ever
// pointer (we don't even need fwding // need the compact info pointer (we don't even need fwding
// pointers because it's a large object) // pointers because it's a large object)
StgWord totalW; // for proper accounting in evac, includes StgWord totalW;
// slop, and removes the first block in // Total number of words in all blocks in the compact
// larger than megablock allocation StgWord autoBlockW;
// essentially meaningless, but if we got it // size of automatically appended blocks
// wrong sanity would complain loudly StgPtr hp, hpLim;
StgWord totalDataW; // for stats/profiling only, it's the // the beginning and end of the free area in the nursery block. This is
// full amount of memory used by this // just a convenience so that we can avoid multiple indirections through
// compact, including the portions not // the nursery pointer below during compaction.
// yet used StgCompactNFDataBlock *nursery;
StgWord autoBlockW; // size of automatically appended blocks // where to (try to) allocate from when appending
StgCompactNFDataBlock *nursery; // where to (try to) allocate from when StgCompactNFDataBlock *last;
// appending // the last block of the chain (to know where to append new
StgCompactNFDataBlock *last; // the last block of the chain (to know where // blocks for resize)
// to append new blocks for resize) struct hashtable *hash;
// the hash table for the current compaction, or NULL if
// there's no (sharing-preserved) compaction in progress.
StgClosure *result;
// Used temporarily to store the result of compaction. Doesn't need to be
// a GC root.
} StgCompactNFData; } StgCompactNFData;
......
...@@ -151,7 +151,8 @@ RTS_ENTRY(stg_END_STM_WATCH_QUEUE); ...@@ -151,7 +151,8 @@ RTS_ENTRY(stg_END_STM_WATCH_QUEUE);
RTS_ENTRY(stg_END_INVARIANT_CHECK_QUEUE); RTS_ENTRY(stg_END_INVARIANT_CHECK_QUEUE);
RTS_ENTRY(stg_END_STM_CHUNK_LIST); RTS_ENTRY(stg_END_STM_CHUNK_LIST);
RTS_ENTRY(stg_NO_TREC); RTS_ENTRY(stg_NO_TREC);
RTS_ENTRY(stg_COMPACT_NFDATA); RTS_ENTRY(stg_COMPACT_NFDATA_CLEAN);
RTS_ENTRY(stg_COMPACT_NFDATA_DIRTY);
/* closures */ /* closures */
...@@ -411,6 +412,8 @@ RTS_FUN_DECL(stg_makeStableNamezh); ...@@ -411,6 +412,8 @@ RTS_FUN_DECL(stg_makeStableNamezh);
RTS_FUN_DECL(stg_makeStablePtrzh); RTS_FUN_DECL(stg_makeStablePtrzh);
RTS_FUN_DECL(stg_deRefStablePtrzh); RTS_FUN_DECL(stg_deRefStablePtrzh);
RTS_FUN_DECL(stg_compactAddzh);
RTS_FUN_DECL(stg_compactAddWithSharingzh);
RTS_FUN_DECL(stg_compactNewzh); RTS_FUN_DECL(stg_compactNewzh);
RTS_FUN_DECL(stg_compactAppendzh); RTS_FUN_DECL(stg_compactAppendzh);
RTS_FUN_DECL(stg_compactResizzezh); RTS_FUN_DECL(stg_compactResizzezh);
...@@ -421,6 +424,7 @@ RTS_FUN_DECL(stg_compactGetFirstBlockzh); ...@@ -421,6 +424,7 @@ RTS_FUN_DECL(stg_compactGetFirstBlockzh);
RTS_FUN_DECL(stg_compactGetNextBlockzh); RTS_FUN_DECL(stg_compactGetNextBlockzh);
RTS_FUN_DECL(stg_compactAllocateBlockzh); RTS_FUN_DECL(stg_compactAllocateBlockzh);
RTS_FUN_DECL(stg_compactFixupPointerszh); RTS_FUN_DECL(stg_compactFixupPointerszh);
RTS_FUN_DECL(stg_compactSizzezh);
RTS_FUN_DECL(stg_forkzh); RTS_FUN_DECL(stg_forkzh);
RTS_FUN_DECL(stg_forkOnzh); RTS_FUN_DECL(stg_forkOnzh);
......
...@@ -49,6 +49,7 @@ module Control.Exception ( ...@@ -49,6 +49,7 @@ module Control.Exception (
BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..), BlockedIndefinitelyOnSTM(..),
AllocationLimitExceeded(..), AllocationLimitExceeded(..),
CompactionFailed(..),
Deadlock(..), Deadlock(..),
NoMethodError(..), NoMethodError(..),
PatternMatchFail(..), PatternMatchFail(..),
......
...@@ -32,6 +32,7 @@ module Control.Exception.Base ( ...@@ -32,6 +32,7 @@ module Control.Exception.Base (
BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..), BlockedIndefinitelyOnSTM(..),
AllocationLimitExceeded(..), AllocationLimitExceeded(..),
CompactionFailed(..),
Deadlock(..), Deadlock(..),
NoMethodError(..), NoMethodError(..),
PatternMatchFail(..), PatternMatchFail(..),
......
...@@ -24,6 +24,8 @@ module GHC.IO.Exception ( ...@@ -24,6 +24,8 @@ module GHC.IO.Exception (
Deadlock(..), Deadlock(..),
AllocationLimitExceeded(..), allocationLimitExceeded, AllocationLimitExceeded(..), allocationLimitExceeded,
AssertionFailed(..), AssertionFailed(..),
CompactionFailed(..),
cannotCompactFunction, cannotCompactPinned, cannotCompactMutable,
SomeAsyncException(..), SomeAsyncException(..),
asyncExceptionToException, asyncExceptionFromException, asyncExceptionToException, asyncExceptionFromException,
...@@ -127,6 +129,35 @@ allocationLimitExceeded = toException AllocationLimitExceeded ...@@ -127,6 +129,35 @@ allocationLimitExceeded = toException AllocationLimitExceeded
----- -----
-- |Compaction found an object that cannot be compacted. Functions
-- cannot be compacted, nor can mutable objects or pinned objects.
-- See 'Data.Compact.compact'.
--
-- @since 4.10.0.0
data CompactionFailed = CompactionFailed String
-- | @since 4.10.0.0
instance Exception CompactionFailed where
-- | @since 4.10.0.0
instance Show CompactionFailed where
showsPrec _ (CompactionFailed why) =
showString ("compaction failed: " ++ why)
cannotCompactFunction :: SomeException -- for the RTS
cannotCompactFunction =
toException (CompactionFailed "cannot compact functions")
cannotCompactPinned :: SomeException -- for the RTS
cannotCompactPinned =
toException (CompactionFailed "cannot compact pinned objects")
cannotCompactMutable :: SomeException -- for the RTS
cannotCompactMutable =
toException (CompactionFailed "cannot compact mutable objects")
-----
-- |'assert' was applied to 'False'. -- |'assert' was applied to 'False'.
newtype AssertionFailed = AssertionFailed String newtype AssertionFailed = AssertionFailed String
......
...@@ -2,6 +2,7 @@ ...@@ -2,6 +2,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-} {-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-name-shadowing #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
...@@ -18,72 +19,102 @@ ...@@ -18,72 +19,102 @@
-- holding fully evaluated data in a consecutive block of memory. -- holding fully evaluated data in a consecutive block of memory.
-- --
-- /Since: 1.0.0/ -- /Since: 1.0.0/
module Data.Compact ( module Data.Compact (
-- * The Compact type
Compact, Compact,
-- * Compacting data
compact,
compactWithSharing,
compactAdd,
compactAddWithSharing,
-- * Inspecting a Compact
getCompact, getCompact,
inCompact, inCompact,
isCompact, isCompact,
compactSize,
newCompact, -- * Other utilities
newCompactNoShare, compactResize,
appendCompact,
appendCompactNoShare,
) where ) where
-- Write down all GHC.Prim deps explicitly to keep them at minimum import Control.Concurrent
import GHC.Prim (Compact#, import Control.DeepSeq (NFData)
compactNew#, import GHC.Prim
State#, import GHC.Types
RealWorld,
Int#, import Data.Compact.Internal as Internal
)
-- We need to import Word from GHC.Types to see the representation -- | Retrieve the object that was stored in a 'Compact'
-- and to able to access the Word# to pass down the primops
import GHC.Types (IO(..), Word(..))
import Control.DeepSeq (NFData, force)
import Data.Compact.Internal(Compact(..),
isCompact,
inCompact,
compactAppendEvaledInternal)
-- |Retrieve the object that was stored in a Compact
getCompact :: Compact a -> a getCompact :: Compact a -> a
getCompact (Compact _ obj) = obj getCompact (Compact _ obj _) = obj
compactAppendInternal :: NFData a => Compact# -> a -> Int# -> -- | Compact a value. /O(size of unshared data)/
State# RealWorld -> (# State# RealWorld, Compact a #) --
compactAppendInternal buffer root share s = -- If the structure contains any internal sharing, the shared data
case force root of -- will be duplicated during the compaction process. Loops if the
!eval -> compactAppendEvaledInternal buffer eval share s -- structure constains cycles.
--
compactAppendInternalIO :: NFData a => Int# -> Compact b -> a -> IO (Compact a) -- The NFData constraint is just to ensure that the object contains no
compactAppendInternalIO share (Compact buffer _) root = -- functions, 'compact' does not actually use it. If your object
IO (\s -> compactAppendInternal buffer root share s) -- contains any functions, then 'compact' will fail. (and your
-- 'NFData' instance is lying).
-- |Append a value to a 'Compact', and return a new 'Compact' --
-- that shares the same buffer but a different root object. compact :: NFData a => a -> IO (Compact a)
appendCompact :: NFData a => Compact b -> a -> IO (Compact a) compact = Internal.compactSized 31268 False
appendCompact = compactAppendInternalIO 1#
-- | Compact a value, retaining any internal sharing and
-- |Append a value to a 'Compact'. This function differs from -- cycles. /O(size of data)/
-- 'appendCompact' in that it will not preserve internal sharing --
-- in the passed in value (and it will diverge on cyclic structures). -- This is typically about 10x slower than 'compact', because it works
appendCompactNoShare :: NFData a => Compact b -> a -> IO (Compact a) -- by maintaining a hash table mapping uncompacted objects to
appendCompactNoShare = compactAppendInternalIO 0# -- compacted objects.
--
compactNewInternal :: NFData a => Int# -> Word -> a -> IO (Compact a) -- The 'NFData' constraint is just to ensure that the object contains no
compactNewInternal share (W# size) root = -- functions, `compact` does not actually use it. If your object
IO (\s -> case compactNew# size s of -- contains any functions, then 'compactWithSharing' will fail. (and
(# s', buffer #) -> compactAppendInternal buffer root share s' ) -- your 'NFData' instance is lying).
--
-- |Create a new 'Compact', with the provided value as suggested block compactWithSharing :: NFData a => a -> IO (Compact a)
-- size (which will be adjusted if unsuitable), and append the given compactWithSharing = Internal.compactSized 31268 True
-- value to it, as if calling 'appendCompact'
newCompact :: NFData a => Word -> a -> IO (Compact a) -- | Add a value to an existing 'Compact'. Behaves exactly like
newCompact = compactNewInternal 1# -- 'compact' with respect to sharing and the 'NFData' constraint.
compactAdd :: NFData a => Compact b -> a -> IO (Compact a)
-- |Create a new 'Compact', but append the value using 'appendCompactNoShare' compactAdd (Compact compact# _ lock) a = withMVar lock $ \_ -> IO $ \s ->
newCompactNoShare :: NFData a => Word -> a -> IO (Compact a) case compactAdd# compact# a s of { (# s1, pk #) ->
newCompactNoShare = compactNewInternal 0# (# s1, Compact compact# pk lock #) }
-- | Add a value to an existing 'Compact'. Behaves exactly like
-- 'compactWithSharing' with respect to sharing and the 'NFData'
-- constraint.
compactAddWithSharing :: NFData a => Compact b -> a -> IO (Compact a)
compactAddWithSharing (Compact compact# _ lock) a =
withMVar lock $ \_ -> IO $ \s ->
case compactAddWithSharing# compact# a s of { (# s1, pk #) ->
(# s1, Compact compact# pk lock #) }
-- | Check if the second argument is inside the 'Compact'
inCompact :: Compact b -> a -> IO Bool
inCompact (Compact buffer _ _) !val =
IO (\s -> case compactContains# buffer val s of
(# s', v #) -> (# s', isTrue# v #) )
-- | Check if the argument is in any 'Compact'
isCompact :: a -> IO Bool
isCompact !val =
IO (\s -> case compactContainsAny# val s of
(# s', v #) -> (# s', isTrue# v #) )
compactSize :: Compact a -> IO Word
compactSize (Compact buffer _ lock) = withMVar lock $ \_ -> IO $ \s0 ->
case compactSize# buffer s0 of (# s1, sz #) -> (# s1, W# sz #)
compactResize :: Compact a -> Word -> IO ()
compactResize (Compact oldBuffer _ lock) (W# new_size) =
withMVar lock $ \_ -> IO $ \s ->
case compactResize# oldBuffer new_size s of
s' -> (# s', () #)
<
{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-} {-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnboxedTuples #-}
...@@ -22,57 +21,82 @@ ...@@ -22,57 +21,82 @@
-- --
-- /Since: 1.0.0/ -- /Since: 1.0.0/
module Data.Compact.Internal( module Data.Compact.Internal
Compact(..), ( Compact(..)
compactResize, , mkCompact
isCompact, , compactSized
inCompact, ) where
compactAppendEvaledInternal, import Control.Concurrent.MVar
) where import Control.DeepSeq
import GHC.Prim
import GHC.Types
-- Write down all GHC.Prim deps explicitly to keep them at minimum -- | A 'Compact' contains fully evaluated, pure, immutable data.
import GHC.Prim (Compact#, --
compactAppend#, -- 'Compact' serves two purposes:
compactResize#, --
compactContains#, -- * Data stored in a 'Compact' has no garbage collection overhead.
compactContainsAny#, -- The garbage collector considers the whole 'Compact' to be alive
State#, -- if there is a reference to any object within it.
RealWorld, --
Int#, -- * A 'Compact' can be serialized, stored, and deserialized again.
) -- The serialized data can only be deserialized by the exact binary
-- We need to import Word from GHC.Types to see the representation -- that created it, but it can be stored indefinitely before
-- and to able to access the Word# to pass down the primops -- deserialization.
import GHC.Types (IO(..), Word(..), isTrue#) --
-- Compacts are self-contained, so compacting data involves copying
-- | A 'Compact' contains fully evaluated, pure, and immutable data. If -- it; if you have data that lives in two 'Compact's, each will have a
-- any object in the compact is alive, then the whole compact is -- separate copy of the data.
-- alive. This means that 'Compact's are very cheap to keep around, --
-- because the data inside a compact does not need to be traversed by -- The cost of compaction is similar to the cost of GC for the same
-- the garbage collector. However, the tradeoff is that the memory -- data, but it is perfomed only once. However, retainining internal
-- that contains a 'Compact' cannot be recovered until the whole 'Compact' -- sharing during the compaction process is very costly, so it is
-- is garbage. -- optional; there are two ways to create a 'Compact': 'compact' and
data Compact a = Compact Compact# a -- 'compactWithSharing'.
--
-- |Check if the second argument is inside the Compact -- Data can be added to an existing 'Compact' with 'compactAdd' or
inCompact :: Compact b -> a -> IO Bool -- 'compactAddWithSharing'.
inCompact (Compact buffer _) !val = --
IO (\s -> case compactContains# buffer val s of -- Data in a compact doesn't ever move, so compacting data is also a
(# s', v #) -> (# s', isTrue# v #) ) -- way to pin arbitrary data structures in memory.
--
-- |Check if the argument is in any Compact -- There are some limitations on what can be compacted:
isCompact :: a -> IO Bool --
isCompact !val = -- * Functions. Compaction only applies to data.
IO (\s -> case compactContainsAny# val s of --
(# s', v #) -> (# s', isTrue# v #) ) -- * Pinned 'ByteArray#' objects cannot be compacted. This is for a