data-dword 0.2.2 → 0.3
raw patch · 7 files changed
+80/−472 lines, 7 filesdep +data-bworddep +tastydep +tasty-quickcheckdep −QuickCheckdep −test-frameworkdep −test-framework-quickcheck2dep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependencies added: data-bword, tasty, tasty-quickcheck
Dependencies removed: QuickCheck, test-framework, test-framework-quickcheck2
Dependency ranges changed: template-haskell
API changes (from Hackage documentation)
- Data.DoubleWord: allOnes :: BinaryWord w => w
- Data.DoubleWord: allZeroes :: BinaryWord w => w
- Data.DoubleWord: class Bits w => BinaryWord w where type family UnsignedWord w type family SignedWord w
- Data.DoubleWord: leadingZeroes :: BinaryWord w => w -> Int
- Data.DoubleWord: lsb :: BinaryWord w => w
- Data.DoubleWord: msb :: BinaryWord w => w
- Data.DoubleWord: signedWord :: BinaryWord w => w -> SignedWord w
- Data.DoubleWord: testLsb :: BinaryWord w => w -> Bool
- Data.DoubleWord: testMsb :: BinaryWord w => w -> Bool
- Data.DoubleWord: trailingZeroes :: BinaryWord w => w -> Int
- Data.DoubleWord: unsignedWord :: BinaryWord w => w -> UnsignedWord w
- Data.DoubleWord: unwrappedAdd :: BinaryWord w => w -> w -> (w, UnsignedWord w)
- Data.DoubleWord: unwrappedMul :: BinaryWord w => w -> w -> (w, UnsignedWord w)
Files
- LICENSE +1/−1
- README.md +12/−0
- data-dword.cabal +9/−6
- src/Data/DoubleWord.hs +3/−1
- src/Data/DoubleWord/Base.hs +3/−450
- src/Data/DoubleWord/TH.hs +47/−4
- tests/Tests.hs +5/−10
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2011-2013 Mikhail Vorozhtsov+Copyright (c) 2011-2014 Mikhail Vorozhtsov All rights reserved. Redistribution and use in source and binary forms, with or without
+ README.md view
@@ -0,0 +1,12 @@+Data-DWord+==========+This package provides Template Haskell utilities for declaring fixed-length+binary word data types. Signed and unsigned 96, 128, 160, 192, 224, and+256-bit types are predefined.++Installation+------------+The usual:++ $ cabal install+
data-dword.cabal view
@@ -1,5 +1,5 @@ Name: data-dword-Version: 0.2.2+Version: 0.3 Category: Data Stability: experimental Synopsis: Stick two binary words together to get a bigger one@@ -13,10 +13,13 @@ Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com> Maintainer: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>-Copyright: 2011, 2012 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+Copyright: 2011-2014 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com> License: BSD3 License-File: LICENSE +Extra-Source-Files:+ README.md+ Cabal-Version: >= 1.10.0 Build-Type: Simple @@ -29,6 +32,7 @@ Build-Depends: base >= 4.6 && < 5, hashable >= 1.1,+ data-bword >= 0.1, template-haskell >= 2.8, ghc-prim Hs-Source-Dirs: src@@ -43,10 +47,9 @@ Default-Language: Haskell2010 Type: exitcode-stdio-1.0 Build-Depends:- base >= 4.5 && < 5,- test-framework >= 0.5,- test-framework-quickcheck2 >= 0.2,- QuickCheck >= 2.4,+ base >= 4.5 && < 5,+ tasty >= 0.8,+ tasty-quickcheck >= 0.8, data-dword Hs-Source-Dirs: tests GHC-Options: -Wall
src/Data/DoubleWord.hs view
@@ -8,7 +8,8 @@ -- signed and unsigned binary word data types of sizes 96, 128, -- 160, 192, 224, and 256 bits. module Data.DoubleWord- ( module Data.DoubleWord.Base+ ( module Data.BinaryWord+ , module Data.DoubleWord.Base , Word96(..) , Word128(..) , Word160(..)@@ -27,6 +28,7 @@ import GHC.Generics import Data.Word import Data.Int+import Data.BinaryWord import Data.DoubleWord.Base import Data.DoubleWord.TH
src/Data/DoubleWord/Base.hs view
@@ -1,461 +1,14 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-} -#include "MachDeps.h"- module Data.DoubleWord.Base- ( BinaryWord(..)- , DoubleWord(..)+ ( DoubleWord(..) ) where +import Data.Bits (Bits(..)) import Data.Int import Data.Word-import Data.Bits (Bits(..))-#if __GLASGOW_HASKELL__ >= 705-import GHC.Prim (plusWord2#, timesWord2#)-# if WORD_SIZE_IN_BITS == 32-import GHC.Word (Word32(..))-# endif-# if WORD_SIZE_IN_BITS == 64-import GHC.Word (Word64(..))-# endif-#endif---- | Extra bit-manipulation functions for binary words of fixed length.-class Bits w ⇒ BinaryWord w where- -- | The unsigned variant type- type UnsignedWord w- -- | The signed variant type- type SignedWord w- -- | Convert the word to the unsigned type (identical to 'fromIntegral')- unsignedWord ∷ w → UnsignedWord w- -- | Convert the word to the signed type (identical to 'fromIntegral')- signedWord ∷ w → SignedWord w- -- | Unwrapped addition- unwrappedAdd ∷ w → w → (w, UnsignedWord w)- -- | Unwrapped multiplication- unwrappedMul ∷ w → w → (w, UnsignedWord w)- -- | Number of leading (from MSB) zero bits- leadingZeroes ∷ w → Int- -- | Number or trailing (from LSB) zero bits- trailingZeroes ∷ w → Int- -- | The word with all bits set to 0- allZeroes ∷ w- -- | The word with all bits set to 1- allOnes ∷ w- -- | The word with MSB set to 1 and all the other bits set to 0- msb ∷ w- -- | The word with LSB set to 1 and all the other bits set to 0- lsb ∷ w- -- | Test if the MSB is 1- testMsb ∷ w → Bool- -- | Test if the LSB is 1- testLsb ∷ w → Bool--instance BinaryWord Word8 where- type UnsignedWord Word8 = Word8- type SignedWord Word8 = Int8- unsignedWord = id- {-# INLINE unsignedWord #-}- signedWord = fromIntegral- {-# INLINE signedWord #-}- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where s = fromIntegral x + fromIntegral y ∷ Word16- hi = hiWord s- lo = loWord s- {-# INLINE unwrappedAdd #-}- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where p = fromIntegral x * fromIntegral y ∷ Word16- hi = hiWord p- lo = loWord p- {-# INLINE unwrappedMul #-}- leadingZeroes w | w .&. 0xF0 == 0 = go4 4 w- | otherwise = go4 0 (shiftR w 4)- where go4 off w' | w' .&. 8 /= 0 = off- | w' .&. 4 /= 0 = off + 1- | w' .&. 2 /= 0 = off + 2- | w' .&. 1 /= 0 = off + 3- | otherwise = off + 4- trailingZeroes w | w .&. 0x0F == 0 = go4 4 (shiftR w 4)- | otherwise = go4 0 w- where go4 off w' | w' .&. 1 /= 0 = off- | w' .&. 2 /= 0 = off + 1- | w' .&. 4 /= 0 = off + 2- | w' .&. 8 /= 0 = off + 3- | otherwise = off + 4- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFF- {-# INLINE allOnes #-}- msb = 0x80- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 7- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}--instance BinaryWord Word16 where- type UnsignedWord Word16 = Word16- type SignedWord Word16 = Int16- unsignedWord = id- {-# INLINE unsignedWord #-}- signedWord = fromIntegral- {-# INLINE signedWord #-}- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where s = fromIntegral x + fromIntegral y ∷ Word32- lo = loWord s- hi = hiWord s- {-# INLINE unwrappedAdd #-}- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where p = fromIntegral x * fromIntegral y ∷ Word32- lo = loWord p- hi = hiWord p- {-# INLINE unwrappedMul #-}- leadingZeroes w | w .&. 0xFF00 == 0 = go8 8 w- | otherwise = go8 0 (shiftR w 8)- where- go8 off w' | w' .&. 0xF0 == 0 = go4 (off + 4) w'- | otherwise = go4 off (shiftR w' 4)- go4 off w' | w' .&. 8 /= 0 = off- | w' .&. 4 /= 0 = off + 1- | w' .&. 2 /= 0 = off + 2- | w' .&. 1 /= 0 = off + 3- | otherwise = off + 4- trailingZeroes w | w .&. 0x00FF == 0 = go8 8 (shiftR w 8)- | otherwise = go8 0 w- where- go8 off w' | w' .&. 0x0F == 0 = go4 (off + 4) (shiftR w' 4)- | otherwise = go4 off w'- go4 off w' | w' .&. 1 /= 0 = off- | w' .&. 2 /= 0 = off + 1- | w' .&. 4 /= 0 = off + 2- | w' .&. 8 /= 0 = off + 3- | otherwise = off + 4- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFFFF- {-# INLINE allOnes #-}- msb = 0x8000- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 15- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}--instance BinaryWord Word32 where- type UnsignedWord Word32 = Word32- type SignedWord Word32 = Int32- unsignedWord = id- {-# INLINE unsignedWord #-}- signedWord = fromIntegral- {-# INLINE signedWord #-}-#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 32- unwrappedAdd (W32# x) (W32# y) = hi `seq` lo `seq` (hi, lo)- where (# hi', lo' #) = plusWord2# x y- hi = W32# hi'- lo = W32# lo'-#else- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where s = fromIntegral x + fromIntegral y ∷ Word64- lo = loWord s- hi = hiWord s-#endif- {-# INLINE unwrappedAdd #-}-#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 32- unwrappedMul (W32# x) (W32# y) = hi `seq` lo `seq` (hi, lo)- where (# hi', lo' #) = timesWord2# x y- lo = W32# lo'- hi = W32# hi'-#else- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where p = fromIntegral x * fromIntegral y ∷ Word64- lo = loWord p- hi = hiWord p-#endif- {-# INLINE unwrappedMul #-}- leadingZeroes w | w .&. 0xFFFF0000 == 0 = go16 16 w- | otherwise = go16 0 (shiftR w 16)- where- go16 off w' | w' .&. 0xFF00 == 0 = go8 (off + 8) w'- | otherwise = go8 off (shiftR w' 8)- go8 off w' | w' .&. 0xF0 == 0 = go4 (off + 4) w'- | otherwise = go4 off (shiftR w' 4)- go4 off w' | w' .&. 8 /= 0 = off- | w' .&. 4 /= 0 = off + 1- | w' .&. 2 /= 0 = off + 2- | w' .&. 1 /= 0 = off + 3- | otherwise = off + 4- trailingZeroes w | w .&. 0x0000FFFF == 0 = go16 16 (shiftR w 16)- | otherwise = go16 0 w- where- go16 off w' | w' .&. 0x00FF == 0 = go8 (off + 8) (shiftR w' 8)- | otherwise = go8 off w'- go8 off w' | w' .&. 0x0F == 0 = go4 (off + 4) (shiftR w' 4)- | otherwise = go4 off w'- go4 off w' | w' .&. 1 /= 0 = off- | w' .&. 2 /= 0 = off + 1- | w' .&. 4 /= 0 = off + 2- | w' .&. 8 /= 0 = off + 3- | otherwise = off + 4- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFFFFFFFF- {-# INLINE allOnes #-}- msb = 0x80000000- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 31- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}--instance BinaryWord Word64 where- type UnsignedWord Word64 = Word64- type SignedWord Word64 = Int64- unsignedWord = id- {-# INLINE unsignedWord #-}- signedWord = fromIntegral- {-# INLINE signedWord #-}-#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 64- unwrappedAdd (W64# x) (W64# y) = hi `seq` lo `seq` (hi, lo)- where (# hi', lo' #) = plusWord2# x y- lo = W64# lo'- hi = W64# hi'- {-# INLINE unwrappedAdd #-}-#else- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where lo = x + y- hi = if lo < x then 1 else 0- {-# INLINABLE unwrappedAdd #-}-#endif-#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 64- unwrappedMul (W64# x) (W64# y) = hi `seq` lo `seq` (hi, lo)- where (# hi', lo' #) = timesWord2# x y- lo = W64# lo'- hi = W64# hi'- {-# INLINE unwrappedMul #-}-#else- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where xHi = shiftR x 32- xLo = x .&. 0xFFFFFFFF- yHi = shiftR y 32- yLo = y .&. 0xFFFFFFFF- hi0 = xHi * yHi- lo0 = xLo * yLo- p1 = xHi * yLo- p2 = xLo * yHi- hi = hi0 + fromIntegral uHi1 + fromIntegral uHi2 +- shiftR p1 32 + shiftR p2 32- lo = fromHiAndLo lo' (loWord lo0)- (uHi1, uLo) = unwrappedAdd (loWord p1) (loWord p2)- (uHi2, lo') = unwrappedAdd (hiWord lo0) uLo-#endif-#if WORD_SIZE_IN_BITS == 64- leadingZeroes w | w .&. 0xFFFFFFFF00000000 == 0 = go32 32 w- | otherwise = go32 0 (shiftR w 32)- where- go32 off w' | w' .&. 0xFFFF0000 == 0 = go16 (off + 16) w'- | otherwise = go16 off (shiftR w' 16)- go16 off w' | w' .&. 0xFF00 == 0 = go8 (off + 8) w'- | otherwise = go8 off (shiftR w' 8)- go8 off w' | w' .&. 0xF0 == 0 = go4 (off + 4) w'- | otherwise = go4 off (shiftR w' 4)- go4 off w' | w' .&. 8 /= 0 = off- | w' .&. 4 /= 0 = off + 1- | w' .&. 2 /= 0 = off + 2- | w' .&. 1 /= 0 = off + 3- | otherwise = off + 4- trailingZeroes w | w .&. 0x00000000FFFFFFFF == 0 = go32 32 (shiftR w 32)- | otherwise = go32 0 w- where- go32 off w' | w' .&. 0x0000FFFF == 0 = go16 (off + 16) (shiftR w' 16)- | otherwise = go16 off w'- go16 off w' | w' .&. 0x00FF == 0 = go8 (off + 8) (shiftR w' 8)- | otherwise = go8 off w'- go8 off w' | w' .&. 0x0F == 0 = go4 (off + 4) (shiftR w' 4)- | otherwise = go4 off w'- go4 off w' | w' .&. 1 /= 0 = off- | w' .&. 2 /= 0 = off + 1- | w' .&. 4 /= 0 = off + 2- | w' .&. 8 /= 0 = off + 3- | otherwise = off + 4-#else- leadingZeroes w | hiZeroes == 32 = 32 + leadingZeroes (loWord w)- | otherwise = hiZeroes- where hiZeroes = leadingZeroes (hiWord w)- trailingZeroes w | loZeroes == 32 = 32 + trailingZeroes (hiWord w)- | otherwise = loZeroes- where loZeroes = trailingZeroes (loWord w)-#endif- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFFFFFFFFFFFFFFFF- {-# INLINE allOnes #-}- msb = 0x8000000000000000- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 63- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}--instance BinaryWord Int8 where- type UnsignedWord Int8 = Word8- type SignedWord Int8 = Int8- unsignedWord = fromIntegral- {-# INLINE unsignedWord #-}- signedWord = id- {-# INLINE signedWord #-}- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where s = fromIntegral x + fromIntegral y ∷ Int16- hi = hiWord s- lo = loWord s- {-# INLINE unwrappedAdd #-}- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where p = fromIntegral x * fromIntegral y ∷ Int16- hi = hiWord p- lo = loWord p- {-# INLINE unwrappedMul #-}- leadingZeroes = leadingZeroes . unsignedWord- {-# INLINE leadingZeroes #-}- trailingZeroes = trailingZeroes . unsignedWord- {-# INLINE trailingZeroes #-}- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFF- {-# INLINE allOnes #-}- msb = 0x80- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 7- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}--instance BinaryWord Int16 where- type UnsignedWord Int16 = Word16- type SignedWord Int16 = Int16- unsignedWord = fromIntegral- {-# INLINE unsignedWord #-}- signedWord = id- {-# INLINE signedWord #-}- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where s = fromIntegral x + fromIntegral y ∷ Int32- lo = loWord s- hi = hiWord s- {-# INLINE unwrappedAdd #-}- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where p = fromIntegral x * fromIntegral y ∷ Int32- lo = loWord p- hi = hiWord p- {-# INLINE unwrappedMul #-}- leadingZeroes = leadingZeroes . unsignedWord- {-# INLINE leadingZeroes #-}- trailingZeroes = trailingZeroes . unsignedWord- {-# INLINE trailingZeroes #-}- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFFFF- {-# INLINE allOnes #-}- msb = 0x8000- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 15- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}--instance BinaryWord Int32 where- type UnsignedWord Int32 = Word32- type SignedWord Int32 = Int32- unsignedWord = fromIntegral- {-# INLINE unsignedWord #-}- signedWord = id- {-# INLINE signedWord #-}-#if WORD_SIZE_IN_BITS == 32- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where extX = if x < 0 then maxBound else 0- extY = if y < 0 then maxBound else 0- (hi', lo) = unsignedWord x `unwrappedAdd` unsignedWord y- hi = signedWord $ hi' + extX + extY- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where extX = if x < 0 then negate y else 0- extY = if y < 0 then negate x else 0- (hi', lo) = unsignedWord x `unwrappedMul` unsignedWord y- hi = signedWord hi' + extX + extY-#else- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where s = fromIntegral x + fromIntegral y ∷ Int64- lo = loWord s- hi = hiWord s- {-# INLINE unwrappedAdd #-}- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where p = fromIntegral x * fromIntegral y ∷ Int64- lo = loWord p- hi = hiWord p- {-# INLINE unwrappedMul #-}-#endif- leadingZeroes = leadingZeroes . unsignedWord- {-# INLINE leadingZeroes #-}- trailingZeroes = trailingZeroes . unsignedWord- {-# INLINE trailingZeroes #-}- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFFFFFFFF- {-# INLINE allOnes #-}- msb = 0x80000000- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 31- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}--instance BinaryWord Int64 where- type UnsignedWord Int64 = Word64- type SignedWord Int64 = Int64- unsignedWord = fromIntegral- {-# INLINE unsignedWord #-}- signedWord = id- {-# INLINE signedWord #-}- unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)- where extX = if x < 0 then maxBound else 0- extY = if y < 0 then maxBound else 0- (hi', lo) = unsignedWord x `unwrappedAdd` unsignedWord y- hi = signedWord $ hi' + extX + extY- unwrappedMul x y = hi `seq` lo `seq` (hi, lo)- where extX = if x < 0 then negate y else 0- extY = if y < 0 then negate x else 0- (hi', lo) = unsignedWord x `unwrappedMul` unsignedWord y- hi = signedWord hi' + extX + extY- leadingZeroes = leadingZeroes . unsignedWord- {-# INLINE leadingZeroes #-}- trailingZeroes = trailingZeroes . unsignedWord- {-# INLINE trailingZeroes #-}- allZeroes = 0- {-# INLINE allZeroes #-}- allOnes = 0xFFFFFFFFFFFFFFFF- {-# INLINE allOnes #-}- msb = 0x8000000000000000- {-# INLINE msb #-}- lsb = 1- {-# INLINE lsb #-}- testMsb x = testBit x 63- {-# INLINE testMsb #-}- testLsb x = testBit x 0- {-# INLINE testLsb #-}+import Data.BinaryWord -- | Defines a particular way to split a binary word in halves. class BinaryWord w ⇒ DoubleWord w where
src/Data/DoubleWord/TH.hs view
@@ -11,6 +11,10 @@ import GHC.Arr (Ix(..)) import Data.Ratio ((%)) import Data.Bits (Bits(..))+#if MIN_VERSION_base(4,7,0)+import Data.Bits (FiniteBits(..))+#else+#endif import Data.Word (Word8, Word16, Word32, Word64) import Data.Int (Int8, Int16, Int32, Int64) #if MIN_VERSION_hashable(1,2,0)@@ -20,6 +24,7 @@ #endif import Control.Applicative ((<$>), (<*>)) import Language.Haskell.TH hiding (match)+import Data.BinaryWord (BinaryWord(..)) import Data.DoubleWord.Base -- | Declare signed and unsigned binary word types built from@@ -71,8 +76,8 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $ [ DataD [] tp [] [NormalC cn [(hiS, hiT), (loS, loT)]] ad , inst ''DoubleWord [tp]- [ TySynInstD ''LoWord [tpT] loT- , TySynInstD ''HiWord [tpT] hiT+ [ tySynInst ''LoWord [tpT] loT+ , tySynInst ''HiWord [tpT] hiT , funLo 'loWord (VarE lo) , inline 'loWord , funHi 'hiWord (VarE hi)@@ -863,6 +868,11 @@ [ appV 'bitSize [SigE (VarE 'undefined) hiT] , appV 'bitSize [SigE (VarE 'undefined) loT] ] , inline 'bitSize+#if MIN_VERSION_base(4,7,0)+ {- bitSizeMaybe = Just . bitSize -}+ , fun 'bitSizeMaybe $ appV '(.) [ConE 'Just, VarE 'bitSize]+ , inline 'bitSizeMaybe+#endif {- isSigned _ = SIGNED -} , fun_ 'isSigned $ ConE $ if signed then 'True else 'False , inline 'isSigned@@ -1072,10 +1082,17 @@ , inline 'popCount ] ++ if signed then [inline 'rotateL] else []+#if MIN_VERSION_base(4,7,0)+ , inst ''FiniteBits [tp]+ {- finiteBitSize = bitSize -}+ [ fun 'finiteBitSize $ VarE 'bitSize+ , inline 'finiteBitSize+ ]+#endif , inst ''BinaryWord [tp]- [ TySynInstD ''UnsignedWord [tpT] $+ [ tySynInst ''UnsignedWord [tpT] $ ConT $ if signed then otp else tp- , TySynInstD ''SignedWord [tpT] $+ , tySynInst ''SignedWord [tpT] $ ConT $ if signed then tp else otp {- UNSIGNED:@@ -1294,6 +1311,18 @@ {- testLsb (W _ lo) = testLsb lo -} , funLo 'testLsb $ appVN 'testLsb [lo] , inline 'testLsb+ {- setMsb (W hi lo) = W (setMsb hi) lo -}+ , funHiLo 'setMsb $ appW [appVN 'setMsb [hi], VarE lo]+ , inline 'setMsb+ {- setLsb (W hi lo) = W hi (setLsb lo) -}+ , funHiLo 'setLsb $ appW [VarE hi, appVN 'setLsb [lo]]+ , inline 'setLsb+ {- clearMsb (W hi lo) = W (clearMsb hi) lo -}+ , funHiLo 'clearMsb $ appW [appVN 'clearMsb [hi], VarE lo]+ , inline 'clearMsb+ {- clearLsb (W hi lo) = W hi (clearLsb lo) -}+ , funHiLo 'clearLsb $ appW [VarE hi, appVN 'clearLsb [lo]]+ , inline 'clearLsb ] ] where@@ -1344,6 +1373,12 @@ hi' = mkName "hi'" lo' = mkName "lo'" tpT = ConT tp+ tySynInst n ps t =+#if MIN_VERSION_template_haskell(2,9,0)+ TySynInstD n (TySynEqn ps t)+#else+ TySynInstD n ps t+#endif inst cls params = InstanceD [] (foldl AppT (ConT cls) (ConT <$> params)) fun n e = FunD n [Clause [] (NormalB e) []] fun_ n e = FunD n [Clause [WildP] (NormalB e) []]@@ -1421,7 +1456,11 @@ signedRules ← do insts ← reifyInstances ''SignedWord [t] case insts of+#if MIN_VERSION_template_haskell(2,9,0)+ [TySynInstD _ (TySynEqn _ signT)] → return $+#else [TySynInstD _ _ signT] → return $+#endif [ RuleP ("fromIntegral/" ++ show tp ++ "->" ++ showT signT) [] (VarE 'fromIntegral)@@ -1473,7 +1512,11 @@ _ → do insts ← reifyInstances ''LoWord [t] case insts of+#if MIN_VERSION_template_haskell(2,9,0)+ [TySynInstD _ (TySynEqn _ t')] →+#else [TySynInstD _ _ t'] →+#endif mkRules' rules' t' (appV '(.) [VarE 'loWord, narrowE]) (appV '(.) [VarE 'extendLo, extE])
tests/Tests.hs view
@@ -6,15 +6,12 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -import Test.Framework (RunnerOptions'(..), TestOptions'(..),- defaultMainWithOpts, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck hiding ((.&.))+import Test.Tasty (defaultMain, localOption, testGroup)+import Test.Tasty.QuickCheck hiding ((.&.)) import Data.Bits import Data.Word import Data.Int-import Data.Monoid (mempty) import Data.DoubleWord (BinaryWord(..)) import Types @@ -44,7 +41,9 @@ .|. fromIntegral lh `shiftL` 32 .|. fromIntegral ll -main = defaultMainWithOpts+main = defaultMain+ $ localOption (QuickCheckTests 10000)+ $ testGroup "Tests" [ arbTestGroup "Word8" (0 ∷ Word8) , arbTestGroup "Int8" (0 ∷ Int8) , arbTestGroup "Word16" (0 ∷ Word16)@@ -57,10 +56,6 @@ , isoTestGroup "|Int32|Word32|" (0 ∷ I64) , isoTestGroup "|Word16|Word16|Word32|" (0 ∷ UU64) , isoTestGroup "|Int16|Word16|Word32|" (0 ∷ II64) ]- mempty {- ropt_test_options =- Just (mempty { topt_maximum_generated_tests = Just 10000 })- } arbTestGroup name t = testGroup name