diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,14 @@ # ChangeLog +## 0.6.1 + +* Can now optionally be built with `integer-simple` instead of + `integer-gmp`, via the `integer-simple` cabal flag. Note that the + serialization of `Integer` with `integer-simple` differs from what + is used by the GMP default. See [#147][]. + +[#147]: https://github.com/fpco/store/pull/147 + ## 0.6.0.1 * Now builds with GHC-7.10 - compatibility was broken in 0.6.0 due to diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,6 +14,11 @@ [#31](https://github.com/fpco/store/issues/31). This plan makes little endian the default, so that the most common endianness has no overhead. + - Another way that the serialization behavior can vary is if + integer-simple is used instead of GHC's default of using + GMP. `Integer` serialized with the `integer-simple` flag enabled + are not compatible with those serialized without the flag enabled. + * Instead of implementing lazy serialization / deserialization involving multiple input / output buffers, `peek` and `poke` always work with a single buffer. This buffer is allocated by asking the value for its size before diff --git a/src/Data/Store/Impl.hs b/src/Data/Store/Impl.hs --- a/src/Data/Store/Impl.hs +++ b/src/Data/Store/Impl.hs @@ -293,7 +293,7 @@ type family TypeErrorMessage (a :: Symbol) :: Constraint where #if MIN_VERSION_base(4,9,0) - TypeErrorMessage a = TypeError (Text a) + TypeErrorMessage a = TypeError ('Text a) -- GHC < 8.0 does not support empty closed type families #elif __GLASGOW_HASKELL__ < 800 TypeErrorMessage a = a ~ "" diff --git a/src/Data/Store/Internal.hs b/src/Data/Store/Internal.hs --- a/src/Data/Store/Internal.hs +++ b/src/Data/Store/Internal.hs @@ -118,10 +118,15 @@ import Foreign.Ptr (plusPtr, minusPtr) import Foreign.Storable (Storable, sizeOf) import GHC.Generics (Generic) +#ifdef INTEGER_GMP import qualified GHC.Integer.GMP.Internals as I +import GHC.Types (Int (I#)) +#else +import GHC.Types (Word (W#)) +import qualified GHC.Integer.Simple.Internals as I +#endif import GHC.Real (Ratio(..)) import GHC.TypeLits -import GHC.Types (Int (I#)) import Instances.TH.Lift () import Language.Haskell.TH import Language.Haskell.TH.Instances () @@ -132,9 +137,11 @@ import TH.Derive -- Conditional import to avoid warning +#ifdef INTEGER_GMP #if MIN_VERSION_integer_gmp(1,0,0) import GHC.Prim (sizeofByteArray#) #endif +#endif ------------------------------------------------------------------------ -- Utilities for defining list-like 'Store' instances in terms of 'IsSequence' @@ -573,6 +580,7 @@ {-# INLINE peekArray #-} instance Store Integer where +#ifdef INTEGER_GMP #if MIN_VERSION_integer_gmp(1,0,0) size = VarSize $ \ x -> sizeOf (undefined :: Word8) + case x of @@ -639,6 +647,51 @@ !(I# sz) = if neg then negate sz0 else sz0 when (r /= 0) (peekException "Buffer size stored for encoded Integer not divisible by Word size (to get limb count).") return (I.J# sz arr) +#endif +#else + -- NOTE: integer-simple uses a different encoding than GMP + size = VarSize $ \ x -> + sizeOf (undefined :: Word8) + case x of + I.Positive ds -> (1 + fromIntegral (numDigits ds)) * sizeOf (undefined :: Word) + I.Negative ds -> (1 + fromIntegral (numDigits ds)) * sizeOf (undefined :: Word) + I.Naught -> 0 + where + poke x = case x of + I.Naught -> poke (0 :: Word8) + I.Positive ds -> do + poke (1 :: Word8) + poke (numDigits ds) + pokeDigits ds + I.Negative ds -> do + poke (2 :: Word8) + poke (numDigits ds) + pokeDigits ds + where + pokeDigits I.None = pure () + pokeDigits (I.Some d ds) = poke (W# d) *> pokeDigits ds + peek = do + tag <- peek :: Peek Word8 + case tag of + 0 -> pure I.Naught + 1 -> do + len <- peek :: Peek Word + I.Positive <$> peekDigits len + 2 -> do + len <- peek :: Peek Word + I.Negative <$> peekDigits len + _ -> peekException "Invalid Integer tag" + where + peekDigits i + | i <= 0 = pure I.None + | otherwise = do + W# d <- peek + ds <- peekDigits (i - 1) + pure $! I.Some d ds + +numDigits :: I.Digits -> Word +numDigits = go 0 + where go !acc I.None = acc + go !acc (I.Some _ ds) = go (acc + 1) ds #endif -- instance Store GHC.Fingerprint.Types.Fingerprint where diff --git a/store.cabal b/store.cabal --- a/store.cabal +++ b/store.cabal @@ -4,15 +4,15 @@ -- -- see: https://github.com/sol/hpack -- --- hash: cbe27ae7010939e8748f8e358c348aa045dd30396a99c04e1967eacd25bf45cd +-- hash: ed0f087802fae2b44eeecb3e8163cf7c263fe0b11167686dae1faa5c23a13ed8 name: store -version: 0.6.0.1 +version: 0.6.1 synopsis: Fast binary serialization category: Serialization, Data homepage: https://github.com/fpco/store#readme bug-reports: https://github.com/fpco/store/issues -maintainer: Michael Sloan +maintainer: Michael Sloan copyright: 2016 FP Complete license: MIT license-file: LICENSE @@ -29,6 +29,11 @@ manual: True default: False +flag integer-simple + description: Use the [simple integer library](http://hackage.haskell.org/package/integer-simple) instead of [integer-gmp](http://hackage.haskell.org/package/integer-gmp) + manual: False + default: False + flag small-bench manual: True default: False @@ -68,7 +73,6 @@ , hashable >=1.2.3.1 , hspec >=2.1.2 , hspec-smallcheck >=0.3.0 - , integer-gmp >=0.5.1.0 , lifted-base >=0.2.3.3 , monad-control >=0.3.3.0 , mono-traversable >=0.7.0 @@ -92,6 +96,13 @@ , unordered-containers >=0.2.5.1 , vector >=0.10.12.3 , void >=0.5.11 + if flag(integer-simple) + build-depends: + integer-simple >=0.1.1.1 + else + cpp-options: -DINTEGER_GMP + build-depends: + integer-gmp >=0.5.1.0 default-language: Haskell2010 test-suite store-test @@ -126,7 +137,6 @@ , hashable >=1.2.3.1 , hspec >=2.1.2 , hspec-smallcheck >=0.3.0 - , integer-gmp >=0.5.1.0 , lifted-base >=0.2.3.3 , monad-control >=0.3.3.0 , mono-traversable >=0.7.0 @@ -151,6 +161,13 @@ , unordered-containers >=0.2.5.1 , vector >=0.10.12.3 , void >=0.5.11 + if flag(integer-simple) + build-depends: + integer-simple >=0.1.1.1 + else + cpp-options: -DINTEGER_GMP + build-depends: + integer-gmp >=0.5.1.0 default-language: Haskell2010 benchmark store-bench @@ -182,7 +199,6 @@ , hashable >=1.2.3.1 , hspec >=2.1.2 , hspec-smallcheck >=0.3.0 - , integer-gmp >=0.5.1.0 , lifted-base >=0.2.3.3 , monad-control >=0.3.3.0 , mono-traversable >=0.7.0 @@ -207,6 +223,13 @@ , unordered-containers >=0.2.5.1 , vector >=0.10.12.3 , void >=0.5.11 + if flag(integer-simple) + build-depends: + integer-simple >=0.1.1.1 + else + cpp-options: -DINTEGER_GMP + build-depends: + integer-gmp >=0.5.1.0 if flag(comparison-bench) cpp-options: -DCOMPARISON_BENCH build-depends: @@ -247,7 +270,6 @@ , hashable >=1.2.3.1 , hspec >=2.1.2 , hspec-smallcheck >=0.3.0 - , integer-gmp >=0.5.1.0 , lifted-base >=0.2.3.3 , monad-control >=0.3.3.0 , mono-traversable >=0.7.0 @@ -274,4 +296,11 @@ , vector-binary-instances , void >=0.5.11 , weigh + if flag(integer-simple) + build-depends: + integer-simple >=0.1.1.1 + else + cpp-options: -DINTEGER_GMP + build-depends: + integer-gmp >=0.5.1.0 default-language: Haskell2010 diff --git a/test/Data/StoreSpec.hs b/test/Data/StoreSpec.hs --- a/test/Data/StoreSpec.hs +++ b/test/Data/StoreSpec.hs @@ -16,6 +16,7 @@ import Control.Applicative import Control.Exception (evaluate) import Control.Monad (unless) +import Control.Monad.Fail (MonadFail) import qualified Data.Array.Unboxed as A import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -31,7 +32,9 @@ import qualified Data.List.NonEmpty as NE import Data.Map (Map) import Data.Monoid +#if !MIN_VERSION_primitive(0,7,0) import Data.Primitive.Types (Addr) +#endif import Data.Proxy (Proxy(..)) import Data.Sequence (Seq) import Data.Sequences (fromList) @@ -284,9 +287,11 @@ spec = do describe "Store on all monomorphic instances" $(do insts <- getAllInstanceTypes1 ''Store - omitTys0 <- sequence - [ [t| Addr |] - , [t| CUIntPtr |] + omitTys0 <- sequence $ +#if !MIN_VERSION_primitive(0,7,0) + [t| Addr |] : +#endif + [ [t| CUIntPtr |] , [t| CIntPtr |] , [t| IntPtr |] , [t| WordPtr |] @@ -303,7 +308,7 @@ filtered = filter f insts smallcheckManyStore verbose 2 $ map return filtered) it "Store on non-numeric Float/Double values" $ do - let testNonNumeric :: forall a m. (RealFloat a, Eq a, Show a, Typeable a, Store a, Monad m) => Proxy a -> m () + let testNonNumeric :: forall a m. (RealFloat a, Eq a, Show a, Typeable a, Store a, Monad m, MonadFail m) => Proxy a -> m () testNonNumeric _proxy = do assertRoundtrip verbose ((1/0) :: a) assertRoundtrip verbose ((-1/0) :: a)