Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/bc4498cb716c47e1ea80a96c469ca42b52d85f52 >--------------------------------------------------------------- commit bc4498cb716c47e1ea80a96c469ca42b52d85f52 Author: Duncan Coutts <[email protected]> Date: Wed Nov 16 23:31:04 2011 +0000 Fixes for ghc-6.10 >--------------------------------------------------------------- Data/ByteString/Internal.hs | 2 +- .../Lazy/Builder/BasicEncoding/Internal.hs | 5 +++++ .../Lazy/Builder/BasicEncoding/Internal/Base16.hs | 1 + .../Builder/BasicEncoding/Internal/Floating.hs | 5 ----- Data/ByteString/Lazy/Builder/Internal.hs | 11 +++-------- bytestring.cabal | 2 +- 6 files changed, 11 insertions(+), 15 deletions(-) diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs index a4cb86d..17d9b6f 100644 --- a/Data/ByteString/Internal.hs +++ b/Data/ByteString/Internal.hs @@ -213,7 +213,7 @@ instance Data ByteString where gfoldl f z txt = z packBytes `f` (unpackBytes txt) toConstr _ = error "Data.ByteString.ByteString.toConstr" gunfold _ _ = error "Data.ByteString.ByteString.gunfold" -#if __GLASGOW_HASKELL__ >= 612 +#if MIN_VERSION_base(4,2,0) dataTypeOf _ = mkNoRepType "Data.ByteString.ByteString" #else dataTypeOf _ = mkNorepType "Data.ByteString.ByteString" diff --git a/Data/ByteString/Lazy/Builder/BasicEncoding/Internal.hs b/Data/ByteString/Lazy/Builder/BasicEncoding/Internal.hs index 768a13b..2b3e72a 100644 --- a/Data/ByteString/Lazy/Builder/BasicEncoding/Internal.hs +++ b/Data/ByteString/Lazy/Builder/BasicEncoding/Internal.hs @@ -63,6 +63,11 @@ module Data.ByteString.Lazy.Builder.BasicEncoding.Internal ( import Foreign import Prelude hiding (maxBound) +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 611 +-- ghc-6.10 and older do not support {-# INLINE CONLIKE #-} +#define CONLIKE +#endif + ------------------------------------------------------------------------------ -- Supporting infrastructure ------------------------------------------------------------------------------ diff --git a/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Base16.hs b/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Base16.hs index 8c53fda..b72abec 100644 --- a/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Base16.hs +++ b/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Base16.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE) diff --git a/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Floating.hs b/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Floating.hs index e69d13e..bb9a0e1 100644 --- a/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Floating.hs +++ b/Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Floating.hs @@ -18,12 +18,7 @@ module Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Floating , encodeDoubleViaWord64F ) where -#if MIN_VERSION_base(4,4,0) -import Foreign hiding (unsafePerformIO) -import System.IO.Unsafe (unsafePerformIO) -#else import Foreign -#endif import Data.ByteString.Lazy.Builder.BasicEncoding.Internal {- diff --git a/Data/ByteString/Lazy/Builder/Internal.hs b/Data/ByteString/Lazy/Builder/Internal.hs index 4497d68..f8bf9d1 100644 --- a/Data/ByteString/Lazy/Builder/Internal.hs +++ b/Data/ByteString/Lazy/Builder/Internal.hs @@ -109,12 +109,7 @@ module Data.ByteString.Lazy.Builder.Internal ( ) where --- TODO: Check if we still require conditional compilation for Applicative - --- #ifdef APPLICATIVE_IN_BASE -import Control.Applicative (Applicative(..)) --- #endif -import Control.Applicative ((<$>)) +import Control.Applicative (Applicative(..), (<$>)) import Data.Monoid import qualified Data.ByteString as S @@ -363,17 +358,17 @@ instance Functor Put where fmap f p = Put $ \k -> unPut p (\x -> k (f x)) {-# INLINE fmap #-} --- #ifdef APPLICATIVE_IN_BASE instance Applicative Put where {-# INLINE pure #-} pure x = Put $ \k -> k x {-# INLINE (<*>) #-} Put f <*> Put a = Put $ \k -> f (\f' -> a (\a' -> k (f' a'))) +#if MIN_VERSION_base(4,2,0) {-# INLINE (<*) #-} Put a <* Put b = Put $ \k -> a (\a' -> b (\_ -> k a')) {-# INLINE (*>) #-} Put a *> Put b = Put $ \k -> a (\_ -> b k) --- #endif +#endif instance Monad Put where {-# INLINE return #-} diff --git a/bytestring.cabal b/bytestring.cabal index c2f6316..0af5f2f 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -154,7 +154,7 @@ test-suite test-builder QuickCheck >= 2.4 && < 3, byteorder == 1.0.*, dlist == 0.5.*, - directory == 1.1.*, + directory >= 1.0 && < 1.2, mtl == 2.0.* ghc-options: -Wall -fwarn-tabs _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
