binary 0.4 → 0.4.1
raw patch · 3 files changed
+85/−19 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- binary.cabal +31/−10
- src/Data/Binary/Builder.hs +17/−3
- src/Data/Binary/Get.hs +37/−6
binary.cabal view
@@ -1,5 +1,5 @@ name: binary-version: 0.4+version: 0.4.1 license: BSD3 license-file: LICENSE author: Lennart Kolmodin <kolmodin@dtek.chalmers.se>@@ -13,14 +13,35 @@ scenarios. synopsis: Binary serialization for Haskell values using lazy ByteStrings category: Data, Parsing-build-depends: base, containers, array, bytestring>=0.9 stability: provisional--- ghc 6.4 also needs package fps-exposed-modules: Data.Binary,- Data.Binary.Put,- Data.Binary.Get,- Data.Binary.Builder-extensions: CPP,FlexibleContexts-hs-source-dirs: src-ghc-options: -O2 -Wall -fliberate-case-threshold=1000+build-type: Simple+cabal-version: >= 1.2+tested-with: GHC ==6.4.2, GHC ==6.6.1, GHC ==6.8.0 extra-source-files: README ++flag bytestring-in-base+flag split-base++library+ if flag(bytestring-in-base)+ -- bytestring was in base-2.0 and 2.1.1+ build-depends: base >= 2.0 && < 2.2+ ghc-options: -DBYTESTRING_IN_BASE+ else+ -- in base 1.0 and 3.0 bytestring is a separate package+ build-depends: base < 2.0 || >= 3, bytestring >= 0.9++ if flag(split-base)+ build-depends: base >= 3.0, containers, array+ else+ build-depends: base < 3.0++ exposed-modules: Data.Binary,+ Data.Binary.Put,+ Data.Binary.Get,+ Data.Binary.Builder+ extensions: CPP, FlexibleContexts+ hs-source-dirs: src+ ghc-options: -O2 -Wall -fliberate-case-threshold=1000+ if impl(ghc < 6.5)+ ghc-options: -fallow-undecidable-instances
src/Data/Binary/Builder.hs view
@@ -58,16 +58,26 @@ import Foreign import Data.Monoid import Data.Word-import Data.ByteString.Internal (inlinePerformIO) import qualified Data.ByteString as S-import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy as L++#ifdef BYTESTRING_IN_BASE+import Data.ByteString.Base (inlinePerformIO)+import qualified Data.ByteString.Base as S+#else+import Data.ByteString.Internal (inlinePerformIO)+import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L+#endif #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) import GHC.Base import GHC.Word (Word32(..),Word16(..),Word64(..))++#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608+import GHC.Word (uncheckedShiftRL64#) #endif+#endif ------------------------------------------------------------------------ @@ -389,8 +399,12 @@ #if WORD_SIZE_IN_BITS < 64 shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i) -foreign import ccall unsafe "stg_uncheckedShiftRL64" +#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64#+#endif+ #else shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i) #endif
src/Data/Binary/Get.hs view
@@ -74,9 +74,14 @@ import Data.Maybe (isNothing) import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as L++#ifdef BYTESTRING_IN_BASE+import qualified Data.ByteString.Base as B+#else+import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy.Internal as L+#endif import Foreign @@ -133,18 +138,20 @@ (x:xs') -> S x (B.LPS xs') 0 -} +#ifndef BYTESTRING_IN_BASE mkState :: L.ByteString -> Int64 -> S mkState l = case l of L.Empty -> S B.empty L.empty L.Chunk x xs -> S x xs {-# INLINE mkState #-} -{-+#else+mkState :: L.ByteString -> Int64 -> S mkState (B.LPS xs) = case xs of [] -> S B.empty L.empty (x:xs') -> S x (B.LPS xs')--}+#endif -- | Run the Get monad applies a 'get'-based parser on the input ByteString runGet :: Get a -> L.ByteString -> a@@ -307,16 +314,18 @@ {-# INLINE getBytes #-} -- ^ important +#ifndef BYTESTRING_IN_BASE join :: B.ByteString -> L.ByteString -> L.ByteString join bb lb | B.null bb = lb | otherwise = L.Chunk bb lb -{-+#else+join :: B.ByteString -> L.ByteString -> L.ByteString join bb (B.LPS lb) | B.null bb = B.LPS lb | otherwise = B.LPS (bb:lb)--}+#endif -- don't use L.append, it's strict in it's second argument :/ {-# INLINE join #-} @@ -330,6 +339,7 @@ -- splitAtST :: Int64 -> L.ByteString -> (L.ByteString, L.ByteString) splitAtST i ps | i <= 0 = (L.empty, ps)+#ifndef BYTESTRING_IN_BASE splitAtST i ps = runST ( do r <- newSTRef undefined xs <- first r i ps@@ -347,6 +357,23 @@ liftM (L.Chunk x) $ unsafeInterleaveST (first r (n - l) xs) where l = fromIntegral (B.length x)+#else+splitAtST i (B.LPS ps) = runST (+ do r <- newSTRef undefined+ xs <- first r i ps+ ys <- unsafeInterleaveST (readSTRef r)+ return (B.LPS xs, B.LPS ys))++ where first r 0 xs = writeSTRef r xs >> return []+ first r _ [] = writeSTRef r [] >> return []+ first r n (x:xs)+ | n < l = do writeSTRef r (B.drop (fromIntegral n) x : xs)+ return [B.take (fromIntegral n) x]+ | otherwise = do writeSTRef r (L.toChunks (L.drop (n - l) (B.LPS xs)))+ fmap (x:) $ unsafeInterleaveST (first r (n - l) xs)++ where l = fromIntegral (B.length x)+#endif {-# INLINE splitAtST #-} -- Pull n bytes from the input, and apply a parser to those bytes,@@ -480,8 +507,12 @@ #if WORD_SIZE_IN_BITS < 64 shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i) -foreign import ccall unsafe "stg_uncheckedShiftL64" +#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64#+#endif+ #else shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i) #endif