diff --git a/benchmarks/GenericsBenchCache.hs b/benchmarks/GenericsBenchCache.hs --- a/benchmarks/GenericsBenchCache.hs +++ b/benchmarks/GenericsBenchCache.hs @@ -37,4 +37,4 @@ return pds cacheFilePath :: String -cacheFilePath = "generics-bench.cache.gz" +cacheFilePath = "generics-bench.cache-100.gz" diff --git a/binary.cabal b/binary.cabal --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,13 @@ +-- To run tests and binaries you'll need to rename the name of the library +-- and all the local dependencies on it. If not, cabal is unable to come up +-- with a build plan. +-- +-- Try this; +-- sed -i 's/\(name:\s*binary\)/\1-cabal-is-broken/' binary.cabal +-- sed -i 's/\(binary\),/\1-cabal-is-broken,/' binary.cabal + name: binary -version: 0.8.7.0 +version: 0.8.8.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin @@ -18,7 +26,7 @@ stability: provisional build-type: Simple cabal-version: >= 1.8 -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC ==8.2.2, GHC == 8.4.4, GHC == 8.6.5 +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC ==8.2.2, GHC == 8.4.4, GHC == 8.6.5 extra-source-files: README.md changelog.md docs/hcar/binary-Lb.tex tools/derive/*.hs @@ -52,31 +60,17 @@ if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances --- Due to circular dependency, we cannot make any of the test-suites or --- benchmark depend on the binary library. Instead, for each test-suite and --- benchmark, we include the source directory of binary and build-depend on all --- the dependencies binary has. - test-suite qc type: exitcode-stdio-1.0 - hs-source-dirs: src tests + hs-source-dirs: tests main-is: QC.hs other-modules: Action Arbitrary - other-modules: - Data.Binary - Data.Binary.Builder - Data.Binary.Class - Data.Binary.FloatCast - Data.Binary.Generic - Data.Binary.Get - Data.Binary.Get.Internal - Data.Binary.Internal - Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, base-orphans >=0.8.1 && <0.9, + binary, bytestring >= 0.10.4, random>=1.0.1.0, test-framework, @@ -93,20 +87,11 @@ test-suite read-write-file type: exitcode-stdio-1.0 - hs-source-dirs: src tests + hs-source-dirs: tests main-is: File.hs - other-modules: - Data.Binary - Data.Binary.Builder - Data.Binary.Class - Data.Binary.FloatCast - Data.Binary.Generic - Data.Binary.Get - Data.Binary.Get.Internal - Data.Binary.Internal - Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, + binary, bytestring >= 0.10.4, Cabal, directory, @@ -123,21 +108,13 @@ benchmark bench type: exitcode-stdio-1.0 - hs-source-dirs: src benchmarks + hs-source-dirs: benchmarks main-is: Benchmark.hs other-modules: MemBench - Data.Binary - Data.Binary.Builder - Data.Binary.Class - Data.Binary.FloatCast - Data.Binary.Generic - Data.Binary.Get - Data.Binary.Get.Internal - Data.Binary.Internal - Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, + binary, bytestring >= 0.10.4 -- build dependencies from using binary source rather than depending on the library build-depends: array, containers @@ -151,21 +128,12 @@ benchmark get type: exitcode-stdio-1.0 - hs-source-dirs: src benchmarks + hs-source-dirs: benchmarks main-is: Get.hs - other-modules: - Data.Binary - Data.Binary.Builder - Data.Binary.Class - Data.Binary.FloatCast - Data.Binary.Generic - Data.Binary.Get - Data.Binary.Get.Internal - Data.Binary.Internal - Data.Binary.Put build-depends: attoparsec, base >= 4.5.0.0 && < 5, + binary, bytestring >= 0.10.4, cereal, criterion == 1.*, @@ -181,20 +149,11 @@ benchmark put type: exitcode-stdio-1.0 - hs-source-dirs: src benchmarks + hs-source-dirs: benchmarks main-is: Put.hs - other-modules: - Data.Binary - Data.Binary.Builder - Data.Binary.Class - Data.Binary.FloatCast - Data.Binary.Generic - Data.Binary.Get - Data.Binary.Get.Internal - Data.Binary.Internal - Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, + binary, bytestring >= 0.10.4, criterion == 1.*, deepseq @@ -207,20 +166,11 @@ benchmark generics-bench type: exitcode-stdio-1.0 - hs-source-dirs: src benchmarks + hs-source-dirs: benchmarks main-is: GenericsBench.hs - other-modules: - Data.Binary - Data.Binary.Builder - Data.Binary.Class - Data.Binary.FloatCast - Data.Binary.Generic - Data.Binary.Get - Data.Binary.Get.Internal - Data.Binary.Internal - Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, + binary, bytestring >= 0.10.4, -- The benchmark already depended on 'generic-deriving' transitively. That's -- what caused one of the problems, as both 'generic-deriving' and @@ -245,20 +195,11 @@ benchmark builder type: exitcode-stdio-1.0 - hs-source-dirs: src benchmarks + hs-source-dirs: benchmarks main-is: Builder.hs - other-modules: - Data.Binary - Data.Binary.Builder - Data.Binary.Class - Data.Binary.FloatCast - Data.Binary.Generic - Data.Binary.Get - Data.Binary.Get.Internal - Data.Binary.Internal - Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, + binary, bytestring >= 0.10.4, criterion == 1.*, deepseq, diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ binary ====== +binary-0.8.8.0 +-------------- + +- Support Int32Rep and Word32Rep (3e0134df). +- Use bases built-in float/word32 and double/word64 casts (8eae4af0). + binary-0.8.7.0 -------------- diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -893,7 +893,11 @@ put Word8Rep = putWord8 13 put Int16Rep = putWord8 14 put Word16Rep = putWord8 15 +#if __GLASGOW_HASKELL__ >= 809 + put Int32Rep = putWord8 16 + put Word32Rep = putWord8 17 #endif +#endif get = do tag <- getWord8 @@ -915,7 +919,11 @@ 13 -> pure Word8Rep 14 -> pure Int16Rep 15 -> pure Word16Rep +#if __GLASGOW_HASKELL__ >= 809 + 16 -> pure Int32Rep + 17 -> pure Word32Rep #endif +#endif _ -> fail "GHCi.TH.Binary.putRuntimeRep: invalid tag" -- | @since 0.8.5.0 @@ -978,7 +986,6 @@ put (3 :: Word8) putTypeRep arg putTypeRep res -putTypeRep _ = error "GHCi.TH.Binary.putTypeRep: Impossible" getSomeTypeRep :: Get SomeTypeRep getSomeTypeRep = do diff --git a/src/Data/Binary/FloatCast.hs b/src/Data/Binary/FloatCast.hs --- a/src/Data/Binary/FloatCast.hs +++ b/src/Data/Binary/FloatCast.hs @@ -1,6 +1,8 @@ - +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +#if !(MIN_VERSION_base(4,11,0)) {-# LANGUAGE Trustworthy #-} +#endif -- | This module was written based on -- . @@ -8,33 +10,52 @@ -- Implements casting via a 1-element STUArray, as described in -- . module Data.Binary.FloatCast - ( floatToWord - , wordToFloat - , doubleToWord - , wordToDouble + ( floatToWord -- | Reinterpret-casts a `Float` to a `Word32`. + , wordToFloat -- | Reinterpret-casts a `Word32` to a `Float`. + , doubleToWord -- | Reinterpret-casts a `Double` to a `Word64`. + , wordToDouble -- | Reinterpret-casts a `Word64` to a `Double`. + ) where +#if MIN_VERSION_base(4,11,0) + import Data.Word (Word32, Word64) +import GHC.Float (castWord32ToFloat, castFloatToWord32, castWord64ToDouble, castDoubleToWord64) + +floatToWord :: Float -> Word32 +floatToWord = castFloatToWord32 +{-# INLINE floatToWord #-} + +wordToFloat :: Word32 -> Float +wordToFloat = castWord32ToFloat +{-# INLINE wordToFloat #-} + +doubleToWord :: Double -> Word64 +doubleToWord = castDoubleToWord64 +{-# INLINE doubleToWord #-} + +wordToDouble :: Word64 -> Double +wordToDouble = castWord64ToDouble +{-# INLINE wordToDouble #-} + +#else +import Data.Word (Word32, Word64) import Data.Array.ST (newArray, readArray, MArray, STUArray) import Data.Array.Unsafe (castSTUArray) import GHC.ST (runST, ST) --- | Reinterpret-casts a `Float` to a `Word32`. floatToWord :: Float -> Word32 floatToWord x = runST (cast x) {-# INLINE floatToWord #-} --- | Reinterpret-casts a `Word32` to a `Float`. wordToFloat :: Word32 -> Float wordToFloat x = runST (cast x) {-# INLINE wordToFloat #-} --- | Reinterpret-casts a `Double` to a `Word64`. doubleToWord :: Double -> Word64 doubleToWord x = runST (cast x) {-# INLINE doubleToWord #-} --- | Reinterpret-casts a `Word64` to a `Double`. wordToDouble :: Word64 -> Double wordToDouble x = runST (cast x) {-# INLINE wordToDouble #-} @@ -43,3 +64,4 @@ MArray (STUArray s) b (ST s)) => a -> ST s b cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0 {-# INLINE cast #-} +#endif diff --git a/tests/QC.hs b/tests/QC.hs --- a/tests/QC.hs +++ b/tests/QC.hs @@ -43,7 +43,6 @@ import Data.Binary import Data.Binary.Get import Data.Binary.Put -import qualified Data.Binary.Class as Class ------------------------------------------------------------------------ @@ -161,7 +160,7 @@ testTypeable = testProperty "TypeRep" prop_TypeRep prop_TypeRep :: TypeRep -> Property -prop_TypeRep = roundTripWith Class.put Class.get +prop_TypeRep = roundTripWith put get atomicTypeReps :: [TypeRep] atomicTypeReps =