diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for stream-sockets +## 0.6.1.1 + +* Work with primitive-unlifted-2.1.0.0. + ## 0.6.1.0 * Correct implementation of withListenerReuse diff --git a/sockets.cabal b/sockets.cabal --- a/sockets.cabal +++ b/sockets.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: sockets -version: 0.6.1.0 +version: 0.6.1.1 synopsis: High-level network sockets description: This library provides a high-level abstraction for network sockets. It uses @@ -83,9 +83,9 @@ , base >= 4.11.1.0 && <5 , bytestring >=0.10 && <0.12 , ip >= 1.4.1 - , posix-api >=0.4 && <0.5 + , posix-api >=0.4.0.1 && <0.5 , primitive-offset >= 0.2 && <0.3 - , primitive-unlifted >= 0.1 && <0.2 + , primitive-unlifted >= 2.1 , primitive-addr >= 0.1 && <0.2 , stm >= 2.4 , text >= 1.2 @@ -93,7 +93,7 @@ if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else - build-depends: primitive >= 0.7 && <0.8 + build-depends: primitive >= 0.7 && <0.10 exposed-modules: Socket Socket.AddrLength @@ -156,7 +156,7 @@ build-depends: , base >= 4.11.1.0 && <5 , error-codes >= 0.1.0.1 && < 0.2 - , posix-api >=0.4 && <0.5 + , posix-api >=0.4.0.1 && <0.5 , stm >= 2.4 , sockets-internal , sockets-buffer @@ -174,7 +174,7 @@ , base >= 4.11.1.0 && <5 , error-codes >= 0.1.0.1 && < 0.2 , stm >= 2.4 - , posix-api >=0.4 && <0.5 + , posix-api >=0.4.0.1 && <0.5 , primitive-offset >= 0.2 && <0.3 , sockets-internal , sockets-buffer @@ -195,15 +195,15 @@ , base >= 4.11.1.0 && <5 , error-codes >= 0.1.0.1 && < 0.2 , stm >= 2.4 - , posix-api >=0.4 && <0.5 - , primitive-unlifted >= 0.1 && <0.2 + , posix-api >=0.4.0.1 && <0.5 + , primitive-unlifted >= 2.1 , byteslice >= 0.1.1 , sockets-datagram-receive , sockets-internal if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else - build-depends: primitive >= 0.7 && <0.8 + build-depends: primitive >= 0.7 && <0.10 exposed-modules: Datagram.Receive.Many.Indefinite hs-source-dirs: src-datagram-receive-many @@ -219,7 +219,7 @@ build-depends: , base >= 4.11.1.0 && <5 , error-codes >= 0.1.0.1 && < 0.2 - , posix-api >=0.4 && <0.5 + , posix-api >=0.4.0.1 && <0.5 , stm >= 2.4 , sockets-internal , sockets-buffer @@ -237,7 +237,7 @@ build-depends: , base >= 4.11.1.0 && <5 , error-codes >= 0.1.0.1 && < 0.2 - , posix-api >=0.4 && <0.5 + , posix-api >=0.4.0.1 && <0.5 , stm >= 2.4 , sockets-internal , sockets-buffer @@ -255,7 +255,7 @@ build-depends: , base >= 4.11.1.0 && <5 , error-codes >= 0.1.0.1 && < 0.2 - , posix-api >=0.4 && <0.5 + , posix-api >=0.4.0.1 && <0.5 , stm >= 2.4 , sockets-internal , sockets-interrupt @@ -532,10 +532,10 @@ , bytestring >=0.10 && <0.12 , error-codes >=0.1.0.1 && <0.2 , ip >=1.4.1 - , posix-api >=0.4 && <0.5 + , posix-api >=0.4.0.1 && <0.5 , primitive-addr >= 0.1 && <0.2 , primitive-offset >= 0.2 && <0.3 - , primitive-unlifted >= 0.1 && <0.2 + , primitive-unlifted >= 2.1 , sockets-datagram-receive , sockets-datagram-receive-many , sockets-datagram-send @@ -548,7 +548,7 @@ if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else - build-depends: primitive >= 0.7 && <0.8 + build-depends: primitive >= 0.7 && <0.10 hs-source-dirs: src if flag(mmsg) hs-source-dirs: src-mmsg @@ -570,13 +570,13 @@ , async , bytestring , byteslice >= 0.1.1 - , primitive-unlifted + , primitive-unlifted >= 2.1 , primitive-addr , stm if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else - build-depends: primitive >= 0.7 && <0.8 + build-depends: primitive >= 0.7 && <0.10 ghc-options: -Wall -O2 -threaded default-language: Haskell2010 @@ -591,7 +591,7 @@ if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else - build-depends: primitive >= 0.7 && <0.8 + build-depends: primitive >= 0.7 && <0.10 ghc-options: -Wall -O2 -threaded -rtsopts default-language: Haskell2010 hs-source-dirs: bench @@ -608,7 +608,7 @@ if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else - build-depends: primitive >= 0.7 && <0.8 + build-depends: primitive >= 0.7 && <0.10 ghc-options: -Wall -O2 -threaded -rtsopts default-language: Haskell2010 hs-source-dirs: bench @@ -626,7 +626,7 @@ if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else - build-depends: primitive >= 0.7 && <0.8 + build-depends: primitive >= 0.7 && <0.10 else buildable: False hs-source-dirs: example diff --git a/src-datagram-receive-many/Datagram/Receive/Many/Indefinite.hs b/src-datagram-receive-many/Datagram/Receive/Many/Indefinite.hs --- a/src-datagram-receive-many/Datagram/Receive/Many/Indefinite.hs +++ b/src-datagram-receive-many/Datagram/Receive/Many/Indefinite.hs @@ -109,6 +109,4 @@ :: MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- ^ source -> Int -- ^ index -> IO (MutableByteArray RealWorld) -readMutableByteArrayArray (PM.MutableUnliftedArray maa#) (I# i#) - = primitive $ \s -> case Exts.readMutableByteArrayArray# maa# i# s of - (# s', aa# #) -> (# s', PM.MutableByteArray aa# #) +readMutableByteArrayArray = PM.readUnliftedArray diff --git a/src-internal/Socket/Discard.hs b/src-internal/Socket/Discard.hs --- a/src-internal/Socket/Discard.hs +++ b/src-internal/Socket/Discard.hs @@ -154,21 +154,17 @@ -> Int -- ^ index -> MutableByteArray RealWorld -- ^ value -> IO () -writeMutableByteArrayArray (PM.MutableUnliftedArray maa#) (I# i#) (PM.MutableByteArray a) - = primitive_ (Exts.writeMutableByteArrayArray# maa# i# a) +writeMutableByteArrayArray = PM.writeUnliftedArray writeByteArrayArray :: MutableUnliftedArray RealWorld ByteArray -- ^ destination -> Int -- ^ index -> ByteArray -- ^ value -> IO () -writeByteArrayArray (PM.MutableUnliftedArray maa#) (I# i#) (PM.ByteArray a) - = primitive_ (Exts.writeByteArrayArray# maa# i# a) +writeByteArrayArray = PM.writeUnliftedArray readMutableByteArrayArray :: MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- ^ source -> Int -- ^ index -> IO (MutableByteArray RealWorld) -readMutableByteArrayArray (PM.MutableUnliftedArray maa#) (I# i#) - = primitive $ \s -> case Exts.readMutableByteArrayArray# maa# i# s of - (# s', aa# #) -> (# s', PM.MutableByteArray aa# #) +readMutableByteArrayArray = PM.readUnliftedArray diff --git a/src-internal/Socket/EventManager.hs b/src-internal/Socket/EventManager.hs --- a/src-internal/Socket/EventManager.hs +++ b/src-internal/Socket/EventManager.hs @@ -154,7 +154,7 @@ -- Precondition: A previous call to register has been made. -- unregister -type MUArray = MutableUnliftedArray RealWorld +type MUArray a = MutableUnliftedArray RealWorld a data Manager = Manager { variables :: !(MUArray (MUArray (TVar Token))) @@ -674,22 +674,17 @@ = PM.primitive (\s# -> case Exts.newPinnedByteArray# (n# *# PM.sizeOf# (undefined :: a)) s# of (# s'#, arr# #) -> (# s'#, MutablePrimArray arr# #)) --- This can be unsound if the result is passed to the FFI. Fortunately, --- we do not do that with the result. readTVarArray :: forall a. MutableUnliftedArray RealWorld (TVar a) -- ^ source -> Int -- ^ index -> IO (TVar a) -readTVarArray (MutableUnliftedArray maa#) (I# i#) - = PM.primitive $ \s -> case Exts.readArrayArrayArray# maa# i# s of - (# s', aa# #) -> (# s', TVar ((unsafeCoerce# :: ArrayArray# -> TVar# RealWorld a) aa#) #) +readTVarArray = PM.readUnliftedArray + readMutableUnliftedArrayArray :: MutableUnliftedArray RealWorld (MutableUnliftedArray RealWorld a) -- ^ source -> Int -- ^ index -> IO (MutableUnliftedArray RealWorld a) -readMutableUnliftedArrayArray (MutableUnliftedArray maa#) (I# i#) - = PM.primitive $ \s -> case Exts.readArrayArrayArray# maa# i# s of - (# s', aa# #) -> (# s', MutableUnliftedArray ((unsafeCoerce# :: ArrayArray# -> MutableArrayArray# RealWorld) aa#) #) +readMutableUnliftedArrayArray = PM.readUnliftedArray -- See readTVarArray writeTVarArray :: forall a. @@ -697,16 +692,14 @@ -> Int -- ^ index -> TVar a -- ^ value -> IO () -writeTVarArray (PM.MutableUnliftedArray maa#) (I# i#) (TVar a) - = PM.primitive_ (Exts.writeArrayArrayArray# maa# i# ((unsafeCoerce# :: TVar# RealWorld a -> ArrayArray#) a)) +writeTVarArray = PM.writeUnliftedArray writeMutableUnliftedArrayArray :: forall a. MutableUnliftedArray RealWorld (MutableUnliftedArray RealWorld a) -- ^ source -> Int -- ^ index -> MutableUnliftedArray RealWorld a -- ^ value -> IO () -writeMutableUnliftedArrayArray (PM.MutableUnliftedArray maa#) (I# i#) (MutableUnliftedArray a) - = PM.primitive_ (Exts.writeArrayArrayArray# maa# i# ((unsafeCoerce# :: MutableArrayArray# RealWorld -> ArrayArray#) a)) +writeMutableUnliftedArrayArray = PM.writeUnliftedArray -- [Notes on registration] -- This interface requires every call to @register@ to be paired with diff --git a/src-internal/Socket/IPv4.hs b/src-internal/Socket/IPv4.hs --- a/src-internal/Socket/IPv4.hs +++ b/src-internal/Socket/IPv4.hs @@ -207,13 +207,10 @@ -> Int -- ^ index -> MutableByteArray RealWorld -- ^ value -> IO () -writeMutableByteArrayArray (PM.MutableUnliftedArray maa#) (I# i#) (PM.MutableByteArray a) - = primitive_ (Exts.writeMutableByteArrayArray# maa# i# a) +writeMutableByteArrayArray = PM.writeUnliftedArray readMutableByteArrayArray :: MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- ^ source -> Int -- ^ index -> IO (MutableByteArray RealWorld) -readMutableByteArrayArray (PM.MutableUnliftedArray maa#) (I# i#) - = primitive $ \s -> case Exts.readMutableByteArrayArray# maa# i# s of - (# s', aa# #) -> (# s', PM.MutableByteArray aa# #) +readMutableByteArrayArray = PM.readUnliftedArray diff --git a/src/Socket/Stream/Uninterruptible/MutableBytes.hs b/src/Socket/Stream/Uninterruptible/MutableBytes.hs --- a/src/Socket/Stream/Uninterruptible/MutableBytes.hs +++ b/src/Socket/Stream/Uninterruptible/MutableBytes.hs @@ -14,10 +14,11 @@ import Data.Bytes.Types (MutableBytes) import Data.Primitive (MutableByteArray) -import Data.Primitive.Unlifted.Array (UnliftedArray(..)) +import Data.Primitive.Unlifted.Array (UnliftedArray,UnliftedArray_(UnliftedArray)) import GHC.Exts (RealWorld,proxy#) import Socket.Stream (Connection,ReceiveException,SendException) import Socket (Interruptibility(Uninterruptible)) +import GHC.Exts (unsafeCoerce#) import qualified Socket.Stream.Uninterruptible.Bytes as SSUB import qualified Socket.Stream.Uninterruptible.MutableBytes.Send as Send @@ -46,7 +47,7 @@ -- buffer from mutable to immutable. This ends up being sound -- in this context because SSUB.sendMany does not preserve any -- referenced to its argument byte arrays. - SSUB.sendMany conn (UnliftedArray bufs) + SSUB.sendMany conn (UnliftedArray (unsafeCoerce# bufs)) -- | Receive a number of bytes exactly equal to the length of the -- buffer slice. If needed, this may call @recv@ repeatedly until