diff --git a/jvm-batching.cabal b/jvm-batching.cabal --- a/jvm-batching.cabal +++ b/jvm-batching.cabal @@ -1,5 +1,5 @@ name: jvm-batching -version: 0.1.1 +version: 0.1.2 synopsis: Provides batched marshalling of values between Java and Haskell. description: Please see README.md. homepage: http://github.com/tweag/inline-java/tree/master/jvm-batching#readme @@ -43,9 +43,9 @@ base >= 4.7 && < 5, bytestring, distributed-closure >= 0.3.5, - jni >= 0.6.0 && <0.7, - jvm >= 0.4.0 && <0.5, - inline-java >= 0.7 && <0.9, + jni >= 0.7.0 && <0.8, + jvm >= 0.5.0 && <0.6, + inline-java >= 0.7 && <0.10, singletons >= 2.2, text, vector @@ -68,6 +68,7 @@ text, vector default-language: Haskell2010 + cpp-options: -DHSPEC_DISCOVER=hspec-discover benchmark micro-benchmarks type: exitcode-stdio-1.0 diff --git a/src/main/haskell/Language/Java/Batching.hs b/src/main/haskell/Language/Java/Batching.hs --- a/src/main/haskell/Language/Java/Batching.hs +++ b/src/main/haskell/Language/Java/Batching.hs @@ -18,7 +18,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# OPTIONS_GHC -fplugin=Language.Java.Inline.Plugin #-} -- | This module provides composable batched marshalling. -- @@ -28,7 +27,7 @@ -- primitive values can be as slow as marshalling a single value. -- -- Because of this, reifying an iterator or a container is best done by --- accumulates multiple elements on the java side before passing them to the +-- accumulating multiple elements on the java side before passing them to the -- Haskell side. And conversely, when reflecting an iterator or container, -- multiple Haskell values are put together before marshalling to the Java -- side. @@ -71,7 +70,7 @@ -- > ) -- > reifyBatch :: J (Batch a) -> Int32 -> IO (V.Vector a) -- --- @newReifyBatched@ produces a java object implementing the @BatchWriter@ +-- @newBatchWriter@ produces a java object implementing the @BatchWriter@ -- interface, and @reifyBatch@ allows to read a batch created in this fashion. -- -- Conversely, batches can be read on the Java side using the interface @@ -96,7 +95,7 @@ -- advantage of batching requires defining the methods explicitly. The default -- implementations are useful for cases where speed is not important, for -- instance when the iterators to reflect or reify contain a single element or --- just a very few. +-- just very few. -- -- 'Vector's and 'ByteString's are batched with the follow scheme. -- @@ -200,9 +199,15 @@ -- | Batches of arrays of variable length -- --- The first component is an array or batch containing the actual elements, --- and the second component is an @int[]@ where the ith position has the --- offset of the first position after the ith array. +-- The first component is an array or batch B containing the elements +-- of all the arrays in the batch. The second component is an array of +-- offsets F. The ith position in the offset array is the first position +-- in B after the ith array of the batch. +-- +-- Thus, the first array of the batch can be found in B between the +-- indices 0 and F[0], the second array of the batch is between the +-- indices F[0] and F[1], and so on. +-- type ArrayBatch ty = 'Class "io.tweag.jvm.batching.Tuple2" <> '[ ty @@ -219,29 +224,47 @@ :: forall a b ty. (Int32 -> J ty -> IO a) -- ^ reify the array/batch of values -- (takes the amount of elements in the array) - -> (Int -> Int -> a -> IO b) -- ^ slice at a given offset of given length of some value + -> (Int -> Int -> a -> IO b) -- ^ slice at a given offset of given length of some array a -> J (ArrayBatch ty) -> Int32 -> IO (V.Vector b) reifyArrayBatch reifyB slice batch0 batchSize = do - result <- VM.new (fromIntegral batchSize) let batch = unsafeUngeneric batch0 - vecEnds <- [java| (int[])$batch._2 |] >>= reify - let count = if VS.null vecEnds then 0 else VS.last vecEnds - vecValues <- [java| $batch._1 |] >>= reifyB count . fromObject - _ <- foldM (writeVector result vecEnds vecValues) 0 [0 .. batchSize - 1] - V.unsafeFreeze result + arrayEnds <- reifyArrayOffsets batch + arrayValues <- reifyArrayValues arrayEnds batch + reifySlices arrayEnds arrayValues where fromObject :: JObject -> J x fromObject = unsafeCast - writeVector :: VM.IOVector b -> VS.Vector Int32 -> a -> Int32 -> Int32 -> IO Int32 - writeVector mv ends values offset i32 = do - let i = fromIntegral i32 + reifyArrayOffsets + :: J ('Class "io.tweag.jvm.batching.Tuple2") -> IO (VS.Vector Int32) + reifyArrayOffsets batch = [java| (int[])$batch._2 |] >>= reify + + reifyArrayValues arrayEnds batch = do + let count = if VS.null arrayEnds then 0 else VS.last arrayEnds + [java| $batch._1 |] >>= reifyB count . fromObject + + reifySlices arrayEnds arrayValues = do + result <- VM.new (fromIntegral batchSize) + _ <- foldM + (writeSliceToVector result arrayEnds arrayValues) + 0 + [0 .. fromIntegral batchSize - 1] + V.unsafeFreeze result + + writeSliceToVector + :: VM.IOVector b -- ^ output vector to write to + -> VS.Vector Int32 -- ^ ends[i] holds the offset of the (i+1)th slice + -> a -- ^ input vector to read slices from + -> Int32 -- ^ offset of the slice to read from the input vector + -> Int -- ^ index of the position to write in the output vector + -> IO Int32 -- ^ offset of the next slice to read + writeSliceToVector output arrayEnds arrayValues offset i = do slice (fromIntegral offset) - (fromIntegral $ ends VS.! i - offset) values - >>= VM.unsafeWrite mv i - return $ ends VS.! i + (fromIntegral $ arrayEnds VS.! i - offset) arrayValues + >>= VM.unsafeWrite output i + return $ arrayEnds VS.! i -- | A class for batching reflection of values. -- @@ -323,9 +346,7 @@ bigvec <- concatenate $ V.toList vecs jvec <- reflectB bigvec jends <- reflect ends - generic <$> Language.Java.new [ coerce (upcast jvec) - , coerce (upcast jends) - ] + generic <$> Language.Java.new (upcast jvec) (upcast jends) withStatic [d| instance Batchable Bool where @@ -610,16 +631,14 @@ instance Batchable a => Batchable (V.Vector a) where type Batch (V.Vector a) = ArrayBatch (Batch a) - instance (SingI (Interp a), SingI (Batch a), BatchReify a) - => BatchReify (V.Vector a) where + instance BatchReify a => BatchReify (V.Vector a) where newBatchWriter _ = do _b <- unsafeUngeneric <$> newBatchWriter (Proxy :: Proxy a) generic <$> [java| new BatchWriters.ObjectArrayBatchWriter($_b) |] reifyBatch = reifyArrayBatch (flip reifyBatch) (fmap (fmap return) . V.unsafeSlice) - instance (SingI (Interp a), SingI (Batch a), BatchReflect a) - => BatchReflect (V.Vector a) where + instance BatchReflect a => BatchReflect (V.Vector a) where newBatchReader _ = do _b <- unsafeUngeneric <$> newBatchReader (Proxy :: Proxy a) generic <$> [java| new BatchReaders.ObjectArrayBatchReader($_b) |] diff --git a/src/test/haskell/Language/Java/BatchingSpec.hs b/src/test/haskell/Language/Java/BatchingSpec.hs --- a/src/test/haskell/Language/Java/BatchingSpec.hs +++ b/src/test/haskell/Language/Java/BatchingSpec.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -{-# OPTIONS_GHC -fplugin=Language.Java.Inline.Plugin #-} module Language.Java.BatchingSpec where diff --git a/src/test/haskell/Spec.hs b/src/test/haskell/Spec.hs --- a/src/test/haskell/Spec.hs +++ b/src/test/haskell/Spec.hs @@ -1,1 +1,2 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -F -pgmF HSPEC_DISCOVER -optF --module-name=Spec #-}