packages feed

storable-record 0.0.2.3 → 0.0.2.4

raw patch · 5 files changed

+500/−29 lines, 5 filesdep +storablevectordep +timeitnew-component:exe:storable-record-speed

Dependencies added: storablevector, timeit

Files

src/Foreign/Storable/Record.hs view
@@ -50,6 +50,10 @@ You see it would simplify class instantiation if we could tell the class dictionary at once instead of defining each method separately.++In this implementation we tail pad records+according to the overall required alignment+in conformance to the Linux/X86 ABI. -} module Foreign.Storable.Record (    Dictionary, Access,@@ -59,13 +63,10 @@    peek, poke,    ) where -import Control.Monad.Trans.Reader-          (ReaderT(ReaderT), runReaderT,-           Reader, reader, runReader, ) import Control.Monad.Trans.Writer           (Writer, writer, runWriter, ) import Control.Monad.Trans.State-          (State, modify, state, runState, )+          (State, modify, get, runState, ) import Control.Applicative (Applicative(pure, (<*>)), ) import Data.Functor.Compose (Compose(Compose), ) import Data.Monoid (Monoid(mempty, mappend), )@@ -81,15 +82,14 @@    Dictionary {       sizeOf_ :: Int,       alignment_ :: Alignment,-      ptrBox :: Reader (Ptr r) (Box r r)+      ptrBox :: Box r r    }  newtype Access r a =    Access       (Compose (Writer Alignment)         (Compose (State Int)-          (Compose (Reader (Ptr r))-              (Box r)))+          (Box r))         a)  instance Functor (Access r) where@@ -103,25 +103,32 @@    Access f <*> Access x = Access (f <*> x)  +{-+For a version with (Ptr r) factored out, see RecordReaderPtr.+That is slightly slower.+-} data Box r a =    Box {-      peek_ :: IO a,-      poke_ :: ReaderT r IO ()+      peek_ :: Ptr r -> IO a,+      poke_ :: Ptr r -> r -> IO ()    }  instance Functor (Box r) where    {-# INLINE fmap #-}    fmap f (Box pe po) =-      Box (fmap f pe) po+      Box (fmap f . pe) po  instance Applicative (Box r) where    {-# INLINE pure #-}    {-# INLINE (<*>) #-}-   pure a = Box (pure a) (pure ())-   f <*> x = Box (peek_ f <*> peek_ x) (poke_ f >> poke_ x)+   pure a = Box (const $ pure a) (const $ const $ pure ())+   f <*> x =+      Box+         (\ptr -> peek_ f ptr <*> peek_ x ptr)+         (\ptr r -> poke_ f ptr r >> poke_ x ptr r)  -newtype Alignment = Alignment Int+newtype Alignment = Alignment {deconsAlignment :: Int}  instance Monoid Alignment where    {-# INLINE mempty #-}@@ -137,28 +144,26 @@        size  = St.sizeOf (f (error "Storable.Record.element.size: content touched"))    in  Access $        Compose $ writer $ flip (,) (Alignment align) $-       Compose $-       modify (roundUp align) >>-       state (\offset ->-          (Compose $ reader $ \ptr ->-           Box-             (St.peekByteOff ptr offset)-             (ReaderT $ St.pokeByteOff ptr offset . f),-           offset+size))+       Compose $ do+          modify (roundUp align)+          offset <- get+          modify (+size)+          return $ Box+             (\ptr -> St.peekByteOff ptr offset)+             (\ptr -> St.pokeByteOff ptr offset . f)  {-# INLINE run #-} run :: Access r r -> Dictionary r run (Access (Compose m)) =    let (Compose s, align) = runWriter m-       (Compose r, size) = runState s 0-   in  Dictionary size align r+       (box, size) = runState s 0+   in  Dictionary (roundUp (deconsAlignment align) size) align box   {-# INLINE alignment #-} alignment :: Dictionary r -> r -> Int alignment dict _ =-   let (Alignment align) = alignment_ dict-   in  align+   deconsAlignment $ alignment_ dict  {-# INLINE sizeOf #-} sizeOf :: Dictionary r -> r -> Int@@ -168,9 +173,9 @@ {-# INLINE peek #-} peek :: Dictionary r -> Ptr r -> IO r peek dict ptr =-   peek_ $ runReader (ptrBox dict) ptr+   peek_ (ptrBox dict) ptr  {-# INLINE poke #-} poke :: Dictionary r -> Ptr r -> r -> IO () poke dict ptr =-   runReaderT (poke_ $ runReader (ptrBox dict) ptr)+   poke_ (ptrBox dict) ptr
+ src/Foreign/Storable/RecordMinimalSize.hs view
@@ -0,0 +1,181 @@+{- |+Here we show an example of how to+define a Storable instance with this module.++> import Foreign.Storable.Record as Store+> import Foreign.Storable (Storable (..), )+>+> import Control.Applicative (liftA2, )+>+> data Stereo a = Stereo {left, right :: a}+>+> store :: Storable a => Store.Dictionary (Stereo a)+> store =+>    Store.run $+>    liftA2 Stereo+>       (Store.element left)+>       (Store.element right)+>+> instance (Storable a) => Storable (Stereo a) where+>    sizeOf = Store.sizeOf store+>    alignment = Store.alignment store+>    peek = Store.peek store+>    poke = Store.poke store+++The @Stereo@ constructor is exclusively used+for constructing the @peek@ function,+whereas the accessors in the @element@ calls+are used for assembling the @poke@ function.+It is required that the order of arguments of @Stereo@+matches the record accessors in the @element@ calls.+If you want that the stored data correctly and fully represents+your Haskell data, it must hold:++>   Stereo (left x) (right x) = x   .++Unfortunately this cannot be checked automatically.+However, mismatching types that are caused by swapped arguments+are detected by the type system.+Our system performs for you:+Size and alignment computation, poking and peeking.+Thus several inconsistency bugs can be prevented using this package,+like size mismatching the space required by @poke@ actions.+There is no more restriction,+thus smart constructors and accessors+and nested records work, too.+For nested records however,+I recommend individual Storable instances for the sub-records.++You see it would simplify class instantiation+if we could tell the class dictionary at once+instead of defining each method separately.++In this implementation we choose the minimum size for a record,+that is we omit tail padding,+which saves space but is incompatible with Linux/X86 ABI.+-}+module Foreign.Storable.RecordMinimalSize (+   Dictionary, Access,+   element, run,++   alignment, sizeOf,+   peek, poke,+   ) where++import Control.Monad.Trans.Reader+          (ReaderT(ReaderT), runReaderT,+           Reader, reader, runReader, )+import Control.Monad.Trans.Writer+          (Writer, writer, runWriter, )+import Control.Monad.Trans.State+          (State, modify, get, runState, )+import Control.Applicative (Applicative(pure, (<*>)), )+import Data.Functor.Compose (Compose(Compose), )+import Data.Monoid (Monoid(mempty, mappend), )++import Foreign.Storable.FixedArray (roundUp, )+import qualified Foreign.Storable as St++import Foreign.Ptr (Ptr, )+import Foreign.Storable (Storable, )+++data Dictionary r =+   Dictionary {+      sizeOf_ :: Int,+      alignment_ :: Alignment,+      ptrBox :: Reader (Ptr r) (Box r r)+   }++newtype Access r a =+   Access+      (Compose (Writer Alignment)+        (Compose (State Int)+          (Compose (Reader (Ptr r))+              (Box r)))+        a)++instance Functor (Access r) where+   {-# INLINE fmap #-}+   fmap f (Access m) = Access (fmap f m)++instance Applicative (Access r) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure a = Access (pure a)+   Access f <*> Access x = Access (f <*> x)+++data Box r a =+   Box {+      peek_ :: IO a,+      poke_ :: ReaderT r IO ()+   }++instance Functor (Box r) where+   {-# INLINE fmap #-}+   fmap f (Box pe po) =+      Box (fmap f pe) po++instance Applicative (Box r) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure a = Box (pure a) (pure ())+   f <*> x = Box (peek_ f <*> peek_ x) (poke_ f >> poke_ x)+++newtype Alignment = Alignment Int++instance Monoid Alignment where+   {-# INLINE mempty #-}+   {-# INLINE mappend #-}+   mempty = Alignment 1+   mappend (Alignment x) (Alignment y) = Alignment (lcm x y)+++{-# INLINE element #-}+element :: Storable a => (r -> a) -> Access r a+element f =+   let align = St.alignment (f (error "Storable.Record.element.alignment: content touched"))+       size  = St.sizeOf (f (error "Storable.Record.element.size: content touched"))+   in  Access $+       Compose $ writer $ flip (,) (Alignment align) $+       Compose $ do+          modify (roundUp align)+          offset <- get+          modify (+size)+          return $+             Compose $ reader $ \ptr ->+                Box+                  (St.peekByteOff ptr offset)+                  (ReaderT $ St.pokeByteOff ptr offset . f)++{-# INLINE run #-}+run :: Access r r -> Dictionary r+run (Access (Compose m)) =+   let (Compose s, align) = runWriter m+       (Compose r, size) = runState s 0+   in  Dictionary size align r+++{-# INLINE alignment #-}+alignment :: Dictionary r -> r -> Int+alignment dict _ =+   let (Alignment align) = alignment_ dict+   in  align++{-# INLINE sizeOf #-}+sizeOf :: Dictionary r -> r -> Int+sizeOf dict _ =+   sizeOf_ dict++{-# INLINE peek #-}+peek :: Dictionary r -> Ptr r -> IO r+peek dict ptr =+   peek_ $ runReader (ptrBox dict) ptr++{-# INLINE poke #-}+poke :: Dictionary r -> Ptr r -> r -> IO ()+poke dict ptr =+   runReaderT (poke_ $ runReader (ptrBox dict) ptr)
+ src/Foreign/Storable/RecordReaderPtr.hs view
@@ -0,0 +1,180 @@+{- |+Here we show an example of how to+define a Storable instance with this module.++> import Foreign.Storable.Record as Store+> import Foreign.Storable (Storable (..), )+>+> import Control.Applicative (liftA2, )+>+> data Stereo a = Stereo {left, right :: a}+>+> store :: Storable a => Store.Dictionary (Stereo a)+> store =+>    Store.run $+>    liftA2 Stereo+>       (Store.element left)+>       (Store.element right)+>+> instance (Storable a) => Storable (Stereo a) where+>    sizeOf = Store.sizeOf store+>    alignment = Store.alignment store+>    peek = Store.peek store+>    poke = Store.poke store+++The @Stereo@ constructor is exclusively used+for constructing the @peek@ function,+whereas the accessors in the @element@ calls+are used for assembling the @poke@ function.+It is required that the order of arguments of @Stereo@+matches the record accessors in the @element@ calls.+If you want that the stored data correctly and fully represents+your Haskell data, it must hold:++>   Stereo (left x) (right x) = x   .++Unfortunately this cannot be checked automatically.+However, mismatching types that are caused by swapped arguments+are detected by the type system.+Our system performs for you:+Size and alignment computation, poking and peeking.+Thus several inconsistency bugs can be prevented using this package,+like size mismatching the space required by @poke@ actions.+There is no more restriction,+thus smart constructors and accessors+and nested records work, too.+For nested records however,+I recommend individual Storable instances for the sub-records.++You see it would simplify class instantiation+if we could tell the class dictionary at once+instead of defining each method separately.++In this implementation we tail pad records+according to the overall required alignment+in conformance to the Linux/X86 ABI.+-}+module Foreign.Storable.RecordReaderPtr (+   Dictionary, Access,+   element, run,++   alignment, sizeOf,+   peek, poke,+   ) where++import Control.Monad.Trans.Reader+          (ReaderT(ReaderT), runReaderT,+           Reader, reader, runReader, )+import Control.Monad.Trans.Writer+          (Writer, writer, runWriter, )+import Control.Monad.Trans.State+          (State, modify, get, runState, )+import Control.Applicative (Applicative(pure, (<*>)), )+import Data.Functor.Compose (Compose(Compose), )+import Data.Monoid (Monoid(mempty, mappend), )++import Foreign.Storable.FixedArray (roundUp, )+import qualified Foreign.Storable as St++import Foreign.Ptr (Ptr, )+import Foreign.Storable (Storable, )+++data Dictionary r =+   Dictionary {+      sizeOf_ :: Int,+      alignment_ :: Alignment,+      ptrBox :: Reader (Ptr r) (Box r r)+   }++newtype Access r a =+   Access+      (Compose (Writer Alignment)+        (Compose (State Int)+          (Compose (Reader (Ptr r))+              (Box r)))+        a)++instance Functor (Access r) where+   {-# INLINE fmap #-}+   fmap f (Access m) = Access (fmap f m)++instance Applicative (Access r) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure a = Access (pure a)+   Access f <*> Access x = Access (f <*> x)+++data Box r a =+   Box {+      peek_ :: IO a,+      poke_ :: ReaderT r IO ()+   }++instance Functor (Box r) where+   {-# INLINE fmap #-}+   fmap f (Box pe po) =+      Box (fmap f pe) po++instance Applicative (Box r) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure a = Box (pure a) (pure ())+   f <*> x = Box (peek_ f <*> peek_ x) (poke_ f >> poke_ x)+++newtype Alignment = Alignment {deconsAlignment :: Int}++instance Monoid Alignment where+   {-# INLINE mempty #-}+   {-# INLINE mappend #-}+   mempty = Alignment 1+   mappend (Alignment x) (Alignment y) = Alignment (lcm x y)+++{-# INLINE element #-}+element :: Storable a => (r -> a) -> Access r a+element f =+   let align = St.alignment (f (error "Storable.Record.element.alignment: content touched"))+       size  = St.sizeOf (f (error "Storable.Record.element.size: content touched"))+   in  Access $+       Compose $ writer $ flip (,) (Alignment align) $+       Compose $ do+          modify (roundUp align)+          offset <- get+          modify (+size)+          return $+             Compose $ reader $ \ptr ->+                Box+                  (St.peekByteOff ptr offset)+                  (ReaderT $ St.pokeByteOff ptr offset . f)++{-# INLINE run #-}+run :: Access r r -> Dictionary r+run (Access (Compose m)) =+   let (Compose s, align) = runWriter m+       (Compose r, size) = runState s 0+   in  Dictionary (roundUp (deconsAlignment align) size) align r+++{-# INLINE alignment #-}+alignment :: Dictionary r -> r -> Int+alignment dict _ =+   deconsAlignment $ alignment_ dict++{-# INLINE sizeOf #-}+sizeOf :: Dictionary r -> r -> Int+sizeOf dict _ =+   sizeOf_ dict++{-# INLINE peek #-}+peek :: Dictionary r -> Ptr r -> IO r+peek dict ptr =+   peek_ $ runReader (ptrBox dict) ptr++{-# INLINE poke #-}+poke :: Dictionary r -> Ptr r -> r -> IO ()+poke dict ptr =+   runReaderT (poke_ $ runReader (ptrBox dict) ptr)
+ src/SpeedTest.hs view
@@ -0,0 +1,87 @@+-- see also speed test in sample-frame package+module Main where++import qualified Data.StorableVector as SV++import qualified System.TimeIt as T++import Foreign.Storable.Newtype as StoreNew+import Foreign.Storable.Record as Store+import Foreign.Storable (Storable (..), )++import Control.Applicative (liftA2, )++import Data.Word (Word8, )+++data MonoN a = MonoN {singleN :: a}+   deriving Show++instance (Storable a) => Storable (MonoN a) where+   {- INLINE sizeOf -}+   sizeOf = StoreNew.sizeOf singleN+   {- INLINE alignment -}+   alignment = StoreNew.alignment singleN+   {- INLINE peek -}+   peek = StoreNew.peek MonoN+   {- INLINE poke -}+   poke = StoreNew.poke singleN+++newtype Mono a = Mono {single :: a}+   deriving Show++{-# INLINE storeMono #-}+storeMono :: Storable a => Store.Dictionary (Mono a)+storeMono =+   Store.run $ fmap Mono $ Store.element single++instance (Storable a) => Storable (Mono a) where+   {-# INLINE sizeOf #-}+   sizeOf = Store.sizeOf storeMono+   {-# INLINE alignment #-}+   alignment = Store.alignment storeMono+   {-# INLINE peek #-}+   peek = Store.peek storeMono+   {-# INLINE poke #-}+   poke = Store.poke storeMono+++data Stereo a = Stereo {left, right :: a}+   deriving Show++-- inline makes performance even worse+{- INLINE storeStereo -}+storeStereo :: Storable a => Store.Dictionary (Stereo a)+storeStereo =+   Store.run $+   liftA2 Stereo+      (Store.element left)+      (Store.element right)++instance (Storable a) => Storable (Stereo a) where+   {- INLINE sizeOf -}+   sizeOf = Store.sizeOf storeStereo+   {- INLINE alignment -}+   alignment = Store.alignment storeStereo+   {- INLINE peek -}+   peek = Store.peek storeStereo+   {- INLINE poke -}+   poke = Store.poke storeStereo+++size :: Int+size = 10000000++main :: IO ()+main = mapM_ T.timeIt $+   (print $ SV.last $ SV.iterateN size (1+) (0::Float)) :+   (print $ SV.last $ SV.iterateN size (1+) (0::Word8)) :+   (print $ SV.last $+    SV.iterateN size (\x -> MonoN (singleN x + 1)) (MonoN (0::Float))) :+   (print $ SV.last $+    SV.iterateN size (\x -> Mono (single x + 1)) (Mono (0::Float))) :+   (print $ SV.last $+    SV.iterateN size (\x -> Stereo (left x + 1) (right x + 3))+       (Stereo 1 2 :: Stereo Float)) :+   []
storable-record.cabal view
@@ -1,5 +1,5 @@ Name:         storable-record-Version:      0.0.2.3+Version:      0.0.2.4 Category:     Data, Foreign Synopsis:     Elegant definition of Storable instances for records Description:@@ -63,11 +63,15 @@ Source-Repository this   Type:     darcs   Location: http://code.haskell.org/~thielema/storable-record/-  Tag:      0.0.2.3+  Tag:      0.0.2.4  Flag splitBase   description: Choose the new smaller, split-up base package. +Flag buildTests+  description: Build speed test+  default:     False+ Library   Build-Depends:     transformers >=0.2 && <0.3,@@ -89,4 +93,18 @@     Foreign.Storable.Traversable   Other-Modules:     Foreign.Storable.FixedArray+    Foreign.Storable.RecordMinimalSize+    Foreign.Storable.RecordReaderPtr     Foreign.Storable.TraversableUnequalSizes++Executable storable-record-speed+  If flag(buildTests)+    Build-Depends:+      storablevector >=0.2.7 && <0.2.8,+      timeit >=1.0 && <1.1+  Else+    Buildable: False++  GHC-Options:         -Wall+  Hs-Source-Dirs:      src+  Main-Is:             SpeedTest.hs