Support multi-threaded compression

Changelog.md

@@ -1,6 +1,7 @@
 ## 0.0.1.0
 
 * Add `pkgconfig` package flag.
+* add `compressThreads` parameter for multithreaded compression
 
 ## 0.0.0.4
 

cbits/lzma_wrapper.c

@@ -25,13 +25,22 @@ hs_lzma_init_decoder(lzma_stream *ls, HsBool autolzma, uint64_t memlimit, uint32
 }
 
 HsInt
-hs_lzma_init_encoder(lzma_stream *ls, uint32_t preset, HsInt check)
+hs_lzma_init_encoder(lzma_stream *ls, uint32_t preset, HsInt check, HsInt threads)
 {
   /* recommended super-portable initialization */
   const lzma_stream ls_init = LZMA_STREAM_INIT;
   *ls = ls_init;
 
-  const lzma_ret ret = lzma_easy_encoder(ls, preset, check);
+  lzma_mt mt = {
+    .threads = threads,
+    // Use the default preset (6) for LZMA2.
+    // To use a preset, filters must be set to NULL.
+    .preset = preset,
+    // Use CRC64 for integrity checking. See also
+    // 01_compress_easy.c about choosing the integrity check.
+    .check = check,
+  };
+  const lzma_ret ret = lzma_stream_encoder_mt(ls, &mt);
 
   return ret;
 }

lzma.cabal

@@ -1,6 +1,6 @@
 cabal-version:       >=1.10
 name:                lzma
-version:             0.0.0.4
+version:             0.0.1.0
 
 synopsis:            LZMA/XZ compression and decompression
 homepage:            https://github.com/hvr/lzma

src-tests/lzma-tests.hs

@@ -21,6 +21,9 @@ main = defaultMain tests
 codecompress :: BL.ByteString -> BL.ByteString
 codecompress = decompress . compress
 
+codecompressMultiCore :: BL.ByteString -> BL.ByteString
+codecompressMultiCore = decompress . compressWith defaultCompressParams { compressThreads = 4 }
+
 newtype ZeroBS = ZeroBS BL.ByteString
 
 instance Show ZeroBS where
@@ -70,6 +73,7 @@ tests = testGroup "ByteString API" [unitTests, properties]
         , testCase "encode-sample" $ codecompress sampleref @?= sampleref
         , testCase "encode-empty^50" $ (iterate decompress (iterate (compressWith lowProf) (BL8.pack "") !! 50) !! 50) @?= BL8.pack ""
         , testCase "encode-10MiB-zeros" $ let z = BL.replicate (10*1024*1024) 0 in codecompress z @?= z
+        , testCase "encode-10MiB-zeros-multicore" $ let z = BL.replicate (10*1024*1024) 0 in codecompressMultiCore z @?= z
         ]
 
     properties = testGroup "properties"
@@ -79,6 +83,9 @@ tests = testGroup "ByteString API" [unitTests, properties]
         , QC.testProperty "decompress . compress === id (chunked)" $
           \(RandBL bs) -> codecompress bs == bs
 
+        , QC.testProperty "decompress . compress (multi-core) === id" $
+          \(RandBL bs) -> codecompressMultiCore bs == bs
+
         , QC.testProperty "decompress . (compress a <> compress b) === a <> b" $
           \(RandBLSm a) (RandBLSm b) -> decompress (compress a `mappend` compress b) == a `mappend` b
         ]

src/Codec/Compression/Lzma.hs

@@ -43,6 +43,7 @@ module Codec.Compression.Lzma
     , compressIntegrityCheck
     , compressLevel
     , compressLevelExtreme
+    , compressThreads
 
     , IntegrityCheck(..)
     , CompressionLevel(..)

src/LibLzma.hsc

@@ -147,6 +147,9 @@ data CompressParams = CompressParams
     , compressLevelExtreme   :: !Bool  -- ^ 'CompressParams' field: Enable slower variant of the
                                        -- 'lzmaCompLevel' preset, see @xz(1)@
                                        -- man-page for details.
+    , compressThreads        :: !Int -- ^ Number of threads to use. It must be greater than zero.
+                                     --
+                                     -- @since 0.0.1.0
     } deriving (Eq,Show)
 
 -- | The default set of parameters for compression. This is typically
@@ -158,6 +161,7 @@ defaultCompressParams = CompressParams {..}
     compressIntegrityCheck = IntegrityCheckCrc64
     compressLevel          = CompressionLevel6
     compressLevelExtreme   = False
+    compressThreads        = 1
 
 newDecodeLzmaStream :: DecompressParams -> ST s (Either LzmaRet LzmaStream)
 newDecodeLzmaStream (DecompressParams {..}) = unsafeIOToST $ do
@@ -180,7 +184,7 @@ newEncodeLzmaStream :: CompressParams -> ST s (Either LzmaRet LzmaStream)
 newEncodeLzmaStream (CompressParams {..}) = unsafeIOToST $ do
     fp <- mallocForeignPtrBytes (#size lzma_stream)
     addForeignPtrFinalizer c_hs_lzma_done_funptr fp
-    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_encoder ptr preset check)
+    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_encoder ptr preset check compressThreads)
     rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc
 
     return $ case rc' of
@@ -242,7 +246,7 @@ foreign import ccall "hs_lzma_init_decoder"
     c_hs_lzma_init_decoder :: Ptr LzmaStream -> Bool -> Word64 -> Word32 -> IO Int
 
 foreign import ccall "hs_lzma_init_encoder"
-    c_hs_lzma_init_encoder :: Ptr LzmaStream -> Word32 -> Int -> IO Int
+    c_hs_lzma_init_encoder :: Ptr LzmaStream -> Word32 -> Int -> Int -> IO Int
 
 foreign import ccall "hs_lzma_run"
     c_hs_lzma_run :: Ptr LzmaStream -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Int