OddWord (empty) → 1.0.0
raw patch · 5 files changed
+378/−0 lines, 5 filesdep +OddWorddep +QuickCheckdep +basesetup-changed
Dependencies added: OddWord, QuickCheck, base
Files
- LICENSE +25/−0
- OddWord.cabal +37/−0
- Setup.hs +2/−0
- src/Data/Word/Odd.hs +211/−0
- test/Main.hs +103/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2011, 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:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ OddWord.cabal view
@@ -0,0 +1,37 @@+name: OddWord+version: 1.0.0+license: BSD3+license-file: LICENSE+copyright: (c) 2011 Robin KAY+author: Robin KAY+maintainer: Robin KAY <komadori@gekkou.co.uk>+synopsis: Provides a wrapper for deriving word types with fewer bits.+category: Data+stability: Stable+cabal-version: >= 1.10+build-type: Simple+extra-source-files: test/*.hs+homepage: http://www.gekkou.co.uk/+description:+ Provdes the 'OddWord' type, which wraps an existing integer type and+ 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.++Library+ hs-source-dirs: src+ exposed-modules: Data.Word.Odd+ default-language: Haskell2010+ other-extensions: ScopedTypeVariables+ build-depends:+ base >= 4 && < 5++Test-Suite oddword-tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ default-language: Haskell2010+ other-extensions: ScopedTypeVariables+ build-depends:+ base >= 4 && < 5,+ QuickCheck >= 2.4 && < 2.5,+ OddWord >= 1.0 && < 1.1
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Word/Odd.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE Haskell2010, ScopedTypeVariables #-}++module Data.Word.Odd (+ -- * Odd Word Wrapper+ OddWord,++ -- * Type Numbers+ TypeNum,+ One,+ Zero,++ -- * Predefined Odd Words+ Word1, Word2, Word3, Word4, Word5, Word6, Word7,+ Word9, Word10, Word11, Word12, Word13, Word14, Word15,+ Word17, Word18, Word19, Word20, Word21, Word22, Word23, Word24,+ Word25, Word26, Word27, Word28, Word29, Word30, Word31,+ Word33, Word34, Word35, Word36, Word37, Word38, Word39, Word40,+ Word41, Word42, Word43, Word44, Word45, Word46, Word47, Word48,+ Word49, Word50, Word51, Word52, Word53, Word54, Word55, Word56,+ Word57, Word58, Word59, Word60, Word61, Word62, Word63+) where++import Data.Bits+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.+--+-- The predefined word types provided by this module give some examples.+newtype OddWord a n = OW {unOW :: a} deriving (Eq, Ord)++data TypeNumBuilder a = TypeNumBuilder Int Int++fromTypeNum :: TypeNumBuilder a -> Int+fromTypeNum (TypeNumBuilder x _) = x++-- | Intances of 'TypeNum' represent type-level numbers.+class TypeNum a where+ typeNum :: TypeNumBuilder a++-- | Represents a type-level number with a leading one bit followed by the+-- 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.+data Zero a++instance TypeNum () where+ typeNum = TypeNumBuilder 0 0++instance (TypeNum a) => TypeNum (One a) where+ typeNum = let (TypeNumBuilder n m) = (typeNum :: TypeNumBuilder a)+ in TypeNumBuilder (n+bit m) (m+1)++instance (TypeNum a) => TypeNum (Zero a) where+ typeNum = let (TypeNumBuilder n m) = (typeNum :: TypeNumBuilder a)+ in TypeNumBuilder (n) (m+1)++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 = OW $ (flip (-) 1) $ bit $ fromTypeNum (typeNum :: TypeNumBuilder n)++mapFst :: (a -> b) -> [(a, c)] -> [(b, c)]+mapFst f xs = map (\(a,c) -> (f a,c)) xs++instance (Show a) => Show (OddWord a n) where+ showsPrec p (OW x) s = showsPrec p x s+ 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 (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)+ abs w = w+ signum (OW x) | x == 0 = 0+ | otherwise = 1+ fromInteger i = OW $ fromInteger i .&. unOW (owMask :: OddWord a n) ++instance (Real a, Bits a, TypeNum n) => Real (OddWord a n) where+ toRational (OW x) = toRational x++instance (Num a, Bits a, TypeNum n) => Bounded (OddWord a n) where+ minBound = 0+ maxBound = owMask++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)+ = OW $ toEnum i+ | otherwise = error "OddWord: toEnum: Out of range."+ fromEnum (OW x) = fromEnum x+ enumFrom x = enumFromTo x owMask+ enumFromThen x1 x2 = enumFromThenTo x1 x2 bound+ where bound | x2 >= x1 = owMask+ | otherwise = 0+ enumFromTo (OW x) (OW y) = map OW $ enumFromTo x y+ enumFromThenTo (OW x1) (OW x2) (OW y) = map OW $ enumFromThenTo x1 x2 y++instance (Integral a, Bits a, TypeNum n) => Integral (OddWord a n) where+ quot (OW n) (OW d) = OW $ quot n d+ rem (OW n) (OW d) = OW $ rem n d+ div (OW n) (OW d) = OW $ div n d+ mod (OW n) (OW d) = OW $ mod n d+ quotRem (OW n) (OW d) = pairOW $ quotRem n d+ divMod (OW n) (OW d) = pairOW $ divMod n d+ toInteger (OW x) = toInteger x++instance (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)+ bit n | n < fromTypeNum (typeNum :: TypeNumBuilder n)+ = OW $ bit n+ | otherwise = OW 0+ setBit (OW x) n | n < fromTypeNum (typeNum :: TypeNumBuilder n)+ = OW $ setBit x n+ | otherwise = OW x+ clearBit (OW x) n = OW $ clearBit x n+ complementBit (OW x) n | n < fromTypeNum (typeNum :: TypeNumBuilder n)+ = OW $ complementBit x n+ | otherwise = OW x+ 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)+ 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')+ where n' = n `mod` w+ w = fromTypeNum (typeNum :: TypeNumBuilder n)+ rotateR (OW x) n = OW $+ shiftR x n' .|. (shiftL x (w-n') .&. unOW (owMask :: OddWord a n))+ where n' = n `mod` w+ w = fromTypeNum (typeNum :: TypeNumBuilder n)++type Word1 = OddWord Word8 (One ())+type Word2 = OddWord Word8 (One (Zero ()))+type Word3 = OddWord Word8 (One (One ()))+type Word4 = OddWord Word8 (One (Zero (Zero ())))+type Word5 = OddWord Word8 (One (Zero (One ())))+type Word6 = OddWord Word8 (One (One (Zero ())))+type Word7 = OddWord Word8 (One (One (One ())))+--type Word8+type Word9 = OddWord Word16 (One (Zero (Zero (One ()))))+type Word10 = OddWord Word16 (One (Zero (Zero (Zero ()))))+type Word11 = OddWord Word16 (One (Zero (One (One ()))))+type Word12 = OddWord Word16 (One (Zero (One (Zero ()))))+type Word13 = OddWord Word16 (One (One (Zero (One ()))))+type Word14 = OddWord Word16 (One (One (Zero (Zero ()))))+type Word15 = OddWord Word16 (One (One (One (One ()))))+--type Word16+type Word17 = OddWord Word32 (One (Zero (Zero (Zero (One ())))))+type Word18 = OddWord Word32 (One (Zero (Zero (One (Zero ())))))+type Word19 = OddWord Word32 (One (Zero (Zero (One (One ())))))+type Word20 = OddWord Word32 (One (Zero (One (Zero (Zero ())))))+type Word21 = OddWord Word32 (One (Zero (One (Zero (One ())))))+type Word22 = OddWord Word32 (One (Zero (One (One (Zero ())))))+type Word23 = OddWord Word32 (One (Zero (One (One (One ())))))+type Word24 = OddWord Word32 (One (One (Zero (Zero (Zero ())))))+type Word25 = OddWord Word32 (One (One (Zero (Zero (One ())))))+type Word26 = OddWord Word32 (One (One (Zero (One (Zero ())))))+type Word27 = OddWord Word32 (One (One (Zero (One (One ())))))+type Word28 = OddWord Word32 (One (One (One (Zero (Zero ())))))+type Word29 = OddWord Word32 (One (One (One (Zero (One ())))))+type Word30 = OddWord Word32 (One (One (One (One (Zero ())))))+type Word31 = OddWord Word32 (One (One (One (One (One ())))))+--type Word32+type Word33 = OddWord Word64 (One (Zero (Zero (Zero (Zero (One ()))))))+type Word34 = OddWord Word64 (One (Zero (Zero (Zero (One (Zero ()))))))+type Word35 = OddWord Word64 (One (Zero (Zero (Zero (One (One ()))))))+type Word36 = OddWord Word64 (One (Zero (Zero (One (Zero (Zero ()))))))+type Word37 = OddWord Word64 (One (Zero (Zero (One (Zero (One ()))))))+type Word38 = OddWord Word64 (One (Zero (Zero (One (One (Zero ()))))))+type Word39 = OddWord Word64 (One (Zero (Zero (One (One (One ()))))))+type Word40 = OddWord Word64 (One (Zero (One (Zero (Zero (Zero ()))))))+type Word41 = OddWord Word64 (One (Zero (One (Zero (Zero (One ()))))))+type Word42 = OddWord Word64 (One (Zero (One (Zero (One (Zero ()))))))+type Word43 = OddWord Word64 (One (Zero (One (Zero (One (One ()))))))+type Word44 = OddWord Word64 (One (Zero (One (One (Zero (Zero ()))))))+type Word45 = OddWord Word64 (One (Zero (One (One (Zero (One ()))))))+type Word46 = OddWord Word64 (One (Zero (One (One (One (Zero ()))))))+type Word47 = OddWord Word64 (One (Zero (One (One (One (One ()))))))+type Word48 = OddWord Word64 (One (One (Zero (Zero (Zero (Zero ()))))))+type Word49 = OddWord Word64 (One (One (Zero (Zero (Zero (One ()))))))+type Word50 = OddWord Word64 (One (One (Zero (Zero (One (Zero ()))))))+type Word51 = OddWord Word64 (One (One (Zero (Zero (One (One ()))))))+type Word52 = OddWord Word64 (One (One (Zero (One (Zero (Zero ()))))))+type Word53 = OddWord Word64 (One (One (Zero (One (Zero (One ()))))))+type Word54 = OddWord Word64 (One (One (Zero (One (One (Zero ()))))))+type Word55 = OddWord Word64 (One (One (Zero (One (One (One ()))))))+type Word56 = OddWord Word64 (One (One (One (Zero (Zero (Zero ()))))))+type Word57 = OddWord Word64 (One (One (One (Zero (Zero (One ()))))))+type Word58 = OddWord Word64 (One (One (One (Zero (One (Zero ()))))))+type Word59 = OddWord Word64 (One (One (One (Zero (One (One ()))))))+type Word60 = OddWord Word64 (One (One (One (One (Zero (Zero ()))))))+type Word61 = OddWord Word64 (One (One (One (One (Zero (One ()))))))+type Word62 = OddWord Word64 (One (One (One (One (One (Zero ()))))))+type Word63 = OddWord Word64 (One (One (One (One (One (One ()))))))
+ test/Main.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE Haskell2010, ScopedTypeVariables #-}++module Main where++import System.Exit+import Test.QuickCheck hiding ((.&.))+import Test.QuickCheck.Gen+import Data.Bits+import Data.Word+import Data.Word.Odd+import Control.Monad++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 |+ And Integer | Or Integer | Xor Integer |+ ClrB Int | SetB Int | InvB Int |+ Shift Int | Rot Int+ 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,+ 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]++safeDiv :: (Integral a, Bounded a) => a -> a -> a+safeDiv d 0 = maxBound+safeDiv d n = div d n++safeMod :: (Integral a) => a -> a -> a+safeMod d 0 = 0+safeMod d n = mod d n++safeQuot :: (Integral a, Bounded a) => a -> a -> a+safeQuot d 0 = maxBound+safeQuot d n = quot d n++safeRem :: (Integral a) => a -> a -> a+safeRem d 0 = 0+safeRem d n = rem d n++fromUFunc :: (Integral a, Bounded a, Bits 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)+fromUFunc (SubR i) x = (fromInteger i) - x+fromUFunc (Div i) x = safeDiv x (fromInteger i)+fromUFunc (Mod i) x = safeMod x (fromInteger i)+fromUFunc (Quot i) x = safeQuot x (fromInteger i)+fromUFunc (Rem i) x = safeRem x (fromInteger i)+fromUFunc (DivR i) x = safeDiv (fromInteger i) x+fromUFunc (ModR i) x = safeMod (fromInteger i) x+fromUFunc (QuotR i) x = safeQuot (fromInteger i) x+fromUFunc (RemR i) x = safeRem (fromInteger i) x+fromUFunc Neg x = negate x+fromUFunc Abs x = abs x+fromUFunc Inv x = complement x+fromUFunc (And i) x = x .&. (fromInteger i)+fromUFunc (Or i) x = x .|. (fromInteger i)+fromUFunc (Xor i) x = xor x (fromInteger i)+fromUFunc (ClrB n) x = clearBit x n+fromUFunc (SetB n) x = setBit x n+fromUFunc (InvB n) x = complementBit x n+fromUFunc (Shift n) x = shift x n+fromUFunc (Rot n) x = rotate x n++type TestWord16 = OddWord Word32 (One (Zero (Zero (Zero (Zero ())))))++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)++main :: IO ()+main = do+ r <- quickCheckWithResult stdArgs {maxSuccess = 1000} verifyTestWord16+ case r of+ Success _ _ _ -> exitSuccess+ _ -> exitFailure