ghc-compact (empty) → 0.1.0.0
raw patch · 5 files changed
+570/−0 lines, 5 filesdep +basedep +bytestringdep +ghc-primsetup-changed
Dependencies added: base, bytestring, ghc-prim
Files
- GHC/Compact.hs +266/−0
- GHC/Compact/Serialized.hs +210/−0
- LICENSE +41/−0
- Setup.hs +6/−0
- ghc-compact.cabal +47/−0
+ GHC/Compact.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-name-shadowing #-}++-----------------------------------------------------------------------------+-- |+-- Module : GHC.Compact+-- Copyright : (c) The University of Glasgow 2001-2009+-- (c) Giovanni Campagna <gcampagn@cs.stanford.edu> 2014+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : libraries@haskell.org+-- Stability : unstable+-- Portability : non-portable (GHC Extensions)+--+-- This module provides a data structure, called a 'Compact', for+-- holding immutable, fully evaluated data in a consecutive block of memory.+-- Compact regions are good for two things:+--+-- 1. Data in a compact region is not traversed during GC; any+-- incoming pointer to a compact region keeps the entire region+-- live. Thus, if you put a long-lived data structure in a compact+-- region, you may save a lot of cycles during major collections,+-- since you will no longer be (uselessly) retraversing this+-- data structure.+--+-- 2. Because the data is stored contiguously, you can easily+-- dump the memory to disk and/or send it over the network.+-- For applications that are not bandwidth bound (GHC's heap+-- representation can be as much of a x4 expansion over a+-- binary serialization), this can lead to substantial speedups.+--+-- For example, suppose you have a function @loadBigStruct :: IO BigStruct@,+-- which loads a large data structure from the file system. You can "compact"+-- the structure with the following code:+--+-- @+-- do r <- 'compact' =<< loadBigStruct+-- let x = 'getCompact' r :: BigStruct+-- -- Do things with x+-- @+--+-- Note that 'compact' will not preserve internal sharing; use+-- 'compactWithSharing' (which is 10x slower) if you have cycles and/or+-- must preserve sharing. The 'Compact' pointer @r@ can be used+-- to add more data to a compact region; see 'compactAdd' or+-- 'compactAddWithSharing'.+--+-- The implementation of compact regions is described by:+--+-- * Edward Z. Yang, Giovanni Campagna, Ömer Ağacan, Ahmed El-Hassany, Abhishek+-- Kulkarni, Ryan Newton. \"/Efficient communication and Collection with Compact+-- Normal Forms/\". In Proceedings of the 20th ACM SIGPLAN International+-- Conference on Functional Programming. September 2015. <http://ezyang.com/compact.html>+--+-- This library is supported by GHC 8.2 and later.++module GHC.Compact (+ -- * The Compact type+ Compact(..),++ -- * Compacting data+ compact,+ compactWithSharing,+ compactAdd,+ compactAddWithSharing,++ -- * Inspecting a Compact+ getCompact,+ inCompact,+ isCompact,+ compactSize,++ -- * Other utilities+ compactResize,++ -- * Internal operations+ mkCompact,+ compactSized,+ ) where++import Control.Concurrent.MVar+import GHC.Prim+import GHC.Types++-- | A 'Compact' contains fully evaluated, pure, immutable data.+--+-- 'Compact' serves two purposes:+--+-- * Data stored in a 'Compact' has no garbage collection overhead.+-- The garbage collector considers the whole 'Compact' to be alive+-- if there is a reference to any object within it.+--+-- * A 'Compact' can be serialized, stored, and deserialized again.+-- The serialized data can only be deserialized by the exact binary+-- that created it, but it can be stored indefinitely before+-- deserialization.+--+-- Compacts are self-contained, so compacting data involves copying+-- it; if you have data that lives in two 'Compact's, each will have a+-- separate copy of the data.+--+-- The cost of compaction is similar to the cost of GC for the same+-- data, but it is performed only once. However, because+-- "GHC.Compact.compact" does not stop-the-world, retaining internal+-- sharing during the compaction process is very costly. The user+-- can choose whether to 'compact' or 'compactWithSharing'.+--+-- When you have a @'Compact' a@, you can get a pointer to the actual object+-- in the region using "GHC.Compact.getCompact". The 'Compact' type+-- serves as handle on the region itself; you can use this handle+-- to add data to a specific 'Compact' with 'compactAdd' or+-- 'compactAddWithSharing' (giving you a new handle which corresponds+-- to the same compact region, but points to the newly added object+-- in the region). At the moment, due to technical reasons,+-- it's not possible to get the @'Compact' a@ if you only have an @a@,+-- so make sure you hold on to the handle as necessary.+--+-- Data in a compact doesn't ever move, so compacting data is also a+-- way to pin arbitrary data structures in memory.+--+-- There are some limitations on what can be compacted:+--+-- * Functions. Compaction only applies to data.+--+-- * Pinned 'ByteArray#' objects cannot be compacted. This is for a+-- good reason: the memory is pinned so that it can be referenced by+-- address (the address might be stored in a C data structure, for+-- example), so we can't make a copy of it to store in the 'Compact'.+--+-- * Objects with mutable pointer fields (e.g. 'Data.IORef.IORef',+-- 'GHC.Array.MutableArray') also cannot be compacted, because subsequent+-- mutation would destroy the property that a compact is self-contained.+--+-- If compaction encounters any of the above, a 'CompactionFailed'+-- exception will be thrown by the compaction operation.+--+data Compact a = Compact Compact# a (MVar ())+ -- we can *read* from a Compact without taking a lock, but only+ -- one thread can be writing to the compact at any given time.+ -- The MVar here is to enforce mutual exclusion among writers.+ -- Note: the MVar protects the Compact# only, not the pure value 'a'++-- | Make a new 'Compact' object, given a pointer to the true+-- underlying region. You must uphold the invariant that @a@ lives+-- in the compact region.+--+mkCompact+ :: Compact# -> a -> State# RealWorld -> (# State# RealWorld, Compact a #)+mkCompact compact# a s =+ case unIO (newMVar ()) s of { (# s1, lock #) ->+ (# s1, Compact compact# a lock #) }+ where+ unIO (IO a) = a++-- | Transfer @a@ into a new compact region, with a preallocated size,+-- possibly preserving sharing or not. If you know how big the data+-- structure in question is, you can save time by picking an appropriate+-- block size for the compact region.+--+compactSized :: Int -> Bool -> a -> IO (Compact a)+compactSized (I# size) share a = IO $ \s0 ->+ case compactNew# (int2Word# size) s0 of { (# s1, compact# #) ->+ case compactAddPrim compact# a s1 of { (# s2, pk #) ->+ mkCompact compact# pk s2 }}+ where+ compactAddPrim+ | share = compactAddWithSharing#+ | otherwise = compactAdd#++-- | Retrieve a direct pointer to the value pointed at by a 'Compact' reference.+-- If you have used 'compactAdd', there may be multiple 'Compact' references+-- into the same compact region. Upholds the property:+--+-- > inCompact c (getCompact c) == True+--+getCompact :: Compact a -> a+getCompact (Compact _ obj _) = obj++-- | Compact a value. /O(size of unshared data)/+--+-- If the structure contains any internal sharing, the shared data+-- will be duplicated during the compaction process. This will+-- not terminate if the structure contains cycles (use 'compactWithSharing'+-- instead).+--+-- The object in question must not contain any functions or data with mutable+-- pointers; if it does, 'compact' will raise an exception. In the future, we+-- may add a type class which will help statically check if this is the case or+-- not.+--+compact :: a -> IO (Compact a)+compact = compactSized 31268 False++-- | Compact a value, retaining any internal sharing and+-- cycles. /O(size of data)/+--+-- This is typically about 10x slower than 'compact', because it works+-- by maintaining a hash table mapping uncompacted objects to+-- compacted objects.+--+-- The object in question must not contain any functions or data with mutable+-- pointers; if it does, 'compact' will raise an exception. In the future, we+-- may add a type class which will help statically check if this is the case or+-- not.+--+compactWithSharing :: a -> IO (Compact a)+compactWithSharing = compactSized 31268 True++-- | Add a value to an existing 'Compact'. This will help you avoid+-- copying when the value contains pointers into the compact region,+-- but remember that after compaction this value will only be deallocated+-- with the entire compact region.+--+-- Behaves exactly like 'compact' with respect to sharing and what data+-- it accepts.+--+compactAdd :: Compact b -> a -> IO (Compact a)+compactAdd (Compact compact# _ lock) a = withMVar lock $ \_ -> IO $ \s ->+ case compactAdd# compact# a s of { (# s1, pk #) ->+ (# s1, Compact compact# pk lock #) }++-- | Add a value to an existing 'Compact', like 'compactAdd',+-- but behaving exactly like 'compactWithSharing' with respect to sharing and+-- what data it accepts.+--+compactAddWithSharing :: 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 passed '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'. If true, the value in question+-- is also fully evaluated, since any value in a compact region must+-- be fully evaluated.+--+isCompact :: a -> IO Bool+isCompact !val =+ IO (\s -> case compactContainsAny# val s of+ (# s', v #) -> (# s', isTrue# v #) )++-- | Returns the size in bytes of the compact region.+--+compactSize :: Compact a -> IO Word+compactSize (Compact buffer _ lock) = withMVar lock $ \_ -> IO $ \s0 ->+ case compactSize# buffer s0 of (# s1, sz #) -> (# s1, W# sz #)++-- | *Experimental.* This function doesn't actually resize a compact+-- region; rather, it changes the default block size which we allocate+-- when the current block runs out of space, and also appends a block+-- to the compact region.+--+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', () #)
+ GHC/Compact/Serialized.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}++-----------------------------------------------------------------------------+-- |+-- Module : GHC.Compact.Serialized+-- Copyright : (c) The University of Glasgow 2001-2009+-- (c) Giovanni Campagna <gcampagn@cs.stanford.edu> 2015+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : libraries@haskell.org+-- Stability : unstable+-- Portability : non-portable (GHC Extensions)+--+-- This module contains support for serializing a Compact for network+-- transmission and on-disk storage.+--+-- /Since: 1.0.0/++module GHC.Compact.Serialized(+ SerializedCompact(..),+ withSerializedCompact,+ importCompact,+ importCompactByteStrings,+) where++import GHC.Prim+import GHC.Types+import GHC.Word (Word8)++import GHC.Ptr (Ptr(..), plusPtr)++import Control.Concurrent+import qualified Data.ByteString as ByteString+import Data.ByteString.Internal(toForeignPtr)+import Data.IORef(newIORef, readIORef, writeIORef)+import Foreign.ForeignPtr(withForeignPtr)+import Foreign.Marshal.Utils(copyBytes)++import GHC.Compact++-- | A serialized version of the 'Compact' metadata (each block with+-- address and size and the address of the root). This structure is+-- meant to be sent alongside the actual 'Compact' data. It can be+-- sent out of band in advance if the data is to be sent over RDMA+-- (which requires both sender and receiver to have pinned buffers).+data SerializedCompact a = SerializedCompact+ { serializedCompactBlockList :: [(Ptr a, Word)]+ , serializedCompactRoot :: Ptr a+ }++addrIsNull :: Addr# -> Bool+addrIsNull addr = isTrue# (nullAddr# `eqAddr#` addr)++compactGetFirstBlock :: Compact# -> IO (Ptr a, Word)+compactGetFirstBlock buffer =+ IO (\s -> case compactGetFirstBlock# buffer s of+ (# s', addr, size #) -> (# s', (Ptr addr, W# size) #) )++compactGetNextBlock :: Compact# -> Addr# -> IO (Ptr a, Word)+compactGetNextBlock buffer block =+ IO (\s -> case compactGetNextBlock# buffer block s of+ (# s', addr, size #) -> (# s', (Ptr addr, W# size) #) )++mkBlockList :: Compact# -> IO [(Ptr a, Word)]+mkBlockList buffer = compactGetFirstBlock buffer >>= go+ where+ go :: (Ptr a, Word) -> IO [(Ptr a, Word)]+ go (Ptr block, _) | addrIsNull block = return []+ go item@(Ptr block, _) = do+ next <- compactGetNextBlock buffer block+ rest <- go next+ return $ item : rest++-- We MUST mark withSerializedCompact as NOINLINE+-- Otherwise the compiler will eliminate the call to touch#+-- causing the Compact# to be potentially GCed too eagerly,+-- before func had a chance to copy everything into its own+-- buffers/sockets/whatever++-- | Serialize the 'Compact', and call the provided function with+-- with the 'Compact' serialized representation. It is not safe+-- to return the pointer from the action and use it after+-- the action completes: all uses must be inside this bracket,+-- since we cannot guarantee that the compact region will stay+-- live from the 'Ptr' object. For example, it would be+-- unsound to use 'unsafeInterleaveIO' to lazily construct+-- a lazy bytestring from the 'Ptr'.+--+{-# NOINLINE withSerializedCompact #-}+withSerializedCompact :: Compact a ->+ (SerializedCompact a -> IO c) -> IO c+withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do+ rootPtr <- IO (\s -> case anyToAddr# root s of+ (# s', rootAddr #) -> (# s', Ptr rootAddr #) )+ blockList <- mkBlockList buffer+ let serialized = SerializedCompact blockList rootPtr+ r <- func serialized+ IO (\s -> case touch# buffer s of+ s' -> (# s', r #) )++fixupPointers :: Addr# -> Addr# -> State# RealWorld ->+ (# State# RealWorld, Maybe (Compact a) #)+fixupPointers firstBlock rootAddr s =+ case compactFixupPointers# firstBlock rootAddr s of+ (# s', buffer, adjustedRoot #) ->+ if addrIsNull adjustedRoot then (# s', Nothing #)+ else case addrToAny# adjustedRoot of+ (# root #) -> case mkCompact buffer root s' of+ (# s'', c #) -> (# s'', Just c #)++-- | Deserialize a 'SerializedCompact' into a in-memory 'Compact'. The+-- provided function will be called with the address and size of each+-- newly allocated block in succession, and should fill the memory+-- from the external source (eg. by reading from a socket or from disk)+-- 'importCompact' can return Nothing if the 'Compact' was corrupt+-- or it had pointers that could not be adjusted.+importCompact :: SerializedCompact a -> (Ptr b -> Word -> IO ()) ->+ IO (Maybe (Compact a))++-- what we would like is+{-+ importCompactPtrs ((firstAddr, firstSize):rest) = do+ (firstBlock, compact) <- compactAllocateAt firstAddr firstSize+ #nullAddr+ fillBlock firstBlock firstAddr firstSize+ let go prev [] = return ()+ go prev ((addr, size):rest) = do+ (block, _) <- compactAllocateAt addr size prev+ fillBlock block addr size+ go block rest+ go firstBlock rest+ if isTrue# (compactFixupPointers compact) then+ return $ Just compact+ else+ return Nothing++But we can't do that because IO Addr# is not valid (kind mismatch)+This check exists to prevent a polymorphic data constructor from using+an unlifted type (which would break GC) - it would not a problem for IO+because IO stores a function, not a value, but the kind check is there+anyway.+Note that by the reasoning, we cannot do IO (# Addr#, Word# #), nor+we can do IO (Addr#, Word#) (that would break the GC for real!)++And therefore we need to do everything with State# explicitly.+-}++-- just do shut up GHC+importCompact (SerializedCompact [] _) _ = return Nothing+importCompact (SerializedCompact blocks root) filler = do+ -- I'm not sure why we need a bang pattern here, given that+ -- these are obviously strict lets, but ghc complains otherwise+ let !((_, W# firstSize):otherBlocks) = blocks+ let !(Ptr rootAddr) = root+ IO $ \s0 ->+ case compactAllocateBlock# firstSize nullAddr# s0 of {+ (# s1, firstBlock #) ->+ case fillBlock firstBlock firstSize s1 of { s2 ->+ case go firstBlock otherBlocks s2 of { s3 ->+ fixupPointers firstBlock rootAddr s3+ }}}+ where+ -- note that the case statements above are strict even though+ -- they don't seem to inspect their argument because State#+ -- is an unlifted type+ fillBlock :: Addr# -> Word# -> State# RealWorld -> State# RealWorld+ fillBlock addr size s = case filler (Ptr addr) (W# size) of+ IO action -> case action s of+ (# s', _ #) -> s'++ go :: Addr# -> [(Ptr a, Word)] -> State# RealWorld -> State# RealWorld+ go _ [] s = s+ go previous ((_, W# size):rest) s =+ case compactAllocateBlock# size previous s of+ (# s', block #) -> case fillBlock block size s' of+ s'' -> go block rest s''++sanityCheckByteStrings :: SerializedCompact a -> [ByteString.ByteString] -> Bool+sanityCheckByteStrings (SerializedCompact scl _) bsl = go scl bsl+ where+ go [] [] = True+ go (_:_) [] = False+ go [] (_:_) = False+ go ((_, size):scs) (bs:bss) =+ fromIntegral size == ByteString.length bs && go scs bss++-- | Convenience function for importing a compact region that is represented+-- by a list of strict 'ByteString's.+--+importCompactByteStrings :: SerializedCompact a -> [ByteString.ByteString] ->+ IO (Maybe (Compact a))+importCompactByteStrings serialized stringList =+ -- sanity check stringList first - if we throw an exception later we leak+ -- memory!+ if not (sanityCheckByteStrings serialized stringList) then+ return Nothing+ else do+ state <- newIORef stringList+ let filler :: Ptr Word8 -> Word -> IO ()+ filler to size = do+ -- this pattern match will never fail+ (next:rest) <- readIORef state+ let (fp, off, _) = toForeignPtr next+ withForeignPtr fp $ \from -> do+ copyBytes to (from `plusPtr` off) (fromIntegral size)+ writeIORef state rest+ importCompact serialized filler
+ LICENSE view
@@ -0,0 +1,41 @@+This library (compact) is derived from code from the GHC project which+is largely (c) The University of Glasgow, and distributable under a+BSD-style license (see below).+Portions of this library were written by Giovanni Campagna+(gcampagn@cs.stanford.edu). They are available under the same license.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2001-2014, The University Court of the University of Glasgow.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ ghc-compact.cabal view
@@ -0,0 +1,47 @@+name: ghc-compact+version: 0.1.0.0+-- NOTE: Don't forget to update ./changelog.md+license: BSD3+license-file: LICENSE+maintainer: libraries@haskell.org+bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries/ghc-compact+synopsis: In memory storage of deeply evaluated data structure+category: Data+description:+ This package provides minimal functionality for working with+ "compact regions", which hold a fully evaluated Haskell object graph.+ These regions maintain the invariant that no pointers live inside the struct+ that point outside it, which ensures efficient garbage collection without+ ever reading the structure contents (effectively, it works as a manually+ managed "oldest generation" which is never freed until the whole is+ released).+ .+ Internally, the struct is stored a single contiguous block of memory,+ which allows efficient serialization and deserialization of structs+ for distributed computing.+ .+ This package provides a low-level API; see also the </package/compact compact package> which provides a user-facing API.+build-type: Simple+cabal-version: >=1.10+tested-with: GHC==8.2.1++source-repository head+ type: git+ location: http://git.haskell.org/ghc.git+ subdir: libraries/ghc-compact++library+ default-language: Haskell2010+ other-extensions:+ MagicHash+ BangPatterns+ UnboxedTuples+ CPP++ build-depends: ghc-prim == 0.5.1.0,+ base >= 4.9.0 && < 4.11,+ bytestring >= 0.10.6.0 && < 0.11+ ghc-options: -Wall++ exposed-modules: GHC.Compact+ GHC.Compact.Serialized