packages feed

vector-binary-instances 0.1.2 → 0.2

raw patch · 4 files changed

+104/−88 lines, 4 files

Files

Data/Vector/Binary.hs view
@@ -3,11 +3,11 @@ -------------------------------------------------------------------- -- | -- Module    : Data.Vector.Binary--- Copyright : (c) Don Stewart 2010+-- Copyright : (c) Don Stewart 2010-2012  -- License   : BSD3 ----- Maintainer: Don Stewart <dons@galois.com>+-- Maintainer: Don Stewart <dons00@gmail.com> -- Stability : provisional -- Portability: GHC only @@ -33,58 +33,67 @@ module Data.Vector.Binary () where  import Data.Binary-import qualified Data.Vector.Generic as G import Control.Monad +import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Storable as S+import Data.Vector (Vector)+ import System.IO.Unsafe import qualified Data.Vector.Generic.Mutable as M+import Foreign.Storable (Storable) -instance (G.Vector v a, Binary a) => Binary (v a) where-    put v = do-        put (G.length v)-        mapM_ put (G.toList v)+-- Enumerate the instances to avoid the nasty overlapping instances. -    -- this is morally sound, if very awkward.-    -- all effects are contained, and can't escape the unsafeFreeze+-- | Boxed, generic vectors.+instance Binary a => Binary (Vector a) where+    put = putGeneric+    get = getGeneric     {-# INLINE get #-}-    get = do-        n  <- get -        -- new unitinialized array-        mv <- lift $ M.new n--        let fill i-                | i < n = do-                    x <- get-                    (unsafePerformIO $ M.unsafeWrite mv i x) `seq` return ()-                    fill (i+1)+-- | Unboxed vectors+instance (U.Unbox a, Binary a) => Binary (U.Vector a) where+    put = putGeneric+    get = getGeneric+    {-# INLINE get #-} -                | otherwise = return ()+-- | Storable vectors+instance (Storable a, Binary a) => Binary (S.Vector a) where+    put = putGeneric+    get = getGeneric+    {-# INLINE get #-} -        fill 0+------------------------------------------------------------------------+    +-- this is morally sound, if very awkward.+-- all effects are contained, and can't escape the unsafeFreeze+getGeneric :: (G.Vector v a, Binary a) => Get (v a)+{-# INLINE getGeneric #-}+getGeneric = do+    n  <- get -        lift $ G.unsafeFreeze mv+    -- new unitinialized array+    mv <- lift $ M.new n -lift = return .unsafePerformIO+    let fill i+            | i < n = do+                x <- get+                (unsafePerformIO $ M.unsafeWrite mv i x) `seq` return ()+                fill (i+1) -{--    -- Uses too much space going via lists.-    -- XXX todo: fill directly from a stream. -    get = do-        n  <- get-        xs <- getMany n-        return (G.fromList xs)+            | otherwise = return () +    fill 0 --- | 'getMany n' get 'n' elements in order, without blowing the stack.-getMany :: Binary a => Int -> Get [a]-getMany n = go [] n- where-    go xs 0 = return $! reverse xs-    go xs i = do x <- get-                 -- we must seq x to avoid stack overflows due to laziness in-                 -- (>>=)-                 x `seq` go (x:xs) (i-1)-{-# INLINE getMany #-}+    lift $ G.unsafeFreeze mv+    +-- | Generic put for anything in the G.Vector class.+putGeneric :: (G.Vector v a, Binary a) => v a -> Put+{-# INLINE putGeneric #-}+putGeneric v = do+    put (G.length v)+    mapM_ put (G.toList v) --}+lift :: IO b -> Get b+lift = return .unsafePerformIO
Data/Vector/Cereal.hs view
@@ -3,11 +3,11 @@ -------------------------------------------------------------------- -- | -- Module    : Data.Vector.Cereal--- Copyright : (c) Don Stewart 2010+-- Copyright : (c) Don Stewart 2010-2012  -- License   : BSD3 ----- Maintainer: Don Stewart <dons@galois.com>+-- Maintainer: Don Stewart <dons00@gmail.com> -- Stability : provisional -- Portability: GHC only --@@ -20,56 +20,65 @@ module Data.Vector.Cereal () where  import Data.Serialize-import qualified Data.Vector.Generic as G import Control.Monad +import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Storable as S+import Data.Vector (Vector)+ import System.IO.Unsafe import qualified Data.Vector.Generic.Mutable as M--instance (G.Vector v a, Serialize a) => Serialize (v a) where-    put v = do-        put (G.length v)-        mapM_ put (G.toList v)+import Foreign.Storable (Storable) -    -- this is morally sound, if very awkward.-    -- all effects are contained, and can't escape the unsafeFreeze+-- | Boxed, generic vectors.+instance Serialize a => Serialize (Vector a) where+    put = putGeneric+    get = getGeneric     {-# INLINE get #-}-    get = do-        n  <- get -        -- new unitinialized array-        mv <- lift $ M.new n--        let fill i-                | i < n = do-                    x <- get-                    (unsafePerformIO $ M.unsafeWrite mv i x) `seq` return ()-                    fill (i+1)+-- | Unboxed vectors+instance (U.Unbox a, Serialize a) => Serialize (U.Vector a) where+    put = putGeneric+    get = getGeneric+    {-# INLINE get #-} -                | otherwise = return ()+-- | Storable vectors+instance (Storable a, Serialize a) => Serialize (S.Vector a) where+    put = putGeneric+    get = getGeneric+    {-# INLINE get #-} -        fill 0+------------------------------------------------------------------------+    +-- this is morally sound, if very awkward.+-- all effects are contained, and can't escape the unsafeFreeze+getGeneric :: (G.Vector v a, Serialize a) => Get (v a)+{-# INLINE getGeneric #-}+getGeneric = do+    n  <- get -        lift $ G.unsafeFreeze mv+    -- new unitinialized array+    mv <- lift $ M.new n -lift = return .unsafePerformIO+    let fill i+            | i < n = do+                x <- get+                (unsafePerformIO $ M.unsafeWrite mv i x) `seq` return ()+                fill (i+1) -{--    get = do-        n  <- get-        xs <- getMany n-        return (G.fromList xs)+            | otherwise = return () +    fill 0 --- | 'getMany n' get 'n' elements in order, without blowing the stack.-getMany :: Serialize a => Int -> Get [a]-getMany n = go [] n- where-    go xs 0 = return $! reverse xs-    go xs i = do x <- get-                 -- we must seq x to avoid stack overflows due to laziness in-                 -- (>>=)-                 x `seq` go (x:xs) (i-1)-{-# INLINE getMany #-}+    lift $ G.unsafeFreeze mv+    +-- | Generic put for anything in the G.Vector class.+putGeneric :: (G.Vector v a, Serialize a) => v a -> Put+{-# INLINE putGeneric #-}+putGeneric v = do+    put (G.length v)+    mapM_ put (G.toList v) --}+lift :: IO b -> Get b+lift = return .unsafePerformIO
LICENSE view
@@ -1,4 +1,4 @@-Copyright Don Stewart 2010+Copyright Don Stewart 2010-2012  All rights reserved. 
vector-binary-instances.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.2+Version:             0.2  -- A short (one-line) description of the package. Synopsis:            Instances of Data.Binary and Data.Serialize for vector@@ -17,6 +17,8 @@    Instances for Binary for the types defined in the vector package,    making it easy to serialize vectors to and from disk. We use the    generic interface to vectors, so all vector types are supported.+   Specific instances are provided for unboxed, boxed and storable+   vectors.    .     To serialize a vector:    .@@ -45,7 +47,7 @@  -- An email address to which users can send suggestions, bug reports, -- and patches.-Maintainer:          dons@galois.com+Maintainer:          dons00@gmail.com  -- A copyright notice. -- Copyright:           @@ -77,7 +79,3 @@     vector >= 0.5,     binary,     cereal--  Extensions:-    FlexibleInstances,-    UndecidableInstances