diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,10 @@ +OddWord - Release History + +release-1.0.0.1 - 2012.12.30 + + * Fixed compilation with base-4.6 (GHC 7.6). + * Fixed bug in Read instance and extended test suite. + +release-1.0.0 - 2011.07.21 + + * Initial release. diff --git a/OddWord.cabal b/OddWord.cabal --- a/OddWord.cabal +++ b/OddWord.cabal @@ -1,8 +1,8 @@ name: OddWord -version: 1.0.0 +version: 1.0.0.1 license: BSD3 license-file: LICENSE -copyright: (c) 2011 Robin KAY +copyright: (c) 2011-2012 Robin KAY author: Robin KAY maintainer: Robin KAY synopsis: Provides a wrapper for deriving word types with fewer bits. @@ -10,7 +10,7 @@ stability: Stable cabal-version: >= 1.10 build-type: Simple -extra-source-files: test/*.hs +extra-source-files: test/*.hs NEWS homepage: http://www.gekkou.co.uk/ description: Provdes the 'OddWord' type, which wraps an existing integer type and @@ -23,7 +23,7 @@ default-language: Haskell2010 other-extensions: ScopedTypeVariables build-depends: - base >= 4 && < 5 + base >= 4.5 && < 5 Test-Suite oddword-tests type: exitcode-stdio-1.0 @@ -32,6 +32,10 @@ default-language: Haskell2010 other-extensions: ScopedTypeVariables build-depends: - base >= 4 && < 5, - QuickCheck >= 2.4 && < 2.5, + base >= 4.5 && < 5, + QuickCheck >= 2.4 && < 2.6, OddWord >= 1.0 && < 1.1 + +Source-repository head + type: darcs + location: https://patch-tag.com/r/komadori/OddWord diff --git a/src/Data/Word/Odd.hs b/src/Data/Word/Odd.hs --- a/src/Data/Word/Odd.hs +++ b/src/Data/Word/Odd.hs @@ -62,9 +62,12 @@ pairOW :: (a, a) -> (OddWord a n, OddWord a n) pairOW = uncurry ((,) `on` OW) -owMask :: forall a n. (Bits a, TypeNum n) => OddWord a n +owMask :: forall a n. (Num a, Bits a, TypeNum n) => OddWord a n owMask = OW $ (flip (-) 1) $ bit $ fromTypeNum (typeNum :: TypeNumBuilder n) +maskOW :: forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n +maskOW w = OW $ w .&. unOW (owMask :: OddWord a n) + mapFst :: (a -> b) -> [(a, c)] -> [(b, c)] mapFst f xs = map (\(a,c) -> (f a,c)) xs @@ -73,19 +76,19 @@ show (OW x) = show x showList xs = showList $ map unOW xs -instance (Read a) => Read (OddWord a n) where - readsPrec p s = mapFst OW $ readsPrec p s - readList s = mapFst (map OW) $ readList s +instance (Read a, Num a, Bits a, TypeNum n) => Read (OddWord a n) where + readsPrec p s = mapFst maskOW $ readsPrec p s + readList s = mapFst (map maskOW) $ readList s instance (Num a, Bits a, TypeNum n) => Num (OddWord a n) where - (OW l) + (OW r) = OW $ (l + r) .&. unOW (owMask :: OddWord a n) - (OW l) * (OW r) = OW $ (l * r) .&. unOW (owMask :: OddWord a n) - (OW l) - (OW r) = OW $ (l - r) .&. unOW (owMask :: OddWord a n) - negate (OW x) = OW $ negate x .&. unOW (owMask :: OddWord a n) + (OW l) + (OW r) = maskOW $ (l + r) + (OW l) * (OW r) = maskOW $ (l * r) + (OW l) - (OW r) = maskOW $ (l - r) + negate (OW x) = maskOW $ negate x abs w = w signum (OW x) | x == 0 = 0 | otherwise = 1 - fromInteger i = OW $ fromInteger i .&. unOW (owMask :: OddWord a n) + fromInteger i = maskOW $ fromInteger i instance (Real a, Bits a, TypeNum n) => Real (OddWord a n) where toRational (OW x) = toRational x @@ -117,11 +120,11 @@ divMod (OW n) (OW d) = pairOW $ divMod n d toInteger (OW x) = toInteger x -instance (Bits a, TypeNum n) => Bits (OddWord a n) where +instance (Num a, Bits a, TypeNum n) => Bits (OddWord a n) where (OW l) .&. (OW r) = OW $ l .&. r (OW l) .|. (OW r) = OW $ l .|. r xor (OW l) (OW r) = OW $ xor l r - complement (OW x) = OW $ complement x .&. unOW (owMask :: OddWord a n) + complement (OW x) = maskOW $ complement x bit n | n < fromTypeNum (typeNum :: TypeNumBuilder n) = OW $ bit n | otherwise = OW 0 @@ -135,7 +138,7 @@ testBit (OW x) n = testBit x n bitSize _ = fromTypeNum (typeNum :: TypeNumBuilder n) isSigned _ = False - shiftL (OW x) n = OW $ shiftL x n .&. unOW (owMask :: OddWord a n) + shiftL (OW x) n = maskOW $ shiftL x n shiftR (OW x) n = OW $ shiftR x n rotateL (OW x) n = OW $ (shiftL x n' .&. unOW (owMask :: OddWord a n)) .|. shiftR x (w-n') @@ -145,6 +148,7 @@ shiftR x n' .|. (shiftL x (w-n') .&. unOW (owMask :: OddWord a n)) where n' = n `mod` w w = fromTypeNum (typeNum :: TypeNumBuilder n) + popCount (OW x) = popCount x type Word1 = OddWord Word8 (One ()) type Word2 = OddWord Word8 (One (Zero ())) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -14,10 +14,10 @@ Add Integer | Mul Integer | Sub Integer | SubR Integer | Div Integer | Mod Integer | Quot Integer | Rem Integer | DivR Integer | ModR Integer | QuotR Integer | RemR Integer | - Neg | Abs | Inv | + Neg | Abs | Inv | AddDigit | And Integer | Or Integer | Xor Integer | ClrB Int | SetB Int | InvB Int | - Shift Int | Rot Int + Shift Int | Rot Int | PopCnt deriving Show instance Arbitrary (UFunc) where @@ -37,6 +37,7 @@ return Neg, return Abs, return Inv, + return AddDigit, choose (0, 0xffff) >>= return . And, choose (0, 0xffff) >>= return . Or, choose (0, 0xffff) >>= return . Xor, @@ -44,7 +45,8 @@ choose (0, 32) >>= return . SetB, choose (0, 32) >>= return . InvB, choose (-32, 32) >>= return . Shift, - choose (-32, 32) >>= return . Rot] + choose (-32, 32) >>= return . Rot, + return PopCnt] safeDiv :: (Integral a, Bounded a) => a -> a -> a safeDiv d 0 = maxBound @@ -62,7 +64,7 @@ safeRem d 0 = 0 safeRem d n = rem d n -fromUFunc :: (Integral a, Bounded a, Bits a) => UFunc -> a -> a +fromUFunc :: (Integral a, Bounded a, Bits a, Read a, Show a) => UFunc -> a -> a fromUFunc (Add i) x = x + (fromInteger i) fromUFunc (Mul i) x = x * (fromInteger i) fromUFunc (Sub i) x = x - (fromInteger i) @@ -78,6 +80,7 @@ fromUFunc Neg x = negate x fromUFunc Abs x = abs x fromUFunc Inv x = complement x +fromUFunc AddDigit x = read . ('1':) $ show x fromUFunc (And i) x = x .&. (fromInteger i) fromUFunc (Or i) x = x .|. (fromInteger i) fromUFunc (Xor i) x = xor x (fromInteger i) @@ -86,6 +89,7 @@ fromUFunc (InvB n) x = complementBit x n fromUFunc (Shift n) x = shift x n fromUFunc (Rot n) x = rotate x n +fromUFunc PopCnt x = fromIntegral $ popCount x type TestWord16 = OddWord Word32 (One (Zero (Zero (Zero (Zero ())))))