Commit 58415741 authored by Edward Z. Yang's avatar Edward Z. Yang

Drop NFData constraint from compact.

Summary:
It's both unsound (easy to write a bogus NFData instance) and
incomplete (you might want to serialize data that doesn't have
an NFData instance, and will be fine at runtime.)  So better
just to drop it.  (By the way, we used to need the NFData
instance to "pre-evaluate" the data before we copied it into
the region, but since Simon Marlow rewrote the code to directly
evaluate and copy, this is no longer necessary.)
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonmar, austin, dfeuer, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3168
parent 992ea029
......@@ -33,9 +33,8 @@
-- binary serialization), this can lead to substantial speed ups.
--
-- For example, suppose you have a function @loadBigStruct :: IO BigStruct@,
-- which loads a large data structure from the file system. First,
-- ensure that @BigStruct@ is immutable by defining an 'NFData' instance
-- for it. Then, you can "compact" the structure with the following code:
-- which loads a large data structure from the file system. You can "compact"
-- the structure with the following code:
--
-- @
-- do r <- 'compact' =<< loadBigStruct
......@@ -79,7 +78,6 @@ module Data.Compact (
) where
import Control.Concurrent
import Control.DeepSeq (NFData)
import GHC.Prim
import GHC.Types
......@@ -101,12 +99,11 @@ getCompact (Compact _ obj _) = obj
-- not terminate if the structure contains cycles (use 'compactWithSharing'
-- instead).
--
-- The NFData constraint is just to ensure that the object contains no
-- functions, 'compact' does not actually use it. If your object
-- contains any functions, then 'compact' will fail. (and your
-- 'NFData' instance is lying).
-- The object in question must not contain any functions or mutable data; 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 :: NFData a => a -> IO (Compact a)
compact :: a -> IO (Compact a)
compact = Internal.compactSized 31268 False
-- | Compact a value, retaining any internal sharing and
......@@ -116,12 +113,11 @@ compact = Internal.compactSized 31268 False
-- by maintaining a hash table mapping uncompacted objects to
-- compacted objects.
--
-- The 'NFData' constraint is just to ensure that the object contains no
-- functions, `compact` does not actually use it. If your object
-- contains any functions, then 'compactWithSharing' will fail. (and
-- your 'NFData' instance is lying).
-- The object in question must not contain any functions or mutable data; 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 :: NFData a => a -> IO (Compact a)
compactWithSharing :: a -> IO (Compact a)
compactWithSharing = Internal.compactSized 31268 True
-- | Add a value to an existing 'Compact'. This will help you avoid
......@@ -129,19 +125,19 @@ compactWithSharing = Internal.compactSized 31268 True
-- 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 the 'NFData'
-- constraint.
-- Behaves exactly like 'compact' with respect to sharing and what data
-- it accepts.
--
compactAdd :: NFData a => Compact b -> a -> IO (Compact a)
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 the 'NFData' constraint.
-- | Add a value to an existing 'Compact', like 'compactAdd',
-- but behaving exactly like 'compactWithSharing' with respect to sharing and
-- what data it accepts.
--
compactAddWithSharing :: NFData a => Compact b -> a -> IO (Compact a)
compactAddWithSharing :: Compact b -> a -> IO (Compact a)
compactAddWithSharing (Compact compact# _ lock) a =
withMVar lock $ \_ -> IO $ \s ->
case compactAddWithSharing# compact# a s of { (# s1, pk #) ->
......
......@@ -26,7 +26,6 @@ module Data.Compact.Internal
) where
import Control.Concurrent.MVar
import Control.DeepSeq
import GHC.Prim
import GHC.Types
......@@ -105,7 +104,7 @@ mkCompact compact# a s =
-- structure in question is, you can save time by picking an appropriate
-- block size for the compact region.
--
compactSized :: NFData a => Int -> Bool -> a -> IO (Compact a)
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 #) ->
......
......@@ -38,7 +38,6 @@ import Data.ByteString.Internal(toForeignPtr)
import Data.IORef(newIORef, readIORef, writeIORef)
import Foreign.ForeignPtr(withForeignPtr)
import Foreign.Marshal.Utils(copyBytes)
import Control.DeepSeq(NFData, force)
import Data.Compact.Internal
......@@ -82,23 +81,23 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go
-- buffers/sockets/whatever
-- | Serialize the 'Compact', and call the provided function with
-- with the 'Compact' serialized representation. The resulting
-- action will be executed synchronously before this function
-- completes.
-- 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 :: NFData c => Compact a ->
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
-- we must be strict, to avoid smart uses of ByteStrict.Lazy that
-- return a thunk instead of a ByteString (but the thunk references
-- the Ptr, not the Compact#, so it will point to garbage if GC
-- happens)
!r <- fmap force $ func serialized
r <- func serialized
IO (\s -> case touch# buffer s of
s' -> (# s', r #) )
......
......@@ -35,11 +35,9 @@ library
UnboxedTuples
CPP
build-depends: rts == 1.0.*
build-depends: ghc-prim == 0.5.0.0
build-depends: base >= 4.9.0 && < 4.11
build-depends: deepseq >= 1.4
build-depends: bytestring >= 0.10.6.0
build-depends: ghc-prim == 0.5.0.0,
base >= 4.9.0 && < 4.11,
bytestring >= 0.10.6.0
ghc-options: -Wall
exposed-modules: Data.Compact
......
import Control.DeepSeq
import Control.Exception
import Data.Compact
data HiddenFunction = HiddenFunction (Int -> Int)
instance NFData HiddenFunction where
rnf x = x `seq` () -- ignore the function inside
main = compact (HiddenFunction (+1))
......@@ -8,7 +8,6 @@ import Control.Monad.ST
import Data.Array
import Data.Array.ST
import qualified Data.Array.Unboxed as U
import Control.DeepSeq
import Data.Compact
import Data.Compact.Internal
......@@ -29,9 +28,6 @@ arrTest = do
writeArray arr j (fromIntegral $ 2*j + 1)
return arr
instance NFData (U.UArray i e) where
rnf x = seq x ()
-- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO ()
test func = do
let fromList :: Array Int Int
......
module Main where
import Control.Exception
import Control.DeepSeq
import System.Mem
import Text.Show
......@@ -29,10 +28,6 @@ instance Show Tree where
showsPrec _ (Node _ l r) = showString "(Node " . shows l .
showString " " . shows r . showString ")"
instance NFData Tree where
rnf Nil = ()
rnf (Node p l r) = p `seq` rnf l `seq` rnf r `seq` ()
{-# NOINLINE test #-}
test x = do
let a = Node Nil x b
......
import Control.Concurrent
import Control.DeepSeq
import Control.Exception
import Data.Compact
data HiddenMVar = HiddenMVar (MVar ())
instance NFData HiddenMVar where
rnf x = x `seq` () -- ignore the function inside
main = do
m <- newEmptyMVar
compact (HiddenMVar m)
import Control.DeepSeq
import Control.Exception
import qualified Data.ByteString.Char8 as B
import Data.Compact
......
......@@ -7,7 +7,6 @@ import System.Mem
import Data.IORef
import Data.ByteString (ByteString, packCStringLen)
import Foreign.Ptr
import Control.DeepSeq
import Data.Compact
import Data.Compact.Internal
......@@ -22,7 +21,7 @@ assertEquals expected actual =
else assertFail $ "expected " ++ (show expected)
++ ", got " ++ (show actual)
serialize :: NFData a => a -> IO (SerializedCompact a, [ByteString])
serialize :: a -> IO (SerializedCompact a, [ByteString])
serialize val = do
cnf <- compactSized 4096 True val
......
......@@ -8,7 +8,6 @@ import Control.Monad.ST
import Data.Array
import Data.Array.ST
import qualified Data.Array.Unboxed as U
import Control.DeepSeq
import Data.Compact
import Data.Compact.Internal
......@@ -29,9 +28,6 @@ arrTest = do
writeArray arr j (fromIntegral $ 2*j + 1)
return arr
instance NFData (U.UArray i e) where
rnf x = seq x ()
-- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO ()
test func = do
let fromList :: Array Int Int
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment