{-# language BlockArguments #-}
{-# language UnliftedFFITypes #-}
{-# language MagicHash #-}
{-# language BangPatterns #-}
{-# language UnboxedTuples #-}
module Lz4.Block
( compress
, compressU
, compressHighly
, compressHighlyU
, decompress
, decompressU
) where
import Control.Monad.ST (runST)
import Control.Monad.ST.Run (runByteArrayST)
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (MutableByteArray(..),ByteArray(..))
import GHC.Exts (ByteArray#,MutableByteArray#)
import GHC.IO (unsafeIOToST)
import GHC.ST (ST(ST))
import qualified Data.Primitive as PM
import qualified GHC.Exts as Exts
compressHighly ::
Int
-> Bytes
-> Bytes
compressHighly !lvl (Bytes (ByteArray arr) off len) = runST do
let maxSz = inlineCompressBound len
dst@(MutableByteArray dst# ) <- PM.newByteArray maxSz
actualSz <- unsafeIOToST (c_hs_compress_HC arr off dst# 0 len maxSz lvl)
shrinkMutableByteArray dst actualSz
result <- PM.unsafeFreezeByteArray dst
pure (Bytes result 0 actualSz)
compressHighlyU ::
Int
-> Bytes
-> ByteArray
compressHighlyU !lvl (Bytes (ByteArray arr) off len) = runST do
let maxSz = inlineCompressBound len
dst@(MutableByteArray dst# ) <- PM.newByteArray maxSz
actualSz <- unsafeIOToST (c_hs_compress_HC arr off dst# 0 len maxSz lvl)
shrinkMutableByteArray dst actualSz
PM.unsafeFreezeByteArray dst
compress ::
Int
-> Bytes
-> Bytes
compress !lvl (Bytes (ByteArray arr) off len) = runST do
let maxSz = inlineCompressBound len
dst@(MutableByteArray dst# ) <- PM.newByteArray maxSz
actualSz <- unsafeIOToST (c_hs_compress_fast arr off dst# 0 len maxSz lvl)
shrinkMutableByteArray dst actualSz
result <- PM.unsafeFreezeByteArray dst
pure (Bytes result 0 actualSz)
compressU ::
Int
-> Bytes
-> ByteArray
compressU !lvl (Bytes (ByteArray arr) off len) = runByteArrayST do
let maxSz = inlineCompressBound len
dst@(MutableByteArray dst# ) <- PM.newByteArray maxSz
actualSz <- unsafeIOToST (c_hs_compress_fast arr off dst# 0 len maxSz lvl)
shrinkMutableByteArray dst actualSz
PM.unsafeFreezeByteArray dst
decompress ::
Int
-> Bytes
-> Maybe Bytes
decompress !dstSz !b = case decompressU dstSz b of
Nothing -> Nothing
Just r -> Just (Bytes r 0 dstSz)
decompressU ::
Int
-> Bytes
-> Maybe ByteArray
decompressU dstSz (Bytes (ByteArray arr) off len) = runST do
dst@(MutableByteArray dst# ) <- PM.newByteArray dstSz
actualSz <- unsafeIOToST (c_hs_decompress_safe arr off dst# 0 len dstSz)
if actualSz == dstSz
then do
result <- PM.unsafeFreezeByteArray dst
pure (Just result)
else pure Nothing
inlineCompressBound :: Int -> Int
inlineCompressBound s = s + (div s 255) + 16
foreign import ccall unsafe "hs_compress_fast"
c_hs_compress_fast ::
ByteArray#
-> Int
-> MutableByteArray# s
-> Int
-> Int
-> Int
-> Int
-> IO Int
foreign import ccall unsafe "hs_compress_HC"
c_hs_compress_HC ::
ByteArray#
-> Int
-> MutableByteArray# s
-> Int
-> Int
-> Int
-> Int
-> IO Int
foreign import ccall unsafe "hs_decompress_safe"
c_hs_decompress_safe ::
ByteArray#
-> Int
-> MutableByteArray# s
-> Int
-> Int
-> Int
-> IO Int
shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()
shrinkMutableByteArray (MutableByteArray x) (Exts.I# i) =
ST (\s -> (# Exts.shrinkMutableByteArray# x i s, () #) )