menoh (empty) → 0.1.0
raw patch · 20 files changed
+1169/−0 lines, 20 filesdep +JuicyPixelsdep +aesondep +basesetup-changedbinary-added
Dependencies added: JuicyPixels, aeson, base, bytestring, containers, filepath, menoh, monad-control, optparse-applicative, transformers, vector
Files
- LICENSE +22/−0
- README.md +58/−0
- Setup.hs +2/−0
- app/mnist_example.hs +153/−0
- app/vgg16_example.hs +164/−0
- data/0.png binary
- data/1.png binary
- data/2.png binary
- data/3.png binary
- data/4.png binary
- data/5.png binary
- data/6.png binary
- data/7.png binary
- data/8.png binary
- data/9.png binary
- data/mnist.onnx too large to diff
- menoh.cabal +71/−0
- retrieve_data.sh +3/−0
- src/Menoh.hs +558/−0
- src/Menoh/Base.hsc +138/−0
+ LICENSE view
@@ -0,0 +1,22 @@++MIT License++Copyright (c) 2018 Preferred Networks, Inc.++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,58 @@+# menoh-haskell++Haskell binding for [Menoh](https://github.com/pfnet-research/menoh/) DNN inference library.++# Requirements++- [Menoh](https://github.com/pfnet-research/menoh/)+- [The Haskell Tool Stack](https://www.haskellstack.org/)++# Build++Execute below commands in root directory.++```+sh retrieve_data.sh+stack build+```++# Running VGG16 example++Execute below command in root directory.++```+cd menoh+stack exec vgg16_example+```++Result is below++```+vgg16 example+fc6_out: -19.079105 -37.94045 -16.185831 25.51685 4.432623 ...+top 5 categories are:+8 0.958079 n01514859 hen+7 0.039541963 n01514668 cock+86 0.0018722217 n01807496 partridge+82 0.00027406064 n01797886 ruffed grouse, partridge, Bonasa umbellus+97 0.00003177848 n01847000 drake+```++Please give `--help` option for details++```+stack exec vgg16_example --help+```++# Installation++```+stack install+```++# Licence++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++That pre-trained model is released under Creative Commons Attribution License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/mnist_example.hs view
@@ -0,0 +1,153 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+module Main (main) where++import qualified Codec.Picture as Picture+import Control.Applicative+import Control.Monad+import Data.Monoid+import qualified Data.Vector as V+import qualified Data.Vector.Storable as VS+import Data.Version+import Options.Applicative+import Menoh+import System.FilePath+import Text.Printf++import Paths_menoh (getDataDir)++main :: IO ()+main = do+ putStrLn "mnist example"+ dataDir <- getDataDir+ opt <- execParser (parserInfo (dataDir </> "data"))++ let input_dir = optInputPath opt+ image_filenames =+ [ "0.png"+ , "1.png"+ , "2.png"+ , "3.png"+ , "4.png"+ , "5.png"+ , "6.png"+ , "7.png"+ , "8.png"+ , "9.png"+ ]+ batch_size = length image_filenames+ channel_num = 1+ height = 28+ width = 28+ category_num = 10+ input_dims, output_dims :: Dims+ input_dims = [batch_size, channel_num, height, width]+ output_dims = [batch_size, category_num]++ images <- liftM VS.concat $ forM image_filenames $ \fname -> do+ ret <- Picture.readImage $ input_dir </> fname+ case ret of+ Left e -> error e+ Right img -> return $ convert width height img++ -- Aliases to onnx's node input and output tensor name+ let mnist_in_name = "139900320569040"+ mnist_out_name = "139898462888656"++ -- Load ONNX model data+ model_data <- makeModelDataFromONNX (optModelPath opt)++ -- Specify inputs and outputs+ vpt <- makeVariableProfileTable+ [(mnist_in_name, DTypeFloat, input_dims)]+ [(mnist_out_name, DTypeFloat)]+ model_data+ optimizeModelData model_data vpt++ -- Construct computation primitive list and memories+ model <- makeModel vpt model_data "mkldnn"++ -- Copy input image data to model's input array+ writeBufferFromStorableVector 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+ s = scores V.! j+ printf "%s = %d : %f\n" fname j s++-- -------------------------------------------------------------------------++data Options+ = Options+ { optInputPath :: FilePath+ , optModelPath :: FilePath+ }++optionsParser :: FilePath -> Parser Options+optionsParser dataDir = Options+ <$> inputPathOption+ <*> modelPathOption+ where+ inputPathOption = strOption+ $ long "input"+ <> short 'i'+ <> metavar "DIR"+ <> help "input image path"+ <> value dataDir+ <> showDefault+ modelPathOption = strOption+ $ long "model"+ <> short 'm'+ <> metavar "PATH"+ <> help "onnx model path"+ <> value (dataDir </> "mnist.onnx")+ <> showDefault++parserInfo :: FilePath -> ParserInfo Options+parserInfo dir = info (helper <*> versionOption <*> optionsParser dir)+ $ fullDesc+ <> header "mnist_example - an example program of Menoh haskell binding"+ where+ versionOption :: Parser (a -> a)+ versionOption = infoOption (showVersion version)+ $ hidden+ <> long "version"+ <> help "Show version"++-- -------------------------------------------------------------------------++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++-- -------------------------------------------------------------------------
+ app/vgg16_example.hs view
@@ -0,0 +1,164 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+module Main (main) where++import qualified Codec.Picture as Picture+import Control.Applicative+import Control.Monad+import Data.List+import Data.Monoid+import Data.Ord+import qualified Data.Vector as V+import qualified Data.Vector.Storable as VS+import Data.Version+import Options.Applicative+import Menoh+import Text.Printf++main :: IO ()+main = do+ putStrLn "vgg16 example"+ opt <- execParser parserInfo++ let batch_size = 1+ channel_num = 3+ height = 224+ width = 224+ category_num = 1000+ input_dims, output_dims :: Dims+ input_dims = [batch_size, channel_num, height, width]+ output_dims = [batch_size, category_num]++ ret <- Picture.readImage (optInputImagePath opt)+ let image_data =+ case ret of+ Left e -> error e+ Right img -> convert width height img++ -- Aliases to onnx's node input and output tensor name+ let conv1_1_in_name = "140326425860192"+ fc6_out_name = "140326200777584"+ softmax_out_name = "140326200803680"++ -- Load ONNX model data+ model_data <- makeModelDataFromONNX (optModelPath opt)++ -- Specify inputs and outputs+ vpt <- makeVariableProfileTable+ [(conv1_1_in_name, DTypeFloat, input_dims)]+ [(fc6_out_name, DTypeFloat), (softmax_out_name, DTypeFloat)]+ model_data+ optimizeModelData model_data vpt++ -- Construct computation primitive list and memories+ model <- makeModel vpt model_data "mkldnn"++ -- Copy input image data to model's input array+ writeBufferFromStorableVector model conv1_1_in_name image_data++ -- Run inference+ run model++ -- Get output+ (fc6_out :: V.Vector Float) <- readBufferToVector 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++ categories <- liftM lines $ readFile (optSynsetWordsPath opt)+ let k = 5+ scores <- forM [0 .. V.length softmax_out - 1] $ \i -> do+ return (i, softmax_out V.! i)+ printf "top %d categories are:\n" k+ forM_ (take k $ sortBy (flip (comparing snd)) scores) $ \(i,p) -> do+ printf "%d %f %s\n" i p (categories !! i)++-- -------------------------------------------------------------------------++data Options+ = Options+ { optInputImagePath :: FilePath+ , optModelPath :: FilePath+ , optSynsetWordsPath :: FilePath+ }++optionsParser :: Parser Options+optionsParser = Options+ <$> inputImageOption+ <*> modelPathOption+ <*> synsetWordsPathOption+ where+ inputImageOption = strOption+ $ long "input-image"+ <> short 'i'+ <> metavar "PATH"+ <> help "input image path"+ <> value "data/Light_sussex_hen.jpg"+ <> showDefault+ modelPathOption = strOption+ $ long "model"+ <> short 'm'+ <> metavar "PATH"+ <> help "onnx model path"+ <> value "data/VGG16.onnx"+ <> showDefault+ synsetWordsPathOption = strOption+ $ long "synset-words"+ <> short 's'+ <> metavar "PATH"+ <> help "synset words path"+ <> value "data/synset_words.txt"+ <> showDefault++parserInfo :: ParserInfo Options+parserInfo = info (helper <*> versionOption <*> optionsParser)+ $ fullDesc+ <> header "vgg16_example - an example program of Menoh haskell binding"+ where+ versionOption :: Parser (a -> a)+ versionOption = infoOption (showVersion version)+ $ hidden+ <> long "version"+ <> help "Show version"++-- -------------------------------------------------------------------------++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++-- Note that VGG16.onnx assumes BGR image+reorderToNCHW :: Picture.Image Picture.PixelRGB8 -> VS.Vector Float+reorderToNCHW img = VS.generate (3 * Picture.imageHeight img * Picture.imageWidth img) f+ where+ f i =+ case Picture.pixelAt img x y of+ Picture.PixelRGB8 r g b ->+ case ch of+ 0 -> fromIntegral b+ 1 -> fromIntegral g+ 2 -> fromIntegral r+ _ -> undefined+ where+ (ch,m) = i `divMod` (Picture.imageWidth img * Picture.imageHeight img)+ (y,x) = m `divMod` Picture.imageWidth img++-- -------------------------------------------------------------------------
+ data/0.png view
binary file changed (absent → 900 bytes)
+ data/1.png view
binary file changed (absent → 513 bytes)
+ data/2.png view
binary file changed (absent → 940 bytes)
+ data/3.png view
binary file changed (absent → 869 bytes)
+ data/4.png view
binary file changed (absent → 819 bytes)
+ data/5.png view
binary file changed (absent → 736 bytes)
+ data/6.png view
binary file changed (absent → 898 bytes)
+ data/7.png view
binary file changed (absent → 705 bytes)
+ data/8.png view
binary file changed (absent → 990 bytes)
+ data/9.png view
binary file changed (absent → 942 bytes)
+ data/mnist.onnx view
file too large to diff
+ menoh.cabal view
@@ -0,0 +1,71 @@+name: menoh+version: 0.1.0+license: MIT+license-file: LICENSE+author: Masahiro Sakai <sakai@preferred.jp>+maintainer: Masahiro Sakai <sakai@preferred.jp>+copyright: Copyright 2018 Preferred Networks, Inc.+category: Machine Learning, Deep Learning+synopsis: Haskell binding for Menoh DNN inference library+description: Menoh is a MKL-DNN based DNN inference library for ONNX models. See https://github.com/pfnet-research/menoh/ for details.+build-type: Simple+cabal-version: >=1.10+extra-source-files:+ README.md+ retrieve_data.sh+data-files:+ data/*.png+ data/mnist.onnx++source-repository head+ type: git+ location: https://github.com/pfnet-research/menoh-haskell/++library+ hs-source-dirs: src+ exposed-modules:+ Menoh+ Menoh.Base+ other-modules:+ Paths_menoh+ other-extensions:+ CPP+ , FlexibleContexts+ , ForeignFunctionInterface+ , ScopedTypeVariables+ build-depends:+ base >=4.7 && <5+ , aeson >=0.8 && <1.3+ , bytestring >=0.10 && <0.11+ , containers >=0.5 && <0.6+ , monad-control >=1.0 && <1.1+ , transformers >=0.3 && <0.6+ , vector >=0.10 && <0.13+ pkgconfig-depends:+ menoh >=0.5.1+ default-language: Haskell2010++executable vgg16_example+ hs-source-dirs: app+ main-is: vgg16_example.hs+ build-depends:+ base+ -- convertRGB8 requires JuicyPixels >=3.2.7+ , JuicyPixels >=3.2.7 && <3.3+ , optparse-applicative >=0.11 && <0.15+ , menoh+ , vector+ default-language: Haskell2010++executable mnist_example+ hs-source-dirs: app+ other-modules: Paths_menoh+ main-is: mnist_example.hs+ build-depends:+ base+ , filepath >=1.3 && <1.5+ , JuicyPixels+ , optparse-applicative+ , menoh+ , vector+ default-language: Haskell2010
+ retrieve_data.sh view
@@ -0,0 +1,3 @@+wget https://www.dropbox.com/s/bjfn9kehukpbmcm/VGG16.onnx?dl=1 -O ./data/VGG16.onnx+wget https://raw.githubusercontent.com/HoldenCaulfieldRye/caffe/master/data/ilsvrc12/synset_words.txt -O ./data/synset_words.txt+wget https://upload.wikimedia.org/wikipedia/commons/5/54/Light_sussex_hen.jpg -O ./data/Light_sussex_hen.jpg
+ src/Menoh.hs view
@@ -0,0 +1,558 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module : Menoh+-- Copyright : Copyright (c) 2018 Preferred Networks, Inc.+-- License : MIT (see the file LICENSE)+--+-- Maintainer : Masahiro Sakai <sakai@preferred.jp>+-- Stability : experimental+-- Portability : non-portable+--+-- Haskell binding for /Menoh/ DNN inference library.+--+-- = 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'.+--+-- 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 'writeBufferFromVector'+-- or 'writeBufferFromStorableVector'. 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 'readBufferToVector'+-- or 'readBufferToStorableVector'.+--+-----------------------------------------------------------------------------+module Menoh+ (+ -- * Basic data types+ Dims+ , DType (..)+ , HasDType (..)+ , Error (..)++ -- * ModelData type+ , ModelData (..)+ , makeModelDataFromONNX+ , optimizeModelData++ -- * Model type+ , Model (..)+ , makeModel+ , makeModelWithConfig+ , run+ , getDType+ , getDims+ , unsafeGetBuffer+ , withBuffer+ , writeBufferFromVector+ , writeBufferFromStorableVector+ , readBufferToVector+ , readBufferToStorableVector++ -- * Misc+ , version+ , bindingVersion++ -- * Low-level API+ -- ** VariableProfileTable+ , VariableProfileTable (..)+ , makeVariableProfileTable+ , vptGetDType+ , vptGetDims++ -- ** Builder for 'VariableProfileTable'+ , VariableProfileTableBuilder (..)+ , makeVariableProfileTableBuilder+ , addInputProfileDims2+ , addInputProfileDims4+ , addOutputProfile+ , buildVariableProfileTable++ -- ** Builder for 'Model'+ , ModelBuilder (..)+ , makeModelBuilder+ , attachExternalBuffer+ , buildModel+ , buildModelWithConfig+ ) where++import Control.Concurrent+import Control.Monad+import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp)+import Control.Monad.IO.Class+import Control.Exception+import qualified Data.Aeson as J+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.Proxy+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Storable.Mutable as VSM+import qualified Data.Vector.Generic as VG+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.Version+import Foreign+import Foreign.C++import qualified Menoh.Base as Base+import qualified Paths_menoh++#include "MachDeps.h"++-- ------------------------------------------------------------------------++-- | Functions in this module can throw this exception type.+data Error+ = ErrorStdError String+ | ErrorUnknownError String+ | ErrorInvalidFilename String+ | ErrorONNXParseError String+ | ErrorInvalidDType String+ | ErrorInvalidAttributeType String+ | ErrorUnsupportedOperatorAttribute String+ | ErrorDimensionMismatch String+ | ErrorVariableNotFound String+ | ErrorIndexOutOfRange String+ | ErrorJSONParseError String+ | ErrorInvalidBackendName String+ | ErrorUnsupportedOperator String+ | ErrorFailedToConfigureOperator String+ | ErrorBackendError String+ | ErrorSameNamedVariableAlreadyExist String+ deriving (Eq, Ord, Show, Read)++instance Exception Error++runMenoh :: IO Base.MenohErrorCode -> IO ()+runMenoh m = runInBoundThread' $ do+ e <- m+ if e == Base.menohErrorCodeSuccess then+ return ()+ else do+ s <- peekCString =<< Base.menoh_get_last_error_message+ case IntMap.lookup (fromIntegral e) table of+ Just ex -> throwIO $ ex s+ Nothing -> throwIO $ ErrorUnknownError $ s ++ "(error code: " ++ show (fromIntegral e :: Int) ++ ")"+ where+ table :: IntMap (String -> Error)+ table = IntMap.fromList $ map (\(k,v) -> (fromIntegral k, v)) $+ [ (Base.menohErrorCodeStdError , ErrorStdError)+ , (Base.menohErrorCodeUnknownError , ErrorUnknownError)+ , (Base.menohErrorCodeInvalidFilename , ErrorInvalidFilename)+ , (Base.menohErrorCodeOnnxParseError , ErrorONNXParseError)+ , (Base.menohErrorCodeInvalidDtype , ErrorInvalidDType)+ , (Base.menohErrorCodeInvalidAttributeType , ErrorInvalidAttributeType)+ , (Base.menohErrorCodeUnsupportedOperatorAttribute , ErrorUnsupportedOperatorAttribute)+ , (Base.menohErrorCodeDimensionMismatch , ErrorDimensionMismatch)+ , (Base.menohErrorCodeVariableNotFound , ErrorVariableNotFound)+ , (Base.menohErrorCodeIndexOutOfRange , ErrorIndexOutOfRange)+ , (Base.menohErrorCodeJsonParseError , ErrorJSONParseError)+ , (Base.menohErrorCodeInvalidBackendName , ErrorInvalidBackendName)+ , (Base.menohErrorCodeUnsupportedOperator , ErrorUnsupportedOperator)+ , (Base.menohErrorCodeFailedToConfigureOperator , ErrorFailedToConfigureOperator)+ , (Base.menohErrorCodeBackendError , ErrorBackendError)+ , (Base.menohErrorCodeSameNamedVariableAlreadyExist , ErrorSameNamedVariableAlreadyExist)+ ]++runInBoundThread' :: IO a -> IO a+runInBoundThread' action+ | rtsSupportsBoundThreads = runInBoundThread action+ | otherwise = action++-- ------------------------------------------------------------------------++-- | Data type of array elements+data DType+ = DTypeFloat -- ^ single precision floating point number+ | DTypeUnknown !Base.MenohDType -- ^ types that this binding is unware of+ deriving (Eq, Ord, Show, Read)++instance Enum DType where+ toEnum x+ | x == fromIntegral Base.menohDtypeFloat = DTypeFloat+ | otherwise = DTypeUnknown (fromIntegral x)++ fromEnum DTypeFloat = fromIntegral Base.menohDtypeFloat+ fromEnum (DTypeUnknown i) = fromIntegral i++-- | Haskell types that have associated 'DType' type code.+class Storable a => HasDType a where+ dtypeOf :: Proxy a -> DType++instance HasDType CFloat where+ dtypeOf _ = DTypeFloat++#if SIZEOF_HSFLOAT == SIZEOF_FLOAT++instance HasDType Float where+ dtypeOf _ = DTypeFloat++#endif++-- ------------------------------------------------------------------------++-- | Dimensions of array+type Dims = [Int]++-- ------------------------------------------------------------------------++-- | @ModelData@ contains model parameters and computation graph structure.+newtype ModelData = ModelData (ForeignPtr Base.MenohModelData)++-- | Load onnx file and make 'ModelData'.+makeModelDataFromONNX :: MonadIO m => FilePath -> m ModelData+makeModelDataFromONNX fpath = liftIO $ withCString fpath $ \fpath' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_make_model_data_from_onnx fpath' ret+ liftM ModelData $ newForeignPtr Base.menoh_delete_model_data_funptr =<< peek ret++-- | Optimize function for 'ModelData'.+--+-- This function modify given 'ModelData'.+optimizeModelData :: MonadIO m => ModelData -> VariableProfileTable -> m ()+optimizeModelData (ModelData m) (VariableProfileTable vpt) = liftIO $+ withForeignPtr m $ \m' -> withForeignPtr vpt $ \vpt' ->+ runMenoh $ Base.menoh_model_data_optimize m' vpt'++-- ------------------------------------------------------------------------++-- | Builder for creation of 'VariableProfileTable'.+newtype VariableProfileTableBuilder+ = VariableProfileTableBuilder (ForeignPtr Base.MenohVariableProfileTableBuilder)++-- | Factory function for 'VariableProfileTableBuilder'.+makeVariableProfileTableBuilder :: MonadIO m => m VariableProfileTableBuilder+makeVariableProfileTableBuilder = liftIO $ alloca $ \p -> do+ runMenoh $ Base.menoh_make_variable_profile_table_builder p+ liftM VariableProfileTableBuilder $ newForeignPtr Base.menoh_delete_variable_profile_table_builder_funptr =<< peek p++addInputProfileDims :: MonadIO m => VariableProfileTableBuilder -> String -> DType -> Dims -> m ()+addInputProfileDims vpt name dtype dims =+ case dims of+ [num, size] -> addInputProfileDims2 vpt name dtype (num, size)+ [num, channel, height, width] -> addInputProfileDims4 vpt name dtype (num, channel, height, width)+ _ -> liftIO $ throwIO $ ErrorDimensionMismatch $ "Menoh.addInputProfileDims: cannot handle dims of length " ++ show (length dims)++-- | Add 2D input profile.+--+-- Input profile contains name, dtype and dims @(num, size)@.+-- This 2D input is conventional batched 1D inputs.+addInputProfileDims2+ :: MonadIO m+ => VariableProfileTableBuilder+ -> String+ -> DType+ -> (Int, Int) -- ^ (num, size)+ -> m ()+addInputProfileDims2 (VariableProfileTableBuilder vpt) name dtype (num, size) = liftIO $+ withForeignPtr vpt $ \vpt' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_variable_profile_table_builder_add_input_profile_dims_2+ vpt' name' (fromIntegral (fromEnum dtype))+ (fromIntegral num) (fromIntegral size)++-- | Add 4D input profile+--+-- Input profile contains name, dtype and dims @(num, channel, height, width)@.+-- This 4D input is conventional batched image inputs. Image input is+-- 3D (channel, height, width).+addInputProfileDims4+ :: MonadIO m+ => VariableProfileTableBuilder+ -> String+ -> DType+ -> (Int, Int, Int, Int) -- ^ (num, channel, height, width)+ -> m ()+addInputProfileDims4 (VariableProfileTableBuilder vpt) name dtype (num, channel, height, width) = liftIO $+ withForeignPtr vpt $ \vpt' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_variable_profile_table_builder_add_input_profile_dims_4+ vpt' name' (fromIntegral (fromEnum dtype))+ (fromIntegral num) (fromIntegral channel) (fromIntegral height) (fromIntegral width)++-- | Add output profile+--+-- Output profile contains name and dtype. Its 'Dims' are calculated automatically,+-- so that you don't need to specify explicitly.+addOutputProfile :: MonadIO m => VariableProfileTableBuilder -> String -> DType -> m ()+addOutputProfile (VariableProfileTableBuilder vpt) name dtype = liftIO $+ withForeignPtr vpt $ \vpt' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_variable_profile_table_builder_add_output_profile+ vpt' name' (fromIntegral (fromEnum dtype))++-- | Factory function for 'VariableProfileTable'+buildVariableProfileTable+ :: MonadIO m+ => VariableProfileTableBuilder+ -> ModelData+ -> m VariableProfileTable+buildVariableProfileTable (VariableProfileTableBuilder b) (ModelData m) = liftIO $+ withForeignPtr b $ \b' -> withForeignPtr m $ \m' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_build_variable_profile_table b' m' ret+ liftM VariableProfileTable $ newForeignPtr Base.menoh_delete_variable_profile_table_funptr =<< peek ret++-- ------------------------------------------------------------------------++-- | @VariableProfileTable@ contains information of dtype and dims of variables.+--+-- Users can access to dtype and dims via 'vptGetDType' and 'vptGetDims'.+newtype VariableProfileTable+ = VariableProfileTable (ForeignPtr Base.MenohVariableProfileTable)++-- | Convenient function for constructing 'VariableProfileTable'.+--+-- If you need finer control, you can use 'VariableProfileTableBuidler'.+makeVariableProfileTable+ :: MonadIO m+ => [(String, DType, Dims)] -- ^ input names with dtypes and dims+ -> [(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+ b <- makeVariableProfileTableBuilder+ forM_ input_name_and_dims_pair_list $ \(name,dtype,dims) -> do+ addInputProfileDims b name dtype dims+ forM_ required_output_name_list $ \(name,dtype) -> do+ addOutputProfile b name dtype+ buildVariableProfileTable b model_data++-- | Accessor function for 'VariableProfileTable'+--+-- Select variable name and get its 'DType'.+vptGetDType :: MonadIO m => VariableProfileTable -> String -> m DType+vptGetDType (VariableProfileTable vpt) name = liftIO $+ withForeignPtr vpt $ \vpt' -> withCString name $ \name' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_variable_profile_table_get_dims_size vpt' name' ret+ (toEnum . fromIntegral) <$> peek ret++-- | Accessor function for 'VariableProfileTable'+--+-- Select variable name and get its 'Dims'.+vptGetDims :: MonadIO m => VariableProfileTable -> String -> m Dims+vptGetDims (VariableProfileTable vpt) name = liftIO $+ withForeignPtr vpt $ \vpt' -> withCString name $ \name' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_variable_profile_table_get_dims_size vpt' name' ret+ size <- peek ret+ forM [0..size-1] $ \i -> do+ runMenoh $ Base.menoh_variable_profile_table_get_dims_at vpt' name' (fromIntegral i) ret+ fromIntegral <$> peek ret++-- ------------------------------------------------------------------------++-- | Helper for creating of 'Model'.+newtype ModelBuilder = ModelBuilder (ForeignPtr Base.MenohModelBuilder)++-- | Factory function for 'ModelBuilder'+makeModelBuilder :: MonadIO m => VariableProfileTable -> m ModelBuilder+makeModelBuilder (VariableProfileTable vpt) = liftIO $+ withForeignPtr vpt $ \vpt' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_make_model_builder vpt' ret+ liftM ModelBuilder $ newForeignPtr Base.menoh_delete_model_builder_funptr =<< peek ret++-- | Attach a buffer which allocated by users.+--+-- Users can attach a external buffer which they allocated to target variable.+--+-- Variables attached no external buffer are attached internal buffers allocated+-- automatically.+--+-- Users can get that internal buffer handle by calling 'unsafeGetBuffer' etc. later.+attachExternalBuffer :: MonadIO m => ModelBuilder -> String -> Ptr a -> m ()+attachExternalBuffer (ModelBuilder m) name buf = liftIO $+ withForeignPtr m $ \m' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_model_builder_attach_external_buffer m' name' buf++-- | Factory function for 'Model'.+buildModel+ :: MonadIO m+ => ModelBuilder+ -> ModelData+ -> String -- ^ backend name+ -> m Model+buildModel builder m backend = liftIO $+ withCString "" $+ buildModelWithConfigString builder m backend++-- | Similar to 'buildModel', but backend specific configuration can be supplied as JSON.+buildModelWithConfig+ :: (MonadIO m, J.ToJSON a)+ => ModelBuilder+ -> ModelData+ -> String -- ^ backend name+ -> a -- ^ backend config+ -> m Model+buildModelWithConfig builder m backend backend_config = liftIO $+ BS.useAsCString (BL.toStrict (J.encode backend_config)) $+ buildModelWithConfigString builder m backend++buildModelWithConfigString+ :: MonadIO m+ => ModelBuilder+ -> ModelData+ -> String -- ^ backend name+ -> CString -- ^ backend config+ -> m Model+buildModelWithConfigString (ModelBuilder builder) (ModelData m) backend backend_config = liftIO $+ withForeignPtr builder $ \builder' -> withForeignPtr m $ \m' -> withCString backend $ \backend' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_build_model builder' m' backend' backend_config ret+ liftM Model $ newForeignPtr Base.menoh_delete_model_funptr =<< peek ret++-- ------------------------------------------------------------------------++-- | ONNX model with input/output buffers+newtype Model = Model (ForeignPtr Base.MenohModel)++-- | Run model inference.+--+-- This function can't be called asynchronously.+run :: MonadIO m => Model -> m ()+run (Model model) = liftIO $ withForeignPtr model $ \model' -> do+ runMenoh $ Base.menoh_model_run model'++-- | Get 'DType' of target variable.+getDType :: MonadIO m => Model -> String -> m DType+getDType (Model m) name = liftIO $ do+ withForeignPtr m $ \m' -> withCString name $ \name' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_model_get_variable_dtype m' name' ret+ liftM (toEnum . fromIntegral) $ peek ret++-- | Get 'Dims' of target variable.+getDims :: MonadIO m => Model -> String -> m Dims+getDims (Model m) name = liftIO $ do+ withForeignPtr m $ \m' -> withCString name $ \name' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_model_get_variable_dims_size m' name' ret+ size <- peek ret+ forM [0..size-1] $ \i -> do+ runMenoh $ Base.menoh_model_get_variable_dims_at m' name' (fromIntegral i) ret+ fromIntegral <$> peek ret++-- | Get a buffer handle attached to target variable.+--+-- Users can get a buffer handle attached to target variable.+-- If that buffer is allocated by users and attached to the variable by calling+-- 'attachExternalBuffer', returned buffer handle is same to it.+--+-- This function is unsafe because it does not prevent the model to be GC'ed and+-- the returned pointer become dangling pointer.+--+-- See also 'withBuffer'.+unsafeGetBuffer :: MonadIO m => Model -> String -> m (Ptr a)+unsafeGetBuffer (Model m) name = liftIO $ do+ withForeignPtr m $ \m' -> withCString name $ \name' -> alloca $ \ret -> do+ runMenoh $ Base.menoh_model_get_variable_buffer_handle m' name' ret+ peek ret++-- | This function takes a function which is applied to the buffer associated to specified variable.+-- The resulting action is then executed. The buffer is kept alive at least during the whole action,+-- even if it is not used directly inside.+-- Note that it is not safe to return the pointer from the action and use it after the action completes.+--+-- See also 'unsafeGetBuffer'.+withBuffer :: forall m r a. (MonadIO m, MonadBaseControl IO m) => Model -> String -> (Ptr a -> m r) -> m r+withBuffer (Model m) name f =+ liftBaseOp (withForeignPtr m) $ \m' ->+ (liftBaseOp (withCString name) :: (CString -> m r) -> m r) $ \name' ->+ liftBaseOp alloca $ \ret -> do+ p <- liftIO $ do+ runMenoh $ Base.menoh_model_get_variable_buffer_handle m' name' ret+ peek ret+ f p++checkDType :: String -> DType -> DType -> IO ()+checkDType name dtype1 dtype2+ | dtype1 /= dtype2 = throwIO $ ErrorInvalidDType $ name ++ ": dtype mismatch"+ | otherwise = return ()++checkDTypeAndSize :: String -> (DType,Int) -> (DType,Int) -> IO ()+checkDTypeAndSize name (dtype1,n1) (dtype2,n2)+ | dtype1 /= dtype2 = throwIO $ ErrorInvalidDType $ name ++ ": dtype mismatch"+ | n1 /= n2 = throwIO $ ErrorDimensionMismatch $ name ++ ": dimension mismatch"+ | otherwise = return ()++-- | 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)++-- | 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++-- | 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++-- | Read whole eleemnts of 'Array' and return as a @'VS.Vector' 'Float'@.+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++-- | Convenient methods for constructing a 'Model'.+makeModel+ :: MonadIO m+ => VariableProfileTable -- ^ variable profile table+ -> ModelData -- ^ model data+ -> String -- ^ backend name+ -> m Model+makeModel vpt model_data backend_name = liftIO $ do+ b <- makeModelBuilder vpt+ buildModel b model_data backend_name++-- | Similar to 'makeModel' but backend-specific configuration can be supplied.+makeModelWithConfig+ :: (MonadIO m, J.ToJSON a)+ => VariableProfileTable -- ^ variable profile table+ -> ModelData -- ^ model data+ -> String -- ^ backend name+ -> a -- ^ backend config+ -> m Model+makeModelWithConfig vpt model_data backend_name backend_config = liftIO $ do+ b <- makeModelBuilder vpt+ buildModelWithConfig b model_data backend_name backend_config++-- ------------------------------------------------------------------------++-- | Menoh version which was supplied on compilation time via CPP macro.+version :: Version+version = makeVersion [Base.menoh_major_version, Base.menoh_minor_version, Base.menoh_patch_version]++-- | Version of this Haskell binding. (Not the version of /Menoh/ itself)+bindingVersion :: Version+bindingVersion = Paths_menoh.version
+ src/Menoh/Base.hsc view
@@ -0,0 +1,138 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ForeignFunctionInterface #-}+module Menoh.Base where++import Data.Int+import Foreign+import Foreign.C++#include <menoh/menoh.h>+#include <menoh/version.hpp>++type MenohDType = #type menoh_dtype++type MenohErrorCode = #type menoh_error_code++#enum MenohDType,,menoh_dtype_float++#enum MenohErrorCode,, \+ menoh_error_code_success, \+ menoh_error_code_std_error, \+ menoh_error_code_unknown_error, \+ menoh_error_code_invalid_filename, \+ menoh_error_code_onnx_parse_error, \+ menoh_error_code_invalid_dtype, \+ menoh_error_code_invalid_attribute_type, \+ menoh_error_code_unsupported_operator_attribute, \+ menoh_error_code_dimension_mismatch, \+ menoh_error_code_variable_not_found, \+ menoh_error_code_index_out_of_range, \+ menoh_error_code_json_parse_error, \+ menoh_error_code_invalid_backend_name, \+ menoh_error_code_unsupported_operator, \+ menoh_error_code_failed_to_configure_operator, \+ menoh_error_code_backend_error, \+ menoh_error_code_same_named_variable_already_exist++foreign import ccall unsafe menoh_get_last_error_message+ :: IO CString++data MenohModelData+type MenohModelDataHandle = Ptr MenohModelData++foreign import ccall safe menoh_make_model_data_from_onnx+ :: CString -> Ptr MenohModelDataHandle -> IO MenohErrorCode++foreign import ccall "&menoh_delete_model_data" menoh_delete_model_data_funptr+ :: FunPtr (MenohModelDataHandle -> IO ())++data MenohVariableProfileTableBuilder+type MenohVariableProfileTableBuilderHandle = Ptr MenohVariableProfileTableBuilder++foreign import ccall unsafe menoh_make_variable_profile_table_builder+ :: Ptr MenohVariableProfileTableBuilderHandle -> IO MenohErrorCode++foreign import ccall "&menoh_delete_variable_profile_table_builder"+ menoh_delete_variable_profile_table_builder_funptr+ :: FunPtr (MenohVariableProfileTableBuilderHandle -> IO ())++foreign import ccall unsafe menoh_variable_profile_table_builder_add_input_profile_dims_2+ :: MenohVariableProfileTableBuilderHandle -> CString -> MenohDType -> Int32 -> Int32 -> IO MenohErrorCode++foreign import ccall unsafe menoh_variable_profile_table_builder_add_input_profile_dims_4+ :: MenohVariableProfileTableBuilderHandle -> CString -> MenohDType -> Int32 -> Int32 -> Int32 -> Int32 -> IO MenohErrorCode++foreign import ccall unsafe menoh_variable_profile_table_builder_add_output_profile+ :: MenohVariableProfileTableBuilderHandle -> CString -> MenohDType -> IO MenohErrorCode++data MenohVariableProfileTable+type MenohVariableProfileTableHandle = Ptr MenohVariableProfileTable++foreign import ccall safe menoh_build_variable_profile_table+ :: MenohVariableProfileTableBuilderHandle -> MenohModelDataHandle+ -> Ptr MenohVariableProfileTableHandle -> IO MenohErrorCode++foreign import ccall "&menoh_delete_variable_profile_table"+ menoh_delete_variable_profile_table_funptr+ :: FunPtr (MenohVariableProfileTableHandle -> IO ())++foreign import ccall unsafe menoh_variable_profile_table_get_dtype+ :: MenohVariableProfileTableHandle -> CString -> Ptr MenohDType -> IO MenohErrorCode++foreign import ccall unsafe menoh_variable_profile_table_get_dims_size+ :: MenohVariableProfileTableHandle -> CString -> Ptr Int32 -> IO MenohErrorCode++foreign import ccall unsafe menoh_variable_profile_table_get_dims_at+ :: MenohVariableProfileTableHandle -> CString -> Int32 -> Ptr Int32 -> IO MenohErrorCode++foreign import ccall safe menoh_model_data_optimize+ :: MenohModelDataHandle -> MenohVariableProfileTableHandle -> IO MenohErrorCode++data MenohModelBuilder+type MenohModelBuilderHandle = Ptr MenohModelBuilder++foreign import ccall unsafe menoh_make_model_builder+ :: MenohVariableProfileTableHandle -> Ptr MenohModelBuilderHandle -> IO MenohErrorCode++foreign import ccall "&menoh_delete_model_builder" menoh_delete_model_builder_funptr+ :: FunPtr (MenohModelBuilderHandle -> IO ())++foreign import ccall unsafe menoh_model_builder_attach_external_buffer+ :: MenohModelBuilderHandle -> CString -> Ptr a -> IO MenohErrorCode++data MenohModel+type MenohModelHandle = Ptr MenohModel++foreign import ccall safe menoh_build_model+ :: MenohModelBuilderHandle -> MenohModelDataHandle -> CString -> CString+ -> Ptr MenohModelHandle -> IO MenohErrorCode++foreign import ccall "&menoh_delete_model" menoh_delete_model_funptr+ :: FunPtr (MenohModelHandle -> IO ())++foreign import ccall unsafe menoh_model_get_variable_buffer_handle+ :: MenohModelHandle -> CString -> Ptr (Ptr a) -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_get_variable_dtype+ :: MenohModelHandle -> CString -> Ptr MenohDType -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_get_variable_dims_size+ :: MenohModelHandle -> CString -> Ptr Int32 -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_get_variable_dims_at+ :: MenohModelHandle -> CString -> Int32 -> Ptr Int32 -> IO MenohErrorCode++foreign import ccall safe menoh_model_run+ :: MenohModelHandle -> IO MenohErrorCode++menoh_major_version :: Int+menoh_major_version = #const MENOH_MAJOR_VERSION++menoh_minor_version :: Int+menoh_minor_version = #const MENOH_MINOR_VERSION++menoh_patch_version :: Int+menoh_patch_version = #const MENOH_PATCH_VERSION++menoh_version_string :: String+menoh_version_string = #const_str MENOH_VERSION_STRING