OddWord 1.0.0.2 → 1.0.1.0

raw patch · 7 files changed

+253/−76 lines, 7 filesdep ~QuickCheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• NEWS +9/−0
• OddWord.cabal +26/−6
• src/Data/Word/Odd.hs +75/−11
• src/Data/Word/Odd/TypeLits.hs +9/−0
• test/Main.hs +108/−58
• test/TypeLitsTest.hs +25/−0

@@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2011, Robin KAY. All rights reserved.+Copyright 2011-2015, Robin KAY. All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -1,5 +1,14 @@ OddWord - Release History +release-1.0.1.0 - 2015.10.25++  * Added optional support for GHC type-level literals.+  * Added FiniteBits instance.+  * Added more test coverage.+  * Fixed bug in toEnum function and extended test suite. (Thanks to Pasqualino     "Titto" Assini)+  * Fixed warnings when compiling test suite with base-4.7 (GHC 7.8).+  * Relaxed QuickCheck version constraint.+ release-1.0.0.2 - 2013.05.14    * Fixed misdefinition of type synonyms for Word10, Word12, and Word14,

@@ -1,8 +1,8 @@ name:               OddWord-version:            1.0.0.2+version:            1.0.1.0 license:            BSD3 license-file:       LICENSE-copyright:          (c) 2011-2013 Robin KAY+copyright:          (c) 2011-2015 Robin KAY author:             Robin KAY maintainer:         Robin KAY <komadori@gekkou.co.uk> synopsis:           Provides a wrapper for deriving word types with fewer bits.@@ -17,25 +17,45 @@     exposes a subset of its bits as a new narrower word type. Includes     predefined type synonyms for all the odd sized words up to 63 bits. +Flag TypeLitsSupport+    description: Enable support for GHC type-level naturals.+    default: True+ Library     hs-source-dirs:   src     exposed-modules:  Data.Word.Odd     default-language: Haskell2010-    other-extensions: ScopedTypeVariables+    other-extensions: ScopedTypeVariables CPP     build-depends:         base >= 4.5 && < 5+    if flag(TypeLitsSupport) && impl(ghc >= 7.8)+        cpp-options: -DTYPE_LITS+        other-modules: Data.Word.Odd.TypeLits  Test-Suite oddword-tests     type:             exitcode-stdio-1.0     hs-source-dirs:   test     main-is:          Main.hs     default-language: Haskell2010-    other-extensions: ScopedTypeVariables+    other-extensions: ScopedTypeVariables CPP     build-depends:         base       >= 4.5 && < 5,-        QuickCheck >= 2.4 && < 2.7,+        QuickCheck >= 2.4 && < 2.9,         OddWord    >= 1.0 && < 1.1 +Test-Suite oddword-tests-typelits+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          TypeLitsTest.hs+    default-language: Haskell2010+    if flag(TypeLitsSupport) && impl(ghc >= 7.8)+        buildable: True+        build-depends:+            base       >= 4.5 && < 5,+            OddWord    >= 1.0 && < 1.1+    else+        buildable: False+ Source-repository head     type:     darcs-    location: https://patch-tag.com/r/komadori/OddWord+    location: http://hub.darcs.net/komadori/OddWord

@@ -1,4 +1,4 @@-{-# LANGUAGE Haskell2010, ScopedTypeVariables #-}+{-# LANGUAGE Haskell2010, ScopedTypeVariables, CPP #-}  module Data.Word.Odd (     -- * Odd Word Wrapper@@ -8,6 +8,9 @@     TypeNum,     One,     Zero,+#ifdef TYPE_LITS+    Lit,+#endif      -- * Predefined Odd Words     Word1, Word2, Word3, Word4, Word5, Word6, Word7,@@ -24,11 +27,37 @@ import Data.Word import Data.Function --- | OddWord wraps the integer type specified in the first type parameter and--- exposes a subset of the available bits as an unsigned word. The number of--- bits to expose is encoded into the second type parameter.+#ifdef TYPE_LITS+import Data.Word.Odd.TypeLits+import Data.Proxy+import GHC.TypeLits+#endif++-- | 'OddWord' provides a range of unsigned integer word types with a length in+-- bits encoded at the type level. The first type parameter @a@ must supply an+-- integer type which can hold at least as many bits as required for the+-- 'OddWord'. The second type paramter @n@ then encodes the length in bits+-- which the 'OddWord' will be restricted to. ----- The predefined word types provided by this module give some examples.+-- The length of the 'OddWord' can be encoded as a string of binary digits+-- using the 'One', 'Zero', and @()@ type constructors. The outermost+-- constructor specifies the most significant digit and each subsequent digit+-- is nested inside the previous type constructor via its type parameter. Hence,+-- the encoding is terminated by the @()@ type constructor. For example, the+-- number 4 would be expressed as: @One (Zero (Zero ()))@.+--+-- Alternatively, if the compiler supports type-level naturals then these can+-- be used via the 'Lit' type constructor. For example, the number 4 can be+-- expressed as: @Lit 4@.+--+-- To supply a complete example, a 4-bit integer type could be built from a+-- 'Word8' and specified as either @OddWord Word8 (One (Zero (Zero ())))@ or+-- @OddWord Word8 (Lit 4)@.+--+-- The behaviour of an 'OddWord' is undefined if the specified length is+-- greater than that of the underlying integer type. The behaviour is also+-- undefined if the specified length is equal to that of the underlying integer+-- type and that type is also signed. newtype OddWord a n = OW {unOW :: a} deriving (Eq, Ord)  data TypeNumBuilder a = TypeNumBuilder Int Int@@ -41,11 +70,11 @@     typeNum :: TypeNumBuilder a  -- | Represents a type-level number with a leading one bit followed by the--- string of digits specified by a.+-- string of digits specified by @a@. data One a  -- | Represents a type-level number with a placeholder zero bit followed by the--- string of digits specified by a.+-- string of digits specified by @a@. data Zero a  instance TypeNum () where@@ -59,18 +88,35 @@     typeNum = let (TypeNumBuilder n m) = (typeNum :: TypeNumBuilder a)               in TypeNumBuilder (n) (m+1) +#ifdef TYPE_LITS+instance (KnownNat a) => TypeNum (Lit a) where+    typeNum = TypeNumBuilder (fromIntegral $ natVal (Proxy :: Proxy a)) 0+#endif++-- | Wraps both parts of a homogenous pair with the OddWord constructor. pairOW :: (a, a) -> (OddWord a n, OddWord a n) pairOW = uncurry ((,) `on` OW) +-- | An OddWord with all the bits set, used for masking. owMask :: forall a n. (Num a, Bits a, TypeNum n) => OddWord a n-owMask = OW $ (flip (-) 1) $ bit $ fromTypeNum (typeNum :: TypeNumBuilder n)+owMask = OW . (flip (-) 1) . bit $ fromTypeNum (typeNum :: TypeNumBuilder n) +-- | Smart constructor for OddWords which masks off the unused upper bits. maskOW :: forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n maskOW w = OW $ w .&. unOW (owMask :: OddWord a n) +-- | Applies a function to the first component of each pair in a list thereof. mapFst :: (a -> b) -> [(a, c)] -> [(b, c)] mapFst f xs = map (\(a,c) -> (f a,c)) xs +--+-- Instances for the OddWord type+--+-- The instances largely forward operations to the underlying integer type+-- while wrapping and unwrapping the newtype, and masking or otherwise+-- adjusting the results as appropriate for the desired bit length of the word.+--+ instance (Show a) => Show (OddWord a n) where     showsPrec p (OW x) s = showsPrec p x s     show (OW x)          = show x@@ -100,9 +146,9 @@ instance (Enum a, Ord a, Num a, Bits a, TypeNum n) => Enum (OddWord a n) where     succ x = x + 1     pred x = x - 1-    toEnum i | i >= 0 && fromIntegral i <= (owMask :: OddWord a n)+    toEnum i | i >= 0 && fromIntegral i <= unOW (owMask :: OddWord a n)              = OW $ toEnum i-             | otherwise = error "OddWord: toEnum: Out of range."+             | otherwise = error "OddWord: toEnum: Index out of bounds."     fromEnum (OW x) = fromEnum x     enumFrom x = enumFromTo x owMask     enumFromThen x1 x2 = enumFromThenTo x1 x2 bound@@ -136,7 +182,10 @@                            = OW $ complementBit x n                            | otherwise = OW x     testBit (OW x) n = testBit x n-    bitSize _  = fromTypeNum (typeNum :: TypeNumBuilder n)+    bitSize _ = fromTypeNum (typeNum :: TypeNumBuilder n)+#if MIN_VERSION_base(4,7,0)+    bitSizeMaybe _ = Just $ fromTypeNum (typeNum :: TypeNumBuilder n)+#endif     isSigned _ = False      shiftL (OW x) n = maskOW $ shiftL x n     shiftR (OW x) n = OW $ shiftR x n@@ -149,6 +198,21 @@         where n' = n `mod` w               w  = fromTypeNum (typeNum :: TypeNumBuilder n)     popCount (OW x) = popCount x++#if MIN_VERSION_base(4,7,0)+instance (Num a, FiniteBits a, TypeNum n) => FiniteBits (OddWord a n) where+    finiteBitSize _ = fromTypeNum (typeNum :: TypeNumBuilder n) +#if MIN_VERSION_base(4,8,0)+    countLeadingZeros (OW x) = countLeadingZeros x ++        fromTypeNum (typeNum :: TypeNumBuilder n) - finiteBitSize x+    countTrailingZeros (OW x) = min (countTrailingZeros x) $+        fromTypeNum (typeNum :: TypeNumBuilder n)+#endif+#endif++--+-- Predefined Odd Words+--  type Word1  = OddWord Word8             (One  ()) type Word2  = OddWord Word8        (One (Zero ()))

@@ -0,0 +1,9 @@+{-# LANGUAGE Haskell2010, DataKinds, KindSignatures #-}++module Data.Word.Odd.TypeLits where++import GHC.TypeLits++-- | Converts a native GHC type-level natural into one usable by this library.+-- This requires GHC 7.8 or later and the @DataKinds@ extension.+data Lit :: Nat -> *

@@ -1,70 +1,103 @@-{-# LANGUAGE Haskell2010, ScopedTypeVariables #-}+{-# LANGUAGE Haskell2010, ScopedTypeVariables, CPP #-}  module Main where +import Prelude hiding (catch) import System.Exit import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Gen import Data.Bits+import Data.Maybe import Data.Word import Data.Word.Odd-import Control.Monad+import Control.Applicative+import Control.Exception+import System.IO.Unsafe -data UFunc =-    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           | AddDigit      |-    And   Integer | Or    Integer | Xor   Integer |-    ClrB  Int     | SetB  Int     | InvB  Int     |-    Shift Int     | Rot   Int     | PopCnt+-- | Represents a range of unary functions which can be applied to a word.+data UFunc+    = 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           | AddDigit+    | From  Integer | And   Integer | Or    Integer | Xor   Integer+    | TstB  Int     | ClrB  Int     | SetB  Int     | InvB  Int+    | FromB Int     | Shift Int     | Rot   Int     | PopCnt+#if MIN_VERSION_base(4,8,0)+    | CntLZ         | CntTZ+#endif+    | AdjEnum Int Integer     deriving Show  instance Arbitrary (UFunc) where-    arbitrary = oneof [-        choose (0, 0xffff) >>= return . Add,-        choose (0, 0xffff) >>= return . Mul,-        choose (0, 0xffff) >>= return . Sub,-        choose (0, 0xffff) >>= return . SubR,-        choose (0, 0xffff) >>= return . Div,-        choose (0, 0xffff) >>= return . Mod,-        choose (0, 0xffff) >>= return . Quot,-        choose (0, 0xffff) >>= return . Rem,-        choose (0, 0xffff) >>= return . DivR,-        choose (0, 0xffff) >>= return . ModR,-        choose (0, 0xffff) >>= return . QuotR,-        choose (0, 0xffff) >>= return . RemR,-        return Neg,-        return Abs,-        return Inv,-        return AddDigit,-        choose (0, 0xffff) >>= return . And,-        choose (0, 0xffff) >>= return . Or,-        choose (0, 0xffff) >>= return . Xor,-        choose (0, 32) >>= return . ClrB,-        choose (0, 32) >>= return . SetB,-        choose (0, 32) >>= return . InvB,-        choose (-32, 32) >>= return . Shift,-        choose (-32, 32) >>= return . Rot,-        return PopCnt]+    arbitrary = oneof+        [Add   <$> choose (0, 0xffff)+        ,Mul   <$> choose (0, 0xffff)+        ,Sub   <$> choose (0, 0xffff)+        ,SubR  <$> choose (0, 0xffff)+        ,Div   <$> choose (0, 0xffff)+        ,Mod   <$> choose (0, 0xffff)+        ,Quot  <$> choose (0, 0xffff)+        ,Rem   <$> choose (0, 0xffff)+        ,DivR  <$> choose (0, 0xffff)+        ,ModR  <$> choose (0, 0xffff)+        ,QuotR <$> choose (0, 0xffff)+        ,RemR  <$> choose (0, 0xffff)+        ,return Neg+        ,return Abs+        ,return Inv+        ,return AddDigit+        ,From  <$> arbitrary+        ,And   <$> choose (0, 0xffff)+        ,Or    <$> choose (0, 0xffff)+        ,Xor   <$> choose (0, 0xffff)+        ,TstB  <$> choose (-32, 32)+        ,ClrB  <$> choose (-32, 32)+        ,SetB  <$> choose (-32, 32)+        ,InvB  <$> choose (-32, 32)+        ,FromB <$> choose (-32, 32)+        ,Shift <$> choose (-32, 32)+        ,Rot   <$> choose (-32, 32)+        ,return PopCnt+#if MIN_VERSION_base(4,8,0)+        ,return CntLZ+        ,return CntTZ+#endif+        ,AdjEnum <$> choose (-0x1ffff, 0x1ffff) <*> choose (0, 0xffff)+        ] +-- | Total wrapper for 'div'. safeDiv :: (Integral a, Bounded a) => a -> a -> a safeDiv d 0 = maxBound safeDiv d n = div d n +-- | Total wrapper for 'mod'. safeMod :: (Integral a) => a -> a -> a safeMod d 0 = 0 safeMod d n = mod d n +-- | Total wrapper for 'quot'. safeQuot :: (Integral a, Bounded a) => a -> a -> a safeQuot d 0 = maxBound safeQuot d n = quot d n +-- | Total wrapper for 'rem'. safeRem :: (Integral a) => a -> a -> a safeRem d 0 = 0 safeRem d n = rem d n -fromUFunc :: (Integral a, Bounded a, Bits a, Read a, Show a) => UFunc -> a -> a+-- | Total wrapper for 'toEnum'.+safeToEnum :: (Enum a) => a -> Int -> a+safeToEnum def x =+    unsafePerformIO (evaluate (toEnum x) `catch` \(ErrorCall _) -> return def)++-- | Interpreter for executing 'UFunc' values.+#if MIN_VERSION_base(4,7,0)+fromUFunc :: (Integral a, Bounded a, Enum a, FiniteBits a, Read a, Show a) =>+#else+fromUFunc :: (Integral a, Bounded a, Enum a, Bits a, Read a, Show a) =>+#endif+    UFunc -> a -> a fromUFunc (Add   i) x = x + (fromInteger i) fromUFunc (Mul   i) x = x * (fromInteger i) fromUFunc (Sub   i) x = x - (fromInteger i)@@ -80,48 +113,65 @@ fromUFunc  Neg      x = negate x fromUFunc  Abs      x = abs x fromUFunc  Inv      x = complement x+fromUFunc (From i)  _ = fromInteger i 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)+fromUFunc (TstB  n) x = fromIntegral $ fromEnum $ testBit x n fromUFunc (ClrB  n) x = clearBit x n fromUFunc (SetB  n) x = setBit x n fromUFunc (InvB  n) x = complementBit x n+fromUFunc (FromB n) _ = bit n fromUFunc (Shift n) x = shift x n fromUFunc (Rot   n) x = rotate x n fromUFunc  PopCnt   x = fromIntegral $ popCount x+#if MIN_VERSION_base(4,8,0)+fromUFunc  CntLZ    x = fromIntegral $ countLeadingZeros x+fromUFunc  CntTZ    x = fromIntegral $ countTrailingZeros x+#endif+fromUFunc (AdjEnum i def) x = safeToEnum (fromIntegral def) . (+i) $ fromEnum x +-- | A 16-bit word underlied by a 32-bit word. type TestWord16 = OddWord Word32 (One (Zero (Zero (Zero (Zero ()))))) +-- | Checks that computations using real and simulated 16-bit words produce+-- the same result for a series of 'UFunc's. verifyTestWord16 :: [UFunc] -> Bool verifyTestWord16 us =     let refFn = foldr (.) id $ map fromUFunc us :: Word16 -> Word16         tstFn = foldr (.) id $ map fromUFunc us :: TestWord16 -> TestWord16     in toInteger (refFn 0) == toInteger (tstFn 0) +-- | List of bit lengths for all words up to 63-bits. preDefWordLengths :: [Int] preDefWordLengths = [-    bitSize (0 :: Word1), bitSize (0 :: Word2), bitSize (0 :: Word3),-    bitSize (0 :: Word4), bitSize (0 :: Word5), bitSize (0 :: Word6),-    bitSize (0 :: Word7), bitSize (0 :: Word8), bitSize (0 :: Word9),-    bitSize (0 :: Word10), bitSize (0 :: Word11), bitSize (0 :: Word12),-    bitSize (0 :: Word13), bitSize (0 :: Word14), bitSize (0 :: Word15),-    bitSize (0 :: Word16), bitSize (0 :: Word17), bitSize (0 :: Word18),-    bitSize (0 :: Word19), bitSize (0 :: Word20), bitSize (0 :: Word21),-    bitSize (0 :: Word22), bitSize (0 :: Word23), bitSize (0 :: Word24),-    bitSize (0 :: Word25), bitSize (0 :: Word26), bitSize (0 :: Word27),-    bitSize (0 :: Word28), bitSize (0 :: Word29), bitSize (0 :: Word30),-    bitSize (0 :: Word31), bitSize (0 :: Word32), bitSize (0 :: Word33),-    bitSize (0 :: Word34), bitSize (0 :: Word35), bitSize (0 :: Word36),-    bitSize (0 :: Word37), bitSize (0 :: Word38), bitSize (0 :: Word39),-    bitSize (0 :: Word40), bitSize (0 :: Word41), bitSize (0 :: Word42),-    bitSize (0 :: Word43), bitSize (0 :: Word44), bitSize (0 :: Word45),-    bitSize (0 :: Word46), bitSize (0 :: Word47), bitSize (0 :: Word48),-    bitSize (0 :: Word49), bitSize (0 :: Word50), bitSize (0 :: Word51),-    bitSize (0 :: Word52), bitSize (0 :: Word53), bitSize (0 :: Word54),-    bitSize (0 :: Word55), bitSize (0 :: Word56), bitSize (0 :: Word57),-    bitSize (0 :: Word58), bitSize (0 :: Word59), bitSize (0 :: Word60),-    bitSize (0 :: Word61), bitSize (0 :: Word62), bitSize (0 :: Word63)]+    bits (0 :: Word1), bits (0 :: Word2), bits (0 :: Word3),+    bits (0 :: Word4), bits (0 :: Word5), bits (0 :: Word6),+    bits (0 :: Word7), bits (0 :: Word8), bits (0 :: Word9),+    bits (0 :: Word10), bits (0 :: Word11), bits (0 :: Word12),+    bits (0 :: Word13), bits (0 :: Word14), bits (0 :: Word15),+    bits (0 :: Word16), bits (0 :: Word17), bits (0 :: Word18),+    bits (0 :: Word19), bits (0 :: Word20), bits (0 :: Word21),+    bits (0 :: Word22), bits (0 :: Word23), bits (0 :: Word24),+    bits (0 :: Word25), bits (0 :: Word26), bits (0 :: Word27),+    bits (0 :: Word28), bits (0 :: Word29), bits (0 :: Word30),+    bits (0 :: Word31), bits (0 :: Word32), bits (0 :: Word33),+    bits (0 :: Word34), bits (0 :: Word35), bits (0 :: Word36),+    bits (0 :: Word37), bits (0 :: Word38), bits (0 :: Word39),+    bits (0 :: Word40), bits (0 :: Word41), bits (0 :: Word42),+    bits (0 :: Word43), bits (0 :: Word44), bits (0 :: Word45),+    bits (0 :: Word46), bits (0 :: Word47), bits (0 :: Word48),+    bits (0 :: Word49), bits (0 :: Word50), bits (0 :: Word51),+    bits (0 :: Word52), bits (0 :: Word53), bits (0 :: Word54),+    bits (0 :: Word55), bits (0 :: Word56), bits (0 :: Word57),+    bits (0 :: Word58), bits (0 :: Word59), bits (0 :: Word60),+    bits (0 :: Word61), bits (0 :: Word62), bits (0 :: Word63)]+#if MIN_VERSION_base(4,8,0)+    where bits n = fromMaybe 0 $ bitSizeMaybe n+#else+    where bits n = bitSize n+#endif  main :: IO () main = do

@@ -0,0 +1,25 @@+{-# LANGUAGE Haskell2010, ScopedTypeVariables, DataKinds #-}++module Main where++import System.Exit+import Data.Bits+import Data.Word+import Data.Word.Odd+import GHC.TypeLits++typeLitWordLengths :: [Int]+typeLitWordLengths = [+    finiteBitSize (0 :: OddWord Word8 (Lit 1)),+    finiteBitSize (0 :: OddWord Word8 (Lit 2)),+    finiteBitSize (0 :: OddWord Word8 (Lit 3)),+    finiteBitSize (0 :: OddWord Word8 (Lit 4))]++main :: IO ()+main = do+    -- Verify lengths of odd words defined using GHC type-level literals+    mapM_ (\(u,v) -> putStrLn (+        showString "Error: Word" . shows u . showString " has length " $+            shows v ".") >> exitFailure) $+        map fst $ filter snd $ map (\t -> (t,uncurry (/=) t)) $+        zip [1..] typeLitWordLengths