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: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonmar, austin, dfeuer, bgamari

Subscribers: thomie

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

11 files changed, 31 insertions, 62 deletions

diff --git a/libraries/compact/Data/Compact.hs b/libraries/compact/Data/Compact.hs
index ce6bf2bb83..f1339e503a 100644
--- a/libraries/compact/Data/Compact.hs
+++ b/libraries/compact/Data/Compact.hs
@@ -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 #) ->
diff --git a/libraries/compact/Data/Compact/Internal.hs b/libraries/compact/Data/Compact/Internal.hs
index 2857a9d615..722a62c09c 100644
--- a/libraries/compact/Data/Compact/Internal.hs
+++ b/libraries/compact/Data/Compact/Internal.hs
@@ -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 #) ->
diff --git a/libraries/compact/Data/Compact/Serialized.hs b/libraries/compact/Data/Compact/Serialized.hs
index bf2b4f7918..56ddb30ef4 100644
--- a/libraries/compact/Data/Compact/Serialized.hs
+++ b/libraries/compact/Data/Compact/Serialized.hs
@@ -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 #) )
 
diff --git a/libraries/compact/compact.cabal b/libraries/compact/compact.cabal
index 2a4478cf20..b80dc59324 100644
--- a/libraries/compact/compact.cabal
+++ b/libraries/compact/compact.cabal
@@ -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
diff --git a/libraries/compact/tests/compact_function.hs b/libraries/compact/tests/compact_function.hs
index fc4f4ca172..8193a78a99 100644
--- a/libraries/compact/tests/compact_function.hs
+++ b/libraries/compact/tests/compact_function.hs
@@ -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))
diff --git a/libraries/compact/tests/compact_huge_array.hs b/libraries/compact/tests/compact_huge_array.hs
index 8a8374297b..87200d807d 100644
--- a/libraries/compact/tests/compact_huge_array.hs
+++ b/libraries/compact/tests/compact_huge_array.hs
@@ -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
diff --git a/libraries/compact/tests/compact_loop.hs b/libraries/compact/tests/compact_loop.hs
index c8991b05d0..5cf167c393 100644
--- a/libraries/compact/tests/compact_loop.hs
+++ b/libraries/compact/tests/compact_loop.hs
@@ -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
diff --git a/libraries/compact/tests/compact_mutable.hs b/libraries/compact/tests/compact_mutable.hs
index 2d1a7f2572..fdd7a436ce 100644
--- a/libraries/compact/tests/compact_mutable.hs
+++ b/libraries/compact/tests/compact_mutable.hs
@@ -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)
diff --git a/libraries/compact/tests/compact_pinned.hs b/libraries/compact/tests/compact_pinned.hs
index 39dda61cd7..faeb2fc6bf 100644
--- a/libraries/compact/tests/compact_pinned.hs
+++ b/libraries/compact/tests/compact_pinned.hs
@@ -1,4 +1,3 @@
-import Control.DeepSeq
 import Control.Exception
 import qualified Data.ByteString.Char8 as B
 import Data.Compact
diff --git a/libraries/compact/tests/compact_serialize.hs b/libraries/compact/tests/compact_serialize.hs
index 2b831e048c..f4bd2044fc 100644
--- a/libraries/compact/tests/compact_serialize.hs
+++ b/libraries/compact/tests/compact_serialize.hs
@@ -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
 
diff --git a/libraries/compact/tests/compact_simple_array.hs b/libraries/compact/tests/compact_simple_array.hs
index 69421c5137..88f669837f 100644
--- a/libraries/compact/tests/compact_simple_array.hs
+++ b/libraries/compact/tests/compact_simple_array.hs
@@ -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