Drop NFData constraint from compact.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Tue, 21 Feb 2017 05:50:41 +0000 (21:50 -0800)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 23 Feb 2017 04:47:50 +0000 (20:47 -0800)
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: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: simonmar, austin, dfeuer, bgamari

Subscribers: thomie

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

libraries/compact/Data/Compact.hs
libraries/compact/Data/Compact/Internal.hs
libraries/compact/Data/Compact/Serialized.hs
libraries/compact/compact.cabal
libraries/compact/tests/compact_function.hs
libraries/compact/tests/compact_huge_array.hs
libraries/compact/tests/compact_loop.hs
libraries/compact/tests/compact_mutable.hs
libraries/compact/tests/compact_pinned.hs
libraries/compact/tests/compact_serialize.hs
libraries/compact/tests/compact_simple_array.hs

index ce6bf2b..f1339e5 100644 (file)
@@ -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 #) ->
index 2857a9d..722a62c 100644 (file)
@@ -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 #) ->
index bf2b4f7..56ddb30 100644 (file)
@@ -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 #) )
 
index 2a4478c..b80dc59 100644 (file)
@@ -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
index fc4f4ca..8193a78 100644 (file)
@@ -1,10 +1,6 @@
-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))
index 8a83742..87200d8 100644 (file)
@@ -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
index c8991b0..5cf167c 100644 (file)
@@ -1,7 +1,6 @@
 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
index 2d1a7f2..fdd7a43 100644 (file)
@@ -1,13 +1,9 @@
 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)
index 39dda61..faeb2fc 100644 (file)
@@ -1,4 +1,3 @@
-import Control.DeepSeq
 import Control.Exception
 import qualified Data.ByteString.Char8 as B
 import Data.Compact
index 2b831e0..f4bd204 100644 (file)
@@ -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
 
index 69421c5..88f6698 100644 (file)
@@ -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