Portability fixes for ghc-6.4.2, ghc-6.6.1
authorDuncan Coutts <duncan.coutts@worc.ox.ac.uk>
Tue, 16 Oct 2007 23:36:34 +0000 (01:36 +0200)
committerDuncan Coutts <duncan.coutts@worc.ox.ac.uk>
Tue, 16 Oct 2007 23:36:34 +0000 (01:36 +0200)
Only tested on x86-64 with ghc-6.4.2 and ghc-6.6.1, not on ordinart 32bit x86

binary.cabal
src/Data/Binary/Builder.hs
src/Data/Binary/Get.hs

index 5feaa15..dfced97 100644 (file)
@@ -13,15 +13,35 @@ description:     Efficient, pure binary serialisation using lazy ByteStrings.
                  scenarios.
 synopsis:        Binary serialization for Haskell values using lazy ByteStrings
 category:        Data, Parsing
-build-depends:   base, containers, array, bytestring>=0.9
 stability:       provisional
-tested-with:     GHC==6.8
--- 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
index 10e1e90..77476ec 100644 (file)
@@ -58,11 +58,17 @@ module Data.Binary.Builder (
 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
index 118b1ee..296d854 100644 (file)
@@ -74,9 +74,14 @@ import Control.Monad.Fix
 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 @@ initState (B.LPS xs) =
       (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 @@ getBytes n = do
 {-# 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 @@ join bb (B.LPS lb)
 --
 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 @@ splitAtST i ps          = runST (
                            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,