packages feed

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 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