jvm 0.4.0.1 → 0.4.1

raw patch · 3 files changed

+43/−8 lines, 3 files

Files

benchmarks/Main.hs +15/−0
jvm.cabal +1/−1
src/Language/Java.hs +27/−7

benchmarks/Main.hs view

@@ -8,6 +8,7 @@  import Control.DeepSeq (NFData(..)) import Criterion.Main as Criterion+import Control.Monad (replicateM_) import Data.Int import Data.Singletons (SomeSing(..)) import qualified Foreign.Concurrent as Concurrent@@ -55,6 +56,20 @@         , bench "jni static method call: unboxed single arg / unboxed return" $ nfIO $ jniAbs klass method 1         , bench "method call: no args / unboxed return" $ nfIO $ intValue 1         , bench "method call: boxed single arg / unboxed return" $ nfIO $ compareTo 1 1+        , bench "local frame / 1 reference" $ nfIO $ do+            pushLocalFrame 30+            _ <- newLocalRef klass+            _ <- popLocalFrame jnull+            return ()+        , bench "delete 1 local ref" $ nfIO $+            newLocalRef klass >>= deleteLocalRef+        , bench "local frame / 30 references" $ nfIO $ do+            pushLocalFrame 30+            replicateM_ 30 $ newLocalRef klass+            _ <- popLocalFrame jnull+            return ()+        , bench "delete 30 local refs" $ nfIO $+            replicateM_ 30 $ newLocalRef klass >>= deleteLocalRef         ]       , bgroup "Haskell calls"         [ bench "incr haskell" $ nfIO $ incrHaskell 1

jvm.cabal view

@@ -1,5 +1,5 @@ name:                jvm-version:             0.4.0.1+version:             0.4.1 synopsis:            Call JVM methods from Haskell. description:         Please see README.md. homepage:            http://github.com/tweag/inline-java/tree/master/jvm#readme

src/Language/Java.hs view

@@ -69,6 +69,7 @@   , pop   , popWithObject   , popWithValue+  , withLocalRef   -- * Coercions   , CoercionFailure(..)   , Coercible(..)@@ -85,7 +86,7 @@ import Control.Distributed.Closure.TH import Control.Exception (Exception, throw, finally) import Control.Monad-import Control.Monad.Catch (MonadCatch, onException)+import Control.Monad.Catch (MonadCatch, MonadMask, bracket, onException) import Control.Monad.IO.Class import Data.Char (chr, ord) import qualified Data.Choice as Choice@@ -157,6 +158,12 @@ popWithValue :: Monad m => a -> m (Pop a) popWithValue x = return (PopValue x) +-- | Create a local ref and delete it when the given action completes.+withLocalRef+  :: (MonadMask m, MonadIO m, Coerce.Coercible o (J ty))+  => m o -> (o -> m a) -> m a+withLocalRef m = bracket m (liftIO . deleteLocalRef)+ -- Note [Class lookup memoization] -- -- By using unsafeDupablePerformIO, we mark the lookup actions as pure. When the@@ -469,19 +476,23 @@ -- say, unmarshall a Java object to a Haskell value. Unlike coercing, in general -- reifying induces allocations and copies. class Interpretation a => Reify a where+  -- | Invariant: The result and the argument share no direct JVM object+  -- references.   reify :: J (Interp a) -> IO a    default reify :: (Coercible a, Interp a ~ Ty a) => J (Interp a) -> IO a-  reify x = return (unsafeUncoerce (JObject x))+  reify x = unsafeUncoerce . JObject <$> (newLocalRef x :: IO (J (Ty a)))  -- | Inject a concrete Haskell value into the space of Java objects. That is to -- say, marshall a Haskell value to a Java object. Unlike coercing, in general -- reflection induces allocations and copies. class Interpretation a => Reflect a where+  -- | Invariant: The result and the argument share no direct JVM object+  -- references.   reflect :: a -> IO (J (Interp a))    default reflect :: (Coercible a, Interp a ~ Ty a) => a -> IO (J (Interp a))-  reflect x = return (jobject x)+  reflect x = newLocalRef (jobject x)  #if ! (__GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1) reifyMVector@@ -704,13 +715,22 @@   instance Reflect (IOVector Int32) where     reflect = reflectMVector (newIntArray) (setIntArrayRegion) -  instance Interpretation (Vector Int32) where-    type Interp (Vector Int32) = 'Array ('Prim "int")+  instance Interpretation (IOVector Double) where+    type Interp (IOVector Double) = 'Array ('Prim "double") -  instance Reify (Vector Int32) where+  instance Reify (IOVector Double) where+    reify = reifyMVector (getDoubleArrayElements) (releaseDoubleArrayElements)++  instance Reflect (IOVector Double) where+    reflect = reflectMVector (newDoubleArray) (setDoubleArrayRegion)++  instance Interpretation (IOVector a) => Interpretation (Vector a) where+    type Interp (Vector a) = Interp (IOVector a)++  instance (Storable a, Reify (IOVector a)) => Reify (Vector a) where     reify = Vector.freeze <=< reify -  instance Reflect (Vector Int32) where+  instance (Storable a, Reflect (IOVector a)) => Reflect (Vector a) where     reflect = reflect <=< Vector.thaw #endif   instance Interpretation a => Interpretation [a] where