menoh 0.1.1 → 0.2.0

raw patch · 7 files changed

+507/−55 lines, 7 filesdep +asyncdep +tastydep +tasty-hunitdep ~JuicyPixelsdep ~basedep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: async, tasty, tasty-hunit, tasty-th

Dependency ranges changed: JuicyPixels, base, vector

API changes (from Hackage documentation)

Files

• README.md +10/−1
• app/mnist_example.hs +5/−6
• app/vgg16_example.hs +3/−3
• menoh.cabal +40/−5
• src/Menoh.hs +183/−40
• src/Menoh/Base.hsc +15/−0
• test/test.hs +251/−0

@@ -2,6 +2,9 @@  [![Hackage](https://img.shields.io/hackage/v/menoh.svg)](https://hackage.haskell.org/package/menoh) [![Hackage Deps](https://img.shields.io/hackage-deps/v/menoh.svg)](https://packdeps.haskellers.com/feed?needle=menoh)+[![Build Status (Travis CI)](https://travis-ci.org/pfnet-research/menoh-haskell.svg?branch=master)](https://travis-ci.org/pfnet-research/menoh-haskell)+[![Build Status (AppVeyor)](https://ci.appveyor.com/api/projects/status/x4yicemyr55cj6na/branch/master?svg=true)](https://ci.appveyor.com/project/pfnet-research/menoh-haskell/branch/master)+[![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT)  Haskell binding for [Menoh](https://github.com/pfnet-research/menoh/) DNN inference library. @@ -53,7 +56,13 @@ stack install ``` -# Licence+# Documents++* [API reference manual](http://hackage.haskell.org/package/menoh) is available on Hackage.++* see [mnist_example.hs](app/mnist_example.hs) and [vgg16_example.hs](app/vgg16_example.hs) for example usage.++# License  Note: `retrieve_data.sh` downloads `data/VGG16.onnx`. `data/VGG16.onnx` is generated by onnx-chainer from pre-trained model which is uploaded at http://www.robots.ox.ac.uk/%7Evgg/software/very_deep/caffe/VGG_ILSVRC_16_layers.caffemodel

@@ -45,7 +45,7 @@       input_dims  = [batch_size, channel_num, height, width]       output_dims = [batch_size, category_num] -  images <- liftM VS.concat $ forM image_filenames $ \fname -> do+  images <- forM image_filenames $ \fname -> do     ret <- Picture.readImage $ input_dir </> fname     case ret of       Left e -> error e@@ -69,16 +69,15 @@   model <- makeModel vpt model_data "mkldnn"    -- Copy input image data to model's input array-  writeBufferFromStorableVector model mnist_in_name images+  writeBuffer model mnist_in_name images    -- Run inference   run model    -- Get output-  (v :: V.Vector Float) <- readBufferToVector model mnist_out_name-  forM_ (zip [0..] image_filenames) $ \(i,fname) -> do-    let scores = V.slice (i * category_num) category_num v-        j = V.maxIndex scores+  (vs :: [V.Vector Float]) <- readBuffer model mnist_out_name+  forM_ (zip vs image_filenames) $ \(scores,fname) -> do+    let j = V.maxIndex scores         s = scores V.! j     printf "%s = %d : %f\n" fname j s 

@@ -55,20 +55,20 @@   model <- makeModel vpt model_data "mkldnn"    -- Copy input image data to model's input array-  writeBufferFromStorableVector model conv1_1_in_name image_data+  writeBuffer model conv1_1_in_name [image_data]    -- Run inference   run model    -- Get output-  (fc6_out :: V.Vector Float) <- readBufferToVector model fc6_out_name+  ([fc6_out] :: [V.Vector Float]) <- readBuffer model fc6_out_name   putStr "fc6_out: "   forM_ [0..4] $ \i -> do     putStr $ show $ fc6_out V.! i     putStr " "   putStrLn "..." -  (softmax_out :: V.Vector Float) <- readBufferToVector model softmax_out_name+  ([softmax_out] :: [V.Vector Float]) <- readBuffer model softmax_out_name    categories <- liftM lines $ readFile (optSynsetWordsPath opt)   let k = 5

@@ -1,5 +1,5 @@ name: menoh-version: 0.1.1+version: 0.2.0 license: MIT license-file: LICENSE author: Masahiro Sakai <sakai@preferred.jp>@@ -17,11 +17,22 @@ data-files:    data/*.png    data/mnist.onnx+tested-with:+   GHC ==7.8.4+   GHC ==7.10.3+   GHC ==8.0.2+   GHC ==8.2.2+   GHC ==8.4.3  source-repository head   type: git   location: https://github.com/pfnet-research/menoh-haskell/ +flag buildexamples+  description: build example programs+  default: True+  manual: True+ library   hs-source-dirs: src   exposed-modules:@@ -31,19 +42,20 @@     Paths_menoh   other-extensions:       CPP+    , DeriveDataTypeable     , FlexibleContexts     , ForeignFunctionInterface     , ScopedTypeVariables   build-depends:       base >=4.7 && <5-    , aeson >=0.8 && <1.3+    , aeson >=0.8 && <1.5     , bytestring >=0.10 && <0.11-    , containers >=0.5 && <0.6+    , containers >=0.5 && <0.7     , monad-control >=1.0 && <1.1     , transformers >=0.3 && <0.6     , vector >=0.10 && <0.13   pkgconfig-depends:-      menoh >=1.0.0+      menoh >=1.0.0 && <2.0.0   default-language: Haskell2010  executable vgg16_example@@ -52,11 +64,13 @@   build-depends:       base       -- convertRGB8 requires JuicyPixels >=3.2.7-    , JuicyPixels >=3.2.7 && <3.3+    , JuicyPixels >=3.2.7 && <3.4     , optparse-applicative >=0.11 && <0.15     , menoh     , vector   default-language: Haskell2010+  If !flag(buildexamples)+    buildable: False  executable mnist_example   hs-source-dirs: app@@ -70,3 +84,24 @@     , menoh     , vector   default-language: Haskell2010+  If !flag(buildexamples)+    buildable: False++Test-suite Test+  type:              exitcode-stdio-1.0+  hs-source-dirs:    test+  main-is:           test.hs+  other-modules:+    Paths_menoh+  build-depends:+      base >=4 && <5+    , async >=2.0.2+    , filepath >=1.3 && <1.5+    , JuicyPixels+    , menoh+    , vector+    , tasty >=0.10.1+    , tasty-hunit >=0.9 && <0.11+    , tasty-th+  default-language: Haskell2010+  ghc-options: -threaded

@@ -1,6 +1,8 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- |@@ -17,35 +19,44 @@ -- = Basic usage -- -- 1. Load computation graph from ONNX file using 'makeModelDataFromONNX'.--- -- 2. Specify input variable type/dimentions (in particular batch size) and---    which output variables you want to retrieve. These information is---    represented as 'VariableProfileTable'.---    Simple way to construct 'VariableProfileTable' is to use 'makeVariableProfileTable'.---+--    which output variables you want to retrieve. This can be done by+--    constructing 'VariableProfileTable' using 'makeVariableProfileTable'. -- 3. Optimize 'ModelData' with respect to your 'VariableProfileTable' by using --    'optimizeModelData'.--- -- 4. Construct a 'Model' using 'makeModel' or 'makeModelWithConfig'. --    If you want to use custom buffers instead of internally allocated ones, --    You need to use more low level 'ModelBuilder'.+-- 5. Load input data. This can be done conveniently using 'writeBuffer'.+--    There are also more low-level API such as 'unsafeGetBuffer' and 'withBuffer'.+-- 6. Run inference using 'run'.+-- 7. Retrieve the result data. This can be done conveniently using 'readBuffer'. ----- 5. Load input data. This can be done conveniently using 'writeBufferFromVector'---    or 'writeBufferFromStorableVector'. There are also more low-level API such as---    'unsafeGetBuffer' and 'withBuffer'.+-- = Note on thread safety ----- 6. Run inference using 'run'.+-- TL;DR: If you want to use Menoh from multiple haskell threads, you need to+-- use /threaded/ RTS by supplying @-threaded@ option to GHC. ----- 7. Retrieve the result data. This can be done conveniently using 'readBufferToVector'---    or 'readBufferToStorableVector'.+-- Menoh uses thread local storage (TLS) for storing error information, and+-- the only way to use TLS safely is to use in /bound/ threads+-- (see "Control.Concurrent#boundthreads"). --+-- * In /threaded RTS/ (i.e. 'rtsSupportsBoundThreads' is True), this module+--   runs computation in bound threads by using 'runInBoundThread'. (If the+--   calling thread is not bound, 'runInBoundThread' create a bound thread+--   temporarily and run the computation inside it).+--+-- * In /non-threaded RTS/, this module /does not/ use 'runInBoundThread' and+--   is therefore unsafe to use from multiple haskell threads. Using non-threaded+--   RTS is allowed for the sake of convenience (e.g. running in GHCi) despite+--   its unsafety.+-- ----------------------------------------------------------------------------- module Menoh   (   -- * Basic data types     Dims   , DType (..)-  , HasDType (..)   , Error (..)    -- * ModelData type@@ -53,6 +64,12 @@   , makeModelDataFromONNX   , optimizeModelData +  -- * VariableProfileTable+  , VariableProfileTable (..)+  , makeVariableProfileTable+  , vptGetDType+  , vptGetDims+   -- * Model type   , Model (..)   , makeModel@@ -60,8 +77,16 @@   , run   , getDType   , getDims+  -- ** Accessors for buffers+  , ToBuffer (..)+  , FromBuffer (..)+  , writeBuffer+  , readBuffer+  -- ** Low-level accessors for buffers   , unsafeGetBuffer   , withBuffer+  -- ** Deprecated accessors for buffers+  , HasDType (..)   , writeBufferFromVector   , writeBufferFromStorableVector   , readBufferToVector@@ -72,11 +97,6 @@   , bindingVersion    -- * Low-level API-  -- ** VariableProfileTable-  , VariableProfileTable (..)-  , makeVariableProfileTable-  , vptGetDType-  , vptGetDims    -- ** Builder for 'VariableProfileTable'   , VariableProfileTableBuilder (..)@@ -94,6 +114,7 @@   , buildModelWithConfig   ) where +import Control.Applicative import Control.Concurrent import Control.Monad import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp)@@ -103,9 +124,12 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Data.Proxy+import Data.Typeable+import qualified Data.Vector as V+import qualified Data.Vector.Generic as VG import qualified Data.Vector.Storable as VS import qualified Data.Vector.Storable.Mutable as VSM-import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Unboxed as VU import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.Version@@ -137,7 +161,7 @@   | ErrorFailedToConfigureOperator String   | ErrorBackendError String   | ErrorSameNamedVariableAlreadyExist String-  deriving (Eq, Ord, Show, Read)+  deriving (Eq, Ord, Show, Read, Typeable)  instance Exception Error @@ -193,6 +217,11 @@   fromEnum DTypeFloat = fromIntegral Base.menohDtypeFloat   fromEnum (DTypeUnknown i) = fromIntegral i +dtypeSize :: DType -> Int+dtypeSize DTypeFloat = sizeOf (undefined :: CFloat)+dtypeSize (DTypeUnknown _) = error "Menoh.dtypeSize: unknown DType"++{-# DEPRECATED HasDType "use FromBuffer/ToBuffer instead" #-} -- | Haskell types that have associated 'DType' type code. class Storable a => HasDType a where   dtypeOf :: Proxy a -> DType@@ -323,7 +352,7 @@   -> [(String, DType)]        -- ^ required output name list with dtypes   -> ModelData                -- ^ model data   -> m VariableProfileTable-makeVariableProfileTable input_name_and_dims_pair_list required_output_name_list model_data = liftIO $ do+makeVariableProfileTable input_name_and_dims_pair_list required_output_name_list model_data = liftIO $ runInBoundThread' $ do   b <- makeVariableProfileTableBuilder   forM_ input_name_and_dims_pair_list $ \(name,dtype,dims) -> do     addInputProfileDims b name dtype dims@@ -344,7 +373,7 @@ -- -- Select variable name and get its 'Dims'. vptGetDims :: MonadIO m => VariableProfileTable -> String -> m Dims-vptGetDims (VariableProfileTable vpt) name = liftIO $+vptGetDims (VariableProfileTable vpt) name = liftIO $ runInBoundThread' $   withForeignPtr vpt $ \vpt' -> withCString name $ \name' -> alloca $ \ret -> do     runMenoh $ Base.menoh_variable_profile_table_get_dims_size vpt' name' ret     size <- peek ret@@ -433,7 +462,7 @@  -- | Get 'Dims' of target variable. getDims :: MonadIO m => Model -> String -> m Dims-getDims (Model m) name = liftIO $ do+getDims (Model m) name = liftIO $ runInBoundThread' $ do   withForeignPtr m $ \m' -> withCString name $ \name' -> alloca $ \ret -> do     runMenoh $ Base.menoh_model_get_variable_dims_size m' name' ret     size <- peek ret@@ -441,6 +470,9 @@       runMenoh $ Base.menoh_model_get_variable_dims_at m' name' (fromIntegral i) ret       fromIntegral <$> peek ret +-- ------------------------------------------------------------------------+-- Accessing buffers+ -- | Get a buffer handle attached to target variable. -- -- Users can get a buffer handle attached to target variable.@@ -473,6 +505,118 @@       peek ret     f p +-- | Type that can be written to menoh's buffer.+class ToBuffer a where+  -- Basic method for implementing @ToBuffer@ class.+  -- Normal user should use 'writeBuffer' instead.+  basicWriteBuffer :: DType -> Dims -> Ptr () -> a -> IO ()++-- | Type that can be read from menoh's buffer.+class FromBuffer a where+  -- Basic method for implementing @FromBuffer@ class.+  -- Normal user should use 'readBuffer' instead.+  basicReadBuffer :: DType -> Dims -> Ptr () -> IO a++-- | Read values from the given model's buffer+readBuffer :: (FromBuffer a, MonadIO m) => Model -> String -> m a+readBuffer model name = liftIO $ withBuffer model name $ \p -> do+  dtype <- getDType model name+  dims <- getDims model name+  basicReadBuffer dtype dims p++-- | Write values to the given model's buffer+writeBuffer :: (ToBuffer a, MonadIO m) => Model -> String -> a -> m ()+writeBuffer model name a = liftIO $ withBuffer model name $ \p -> do+  dtype <- getDType model name+  dims <- getDims model name+  basicWriteBuffer dtype dims p a+++-- | Default implementation of 'basicWriteBuffer' for 'VG.Vector' class+-- for the cases whete the 'Storable' is compatible for representation in buffers.+basicWriteBufferGenericVectorStorable+  :: forall v a. (VG.Vector v a, Storable a)+  => DType -> DType -> Dims -> Ptr () -> v a -> IO ()+basicWriteBufferGenericVectorStorable dtype0 dtype dims p vec = do+  let n = product dims+      p' = castPtr p+  checkDTypeAndSize "Menoh.basicWriteBufferGenericVectorStorable" (dtype, n) (dtype0, VG.length vec)+  forM_ [0..n-1] $ \i -> do+    pokeElemOff p' i (vec VG.! i)++-- | Default implementation of 'basicReadToBuffer' for 'VG.Vector' class+-- for the cases whete the 'Storable' is compatible for representation in buffers.+basicReadBufferGenericVectorStorable+  :: forall v a. (VG.Vector v a, Storable a)+  => DType -> DType -> Dims -> Ptr () -> IO (v a)+basicReadBufferGenericVectorStorable dtype0 dtype dims p = do+  checkDType "Menoh.basicReadBufferGenericVectorStorable" dtype dtype0+  let n = product dims+      p' = castPtr p+  VG.generateM n $ peekElemOff p'+++-- | Default implementation of 'basicWriteBuffer' for 'VS.Vector' class+-- for the cases whete the 'Storable' is compatible for representation in buffers.+basicWriteBufferStorableVector+  :: forall a. (Storable a)+  => DType -> DType -> Dims -> Ptr () -> VS.Vector a -> IO ()+basicWriteBufferStorableVector dtype0 dtype dims p vec = do+  let n = product dims+  checkDTypeAndSize "Menoh.basicWriteBufferStorableVector" (dtype, n) (dtype0, VG.length vec)+  VS.unsafeWith vec $ \src -> do+    copyArray (castPtr p) src n++-- | Default implementation of 'basicReadToBuffer' for 'VS.Vector' class+-- for the cases whete the 'Storable' is compatible for representation in buffers.+basicReadBufferStorableVector+  :: forall a. (Storable a)+  => DType -> DType -> Dims -> Ptr () -> IO (VS.Vector a)+basicReadBufferStorableVector dtype0 dtype dims p = do+  checkDType "Menoh.basicReadBufferStorableVector" dtype dtype0+  let n = product dims+  vec <- VSM.new n+  VSM.unsafeWith vec $ \dst -> copyArray dst (castPtr p) n+  VS.unsafeFreeze vec+++instance ToBuffer (V.Vector Float) where+  basicWriteBuffer = basicWriteBufferGenericVectorStorable DTypeFloat+instance FromBuffer (V.Vector Float) where+  basicReadBuffer = basicReadBufferGenericVectorStorable DTypeFloat+++instance ToBuffer (VU.Vector Float) where+  basicWriteBuffer = basicWriteBufferGenericVectorStorable DTypeFloat+instance FromBuffer (VU.Vector Float) where+  basicReadBuffer = basicReadBufferGenericVectorStorable DTypeFloat+++instance ToBuffer (VS.Vector Float) where+  basicWriteBuffer = basicWriteBufferStorableVector DTypeFloat+instance FromBuffer (VS.Vector Float) where+  basicReadBuffer = basicReadBufferStorableVector DTypeFloat+++instance ToBuffer a => ToBuffer [a] where+  basicWriteBuffer _dtype [] _p _xs =+    throwIO $ ErrorDimensionMismatch $ "ToBuffer{[a]}.basicWriteBuffer: empty dims"+  basicWriteBuffer dtype (dim : dims) p xs = do+    unless (dim == length xs) $ do+      throwIO $ ErrorDimensionMismatch $ "ToBuffer{[a]}.basicWriteBuffer: dimension mismatch"+    let s = product dims * dtypeSize dtype+    forM_ (zip [0,s..] xs) $ \(offset,x) -> do+      basicWriteBuffer dtype dims (p `plusPtr` offset) x++instance FromBuffer a => FromBuffer [a] where+  basicReadBuffer _dtype [] _p =+    throwIO $ ErrorDimensionMismatch $ "FromBuffer{[a]}.basicReadBuffer: empty dims"+  basicReadBuffer dtype (dim : dims) p = do+    let s = product dims * dtypeSize dtype+    forM [0..dim-1] $ \i -> do+      basicReadBuffer dtype dims (p `plusPtr` (i*s))++ checkDType :: String -> DType -> DType -> IO () checkDType name dtype1 dtype2   | dtype1 /= dtype2 = throwIO $ ErrorInvalidDType $ name ++ ": dtype mismatch"@@ -484,46 +628,41 @@   | n1 /= n2         = throwIO $ ErrorDimensionMismatch $ name ++ ": dimension mismatch"   | otherwise        = return () ++{-# DEPRECATED writeBufferFromVector, writeBufferFromStorableVector "Use ToBuffer class and writeBuffer instead" #-}+ -- | Copy whole elements of 'VG.Vector' into a model's buffer writeBufferFromVector :: forall v a m. (VG.Vector v a, HasDType a, MonadIO m) => Model -> String -> v a -> m () writeBufferFromVector model name vec = liftIO $ withBuffer model name $ \p -> do   dtype <- getDType model name   dims <- getDims model name-  let n = product dims-  checkDTypeAndSize "Menoh.writeBufferFromVector" (dtype, n) (dtypeOf (Proxy :: Proxy a), VG.length vec)-  forM_ [0..n-1] $ \i -> do-    pokeElemOff p i (vec VG.! i)+  basicWriteBufferGenericVectorStorable (dtypeOf (Proxy :: Proxy a)) dtype dims p vec  -- | Copy whole elements of @'VS.Vector' a@ into a model's buffer writeBufferFromStorableVector :: forall a m. (HasDType a, MonadIO m) => Model -> String -> VS.Vector a -> m () writeBufferFromStorableVector model name vec = liftIO $ withBuffer model name $ \p -> do   dtype <- getDType model name   dims <- getDims model name-  let n = product dims-  checkDTypeAndSize "Menoh.writeBufferFromStorableVector" (dtype, n) (dtypeOf (Proxy :: Proxy a), VG.length vec)-  VS.unsafeWith vec $ \src -> do-    copyArray p src n+  basicWriteBufferStorableVector (dtypeOf (Proxy :: Proxy a)) dtype dims p vec +{-# DEPRECATED readBufferToVector, readBufferToStorableVector "Use FromBuffer class and readBuffer instead" #-}+ -- | Read whole elements of 'Array' and return as a 'VG.Vector'. readBufferToVector :: forall v a m. (VG.Vector v a, HasDType a, MonadIO m) => Model -> String -> m (v a) readBufferToVector model name = liftIO $ withBuffer model name $ \p -> do   dtype <- getDType model name   dims <- getDims model name-  checkDType "Menoh.readBufferToVector" dtype (dtypeOf (Proxy :: Proxy a))-  let n = product dims-  VG.generateM n $ peekElemOff p+  basicReadBufferGenericVectorStorable (dtypeOf (Proxy :: Proxy a)) dtype dims p --- | Read whole eleemnts of 'Array' and return as a @'VS.Vector' 'Float'@.+-- | Read whole eleemnts of 'Array' and return as a 'VS.Vector'. readBufferToStorableVector :: forall a m. (HasDType a, MonadIO m) => Model -> String -> m (VS.Vector a) readBufferToStorableVector model name = liftIO $ withBuffer model name $ \p -> do   dtype <- getDType model name   dims <- getDims model name-  checkDType "Menoh.readBufferToStorableVector" dtype (dtypeOf (Proxy :: Proxy a))-  let n = product dims-  vec <- VSM.new n-  VSM.unsafeWith vec $ \dst -> copyArray dst p n-  VS.unsafeFreeze vec+  basicReadBufferStorableVector (dtypeOf (Proxy :: Proxy a)) dtype dims p +-- ------------------------------------------------------------------------+ -- | Convenient methods for constructing  a 'Model'. makeModel   :: MonadIO m@@ -551,7 +690,11 @@  -- | Menoh version which was supplied on compilation time via CPP macro. version :: Version+#if MIN_VERSION_base(4,8,0) version = makeVersion [Base.menoh_major_version, Base.menoh_minor_version, Base.menoh_patch_version]+#else+version = Version [Base.menoh_major_version, Base.menoh_minor_version, Base.menoh_patch_version] []+#endif  -- | Version of this Haskell binding. (Not the version of /Menoh/ itself) bindingVersion :: Version

@@ -1,5 +1,20 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Menoh.Base+-- Copyright   :  Copyright (c) 2018 Preferred Networks, Inc.+-- License     :  MIT (see the file LICENSE)+--+-- Maintainer  :  Masahiro Sakai <sakai@preferred.jp>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- FFI imports of Menoh library.+--+-- See https://pfnet-research.github.io/menoh/ for details of those API.+--+----------------------------------------------------------------------------- module Menoh.Base where  import Data.Int

@@ -0,0 +1,251 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++import qualified Codec.Picture as Picture+import Control.Concurrent.Async+import Control.Exception+import Control.Monad+import qualified Data.Vector as V+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import Foreign+import System.FilePath++import Test.Tasty.HUnit+import Test.Tasty.TH++import Menoh+import Paths_menoh (getDataDir)++------------------------------------------------------------------------++case_basicWriteBuffer_vector ::  Assertion+case_basicWriteBuffer_vector = do+  allocaArray 9 $ \(p :: Ptr Float) -> do+    basicWriteBuffer DTypeFloat [3,3] (castPtr p) (VG.tail (V.fromList xs))+    ys <- peekArray 9 p+    ys @?= (tail xs)+  where+    xs = [0..9]++case_basicWriteBuffer_vector_storable ::  Assertion+case_basicWriteBuffer_vector_storable = do+  allocaArray 9 $ \(p :: Ptr Float) -> do+    basicWriteBuffer DTypeFloat [3,3] (castPtr p) (VG.tail (VS.fromList xs))+    ys <- peekArray 9 p+    ys @?= tail xs+  where+    xs = [0..9]++case_basicWriteBuffer_vector_unboxed ::  Assertion+case_basicWriteBuffer_vector_unboxed = do+  allocaArray 9 $ \(p :: Ptr Float) -> do+    basicWriteBuffer DTypeFloat [3,3] (castPtr p) (VG.tail (VU.fromList xs))+    ys <- peekArray 9 p+    ys @?= tail xs+  where+    xs = [0..9]++case_basicWriteBuffer_list ::  Assertion+case_basicWriteBuffer_list = do+  allocaArray 9 $ \(p :: Ptr Float) -> do+    basicWriteBuffer DTypeFloat [3,3] (castPtr p) (map V.fromList xss)+    ys <- peekArray 9 p+    ys @?= concat xss+  where+    xss = [[1,2,3], [4,5,6], [7,8,9]]++------------------------------------------------------------------------++case_loading_nonexistent_model_file :: Assertion+case_loading_nonexistent_model_file = do+  dataDir <- getDataDir+  ret <- try $ makeModelDataFromONNX $ dataDir </> "data" </> "nonexistent_model.onnx"+  case ret of+    Left (ErrorInvalidFilename _msg) -> return ()+    _ -> assertFailure "should throw ErrorInvalidFilename"+++case_empty_output :: Assertion+case_empty_output = do+  images <- loadMNISTImages+  let batch_size = length images++  dataDir <- getDataDir+  model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+  vpt <- makeVariableProfileTable+           [(mnist_in_name, DTypeFloat, [batch_size, mnist_channel_num, mnist_height, mnist_width])]+           []+           model_data+  optimizeModelData model_data vpt+  model <- makeModel vpt model_data "mkldnn"++  -- Run the model+  writeBuffer model mnist_in_name images+  run model++  -- but we cannot retrieve results+  return ()+++case_insufficient_input :: Assertion+case_insufficient_input = do+  dataDir <- getDataDir+  model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+  ret <- try $ makeVariableProfileTable+    []+    [(mnist_out_name, DTypeFloat)]+    model_data+  case ret of+    Left (ErrorVariableNotFound _msg) -> return ()+    _ -> assertFailure "should throw ErrorVariableNotFound"+++case_bad_input :: Assertion+case_bad_input = do+  images <- loadMNISTImages++  dataDir <- getDataDir+  model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+  vpt <- makeVariableProfileTable+           [ (mnist_in_name, DTypeFloat, [length images, mnist_channel_num, mnist_height, mnist_width])+           , ("bad input name", DTypeFloat, [1,8])+           ]+           [(mnist_out_name, DTypeFloat)]+           model_data+  optimizeModelData model_data vpt+  model <- makeModel vpt model_data "mkldnn"++  -- Run the model+  writeBuffer model mnist_in_name images+  run model+  (vs :: [V.Vector Float]) <- readBuffer model mnist_out_name+  forM_ (zip [0..9] vs) $ \(i, scores) -> do+    V.maxIndex scores @?= i+++case_bad_output :: Assertion+case_bad_output = do+  images <- loadMNISTImages++  dataDir <- getDataDir+  model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+  ret <- try $ makeVariableProfileTable+    [(mnist_in_name, DTypeFloat, [length images, mnist_channel_num, mnist_height, mnist_width])]+    [(mnist_out_name, DTypeFloat), ("bad output name", DTypeFloat)]+    model_data+  case ret of+    Left (ErrorVariableNotFound _msg) -> return ()+    _ -> assertFailure "should throw ErrorVariableNotFound"+++------------------------------------------------------------------------++-- Aliases to onnx's node input and output tensor name+mnist_in_name, mnist_out_name :: String+mnist_in_name  = "139900320569040"+mnist_out_name = "139898462888656"++mnist_channel_num, mnist_height, mnist_width :: Int+mnist_channel_num = 1+mnist_height = 28+mnist_width  = 28++loadMNISTImages :: IO [VS.Vector Float]+loadMNISTImages = do+  dataDir <- getDataDir+  forM [(0::Int)..9] $ \i -> do+    ret <- Picture.readImage $ dataDir </> "data" </> (show i ++ ".png")+    case ret of+      Left e -> error e+      Right img -> return $ convert mnist_width mnist_height img++loadMNISTModel :: Int -> IO Model+loadMNISTModel batch_size = do+  dataDir <- getDataDir+  model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+  vpt <- makeVariableProfileTable+           [(mnist_in_name, DTypeFloat, [batch_size, mnist_channel_num, mnist_height, mnist_width])]+           [(mnist_out_name, DTypeFloat)]+           model_data+  optimizeModelData model_data vpt+  makeModel vpt model_data "mkldnn"++case_MNIST :: Assertion+case_MNIST = do+  images <- loadMNISTImages+  model <- loadMNISTModel (length images)++  -- Run the model+  writeBuffer model mnist_in_name images+  run model+  (vs :: [V.Vector Float]) <- readBuffer model mnist_out_name+  forM_ (zip [0..9] vs) $ \(i, scores) -> do+    V.maxIndex scores @?= i++  -- Run the same model more than once, but with the different order+  writeBuffer model mnist_in_name (reverse images)+  run model+  (vs' :: [V.Vector Float]) <- readBuffer model mnist_out_name+  forM_ (zip [9,8..0] vs') $ \(i, scores) -> do+    V.maxIndex scores @?= i++case_MNIST_concurrently :: Assertion+case_MNIST_concurrently = do+  images <- loadMNISTImages+  let batch_size = length images++  dataDir <- getDataDir+  model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+  vpt <- makeVariableProfileTable+           [(mnist_in_name, DTypeFloat, [batch_size, mnist_channel_num, mnist_height, mnist_width])]+           [(mnist_out_name, DTypeFloat)]+           model_data+  optimizeModelData model_data vpt+  models <- replicateM 10 $ makeModel vpt model_data "mkldnn"++  _ <- flip mapConcurrently models $ \model -> do+    replicateM_ 10 $ do+      writeBuffer model mnist_in_name images+      run model+      (vs :: [V.Vector Float]) <- readBuffer model mnist_out_name+      forM_ (zip [0..9] vs) $ \(i, scores) -> do+        V.maxIndex scores @?= i+  return ()++-- -------------------------------------------------------------------------++convert :: Int -> Int -> Picture.DynamicImage -> VS.Vector Float+convert w h = reorderToNCHW . resize (w,h) . crop . Picture.convertRGB8++crop :: Picture.Pixel a => Picture.Image a -> Picture.Image a+crop img = Picture.generateImage (\x y -> Picture.pixelAt img (base_x + x) (base_y + y)) shortEdge shortEdge+  where+    shortEdge = min (Picture.imageWidth img) (Picture.imageHeight img)+    base_x = (Picture.imageWidth  img - shortEdge) `div` 2+    base_y = (Picture.imageHeight img - shortEdge) `div` 2++-- TODO: Should we do some kind of interpolation?+resize :: Picture.Pixel a => (Int,Int) -> Picture.Image a -> Picture.Image a+resize (w,h) img = Picture.generateImage (\x y -> Picture.pixelAt img (x * orig_w `div` w) (y * orig_h `div` h)) w h+  where+    orig_w = Picture.imageWidth  img+    orig_h = Picture.imageHeight img++reorderToNCHW :: Picture.Image Picture.PixelRGB8 -> VS.Vector Float+reorderToNCHW img = VS.generate (Picture.imageHeight img * Picture.imageWidth img) f+  where+    f i =+      case Picture.pixelAt img x y of+        Picture.PixelRGB8 r g b ->+          (fromIntegral r + fromIntegral g + fromIntegral b) / 3+      where+        (y,x) = i `divMod` Picture.imageWidth img++------------------------------------------------------------------------+-- Test harness++main :: IO ()+main = $(defaultMainGenerator)