sized-types 0.5.0 → 0.5.1
raw patch · 13 files changed
+378/−300 lines, 13 filesdep +base-compatdep +sized-typesdep ~arraydep ~basedep ~singletonsnew-uploader
Dependencies added: base-compat, sized-types
Dependency ranges changed: array, base, singletons
Files
- CHANGELOG.md +3/−0
- Data/Sized/Fin.hs +9/−2
- Data/Sized/Matrix.hs +33/−26
- Data/Sized/Sampled.hs +39/−39
- Data/Sized/Signed.hs +69/−55
- Data/Sized/Sparse/Matrix.hs +26/−24
- Data/Sized/Unsigned.hs +66/−52
- README.md +19/−0
- qc/QC.hs +0/−21
- sized-types.cabal +42/−37
- test/Example1.hs +35/−30
- test/QC/QC.hs +19/−0
- test/Test1.hs +18/−14
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## 0.5.1+* Support for `singletons-1.1`+* Fixed warnings on GHC 7.10
Data/Sized/Fin.hs view
@@ -7,7 +7,7 @@ -- Stability: unstable -- Portability: ghc {-# LANGUAGE TypeFamilies, ScopedTypeVariables, UndecidableInstances, FlexibleInstances, GADTs, DeriveDataTypeable #-}-{-# LANGUAGE DataKinds, KindSignatures, TypeOperators #-}+{-# LANGUAGE DataKinds, KindSignatures, TypeOperators, CPP #-} module Data.Sized.Fin ( -- TNat Fin@@ -21,14 +21,21 @@ where import Data.Ix+#if __GLASGOW_HASKELL__ >= 708 import Data.Typeable+#endif import Data.Singletons import Data.Singletons.TypeLits --type TNat (a::Nat) = Sing a newtype Fin (n :: Nat) = Fin Integer- deriving (Eq, Ord, Typeable)+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ ) fromNat :: Sing (n :: Nat) -> Integer fromNat = fromSing
Data/Sized/Matrix.hs view
@@ -8,18 +8,20 @@ -- Portability: ghc {-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables,- UndecidableInstances, MultiParamTypeClasses, TypeOperators, DataKinds, FlexibleContexts, DeriveDataTypeable #-}+ UndecidableInstances, MultiParamTypeClasses, TypeOperators, DataKinds,+ FlexibleContexts, DeriveDataTypeable, CPP, NoImplicitPrelude #-} module Data.Sized.Matrix where -import Prelude as P hiding (all)-import Control.Applicative+import Prelude.Compat as P hiding (all) import qualified Data.Traversable as T import qualified Data.Foldable as F import qualified Data.List as L hiding (all) import Data.Array.Base as B import Data.Array.IArray as I-import GHC.TypeLits+import GHC.TypeLits (type (+))+#if __GLASGOW_HASKELL__ >= 708 import Data.Typeable+#endif import Numeric import Data.Sized.Fin@@ -27,7 +29,12 @@ -- | A 'Matrix' is an array with the size determined uniquely by the -- /type/ of the index type, 'ix', with every type in 'ix' used. newtype Matrix ix a = Matrix (Array ix a)- deriving (Typeable, Eq, Ord)+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ ) -- | A 'Vector' is a 1D Matrix, using a TypeNat to define its length. type Vector (ix :: Nat) a = Matrix (Fin ix) a@@ -36,7 +43,7 @@ type Vector2 (ix :: Nat) (iy :: Nat) a = Matrix (Fin ix,Fin iy) a instance (Ix ix) => Functor (Matrix ix) where- fmap f (Matrix xs) = Matrix (fmap f xs)+ fmap f (Matrix xs) = Matrix (fmap f xs) instance IArray Matrix a where bounds (Matrix arr) = B.bounds arr@@ -45,23 +52,23 @@ unsafeAt (Matrix arr) i = B.unsafeAt arr i instance (Bounded i, Ix i) => Applicative (Matrix i) where- pure a = fmap (const a) coord -- possible because we are a fixed size- -- Also why use use newtype here.+ pure a = fmap (const a) coord -- possible because we are a fixed size+ -- Also why use use newtype here. a <*> b = forAll $ \ i -> (a ! i) (b ! i) -- | 'matrix' turns a finite list into a matrix. You often need to give the type of the result. matrix :: forall i a . (Bounded i, Ix i) => [a] -> Matrix i a matrix xs | size' == fromIntegral (L.length xs) = I.listArray (low,high) xs- | otherwise = error $ "bad length of fromList for Matrix, "- ++ "expecting " ++ show size' ++ " elements"- ++ ", found " ++ show (L.length xs) ++ " elements."+ | otherwise = error $ "bad length of fromList for Matrix, "+ ++ "expecting " ++ show size' ++ " elements"+ ++ ", found " ++ show (L.length xs) ++ " elements." where size' = rangeSize (low,high)- low :: i- low = minBound- high :: i- high = maxBound+ low :: i+ low = minBound+ high :: i+ high = maxBound -- | what is the population of a matrix? population :: forall i a . (Bounded i, Ix i) => Matrix i a -> Int@@ -172,16 +179,16 @@ show2D :: (Bounded n, Ix n, Bounded m, Ix m, Show a) => Matrix (m, n) a -> String show2D m0 = (joinLines $ map showRow m_rows)- where- m = fmap show m0- m' = forEach m $ \ (x,y) a -> (x == maxBound && y == maxBound,a)- joinLines = unlines . addTail . L.zipWith (++) ("[":repeat " ")- addTail xs = init xs ++ [last xs ++ " ]"]- showRow r = concat (I.elems $ Data.Sized.Matrix.zipWith showEle r m_cols_size)- showEle (f,str) s = take (s - L.length str) (cycle " ") ++ " " ++ str ++ (if f then "" else ",")- m_cols = columns m- m_rows = I.elems $ rows m'- m_cols_size = fmap (maximum . map L.length . I.elems) m_cols+ where+ m = fmap show m0+ m' = forEach m $ \ (x,y) a -> (x == maxBound && y == maxBound,a)+ joinLines = unlines . addTail . L.zipWith (++) ("[":repeat " ")+ addTail xs = init xs ++ [last xs ++ " ]"]+ showRow r = concat (I.elems $ Data.Sized.Matrix.zipWith showEle r m_cols_size)+ showEle (f,str) s = take (s - L.length str) (cycle " ") ++ " " ++ str ++ (if f then "" else ",")+ m_cols = columns m+ m_rows = I.elems $ rows m'+ m_cols_size = fmap (maximum . map L.length . I.elems) m_cols instance (Show a, Show ix, Bounded ix, Ix ix) => Show (Matrix ix a) where show m = "matrix " ++ show (I.bounds m) ++ " " ++ show (I.elems m)@@ -194,7 +201,7 @@ newtype S = S String instance Show S where- show (S s) = s+ show (S s) = s showAsE :: (RealFloat a) => Int -> a -> S showAsE i a = S $ showEFloat (Just i) a ""
Data/Sized/Sampled.hs view
@@ -16,60 +16,60 @@ fromVector :: forall n m . (SingI n, SingI m) => Vector n Bool -> Sampled m n fromVector v = mkSampled (fromIntegral scale * fromIntegral val / fromIntegral precision)- where val :: Signed n- val = S.fromVector v- scale :: Integer- scale = fromIntegral (fromNat (sing :: Sing m))- precision :: Integer- precision = 2 ^ (fromIntegral (fromNat (sing :: Sing n) - 1) :: Integer)+ where val :: Signed n+ val = S.fromVector v+ scale :: Integer+ scale = fromIntegral (fromNat (sing :: Sing m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (fromNat (sing :: Sing n) - 1) :: Integer) mkSampled :: forall n m . (SingI n, SingI m) => Rational -> Sampled m n mkSampled v = Sampled val (fromIntegral scale * fromIntegral val / fromIntegral precision)- where scale :: Integer- scale = fromIntegral (fromNat (sing :: Sing m))- precision :: Integer- precision = 2 ^ (fromIntegral (fromNat (sing :: Sing n) - 1) :: Integer)- val0 :: Rational- val0 = v / fromIntegral scale- val1 :: Integer- -- Key rounding step- val1 = round (val0 * fromIntegral precision)- val = if val1 >= precision then maxBound- else if val1 <= -precision then minBound- else fromInteger val1+ where scale :: Integer+ scale = fromIntegral (fromNat (sing :: Sing m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (fromNat (sing :: Sing n) - 1) :: Integer)+ val0 :: Rational+ val0 = v / fromIntegral scale+ val1 :: Integer+ -- Key rounding step+ val1 = round (val0 * fromIntegral precision)+ val = if val1 >= precision then maxBound+ else if val1 <= -precision then minBound+ else fromInteger val1 instance (SingI ix) => Eq (Sampled m ix) where- (Sampled a _) == (Sampled b _) = a == b+ (Sampled a _) == (Sampled b _) = a == b instance (SingI ix) => Ord (Sampled m ix) where- (Sampled a _) `compare` (Sampled b _) = a `compare` b+ (Sampled a _) `compare` (Sampled b _) = a `compare` b instance (SingI ix) => Show (Sampled m ix) where- show (Sampled _ s) = show (fromRational s :: Double)+ show (Sampled _ s) = show (fromRational s :: Double) instance (SingI ix, SingI m) => Read (Sampled m ix) where- readsPrec i str = [ (mkSampled a,r) | (a,r) <- readsPrec i str ]+ readsPrec i str = [ (mkSampled a,r) | (a,r) <- readsPrec i str ] instance (SingI ix, SingI m) => Num (Sampled m ix) where- (Sampled _ a) + (Sampled _ b) = mkSampled $ a + b- (Sampled _ a) - (Sampled _ b) = mkSampled $ a - b- (Sampled _ a) * (Sampled _ b) = mkSampled $ a * b- abs (Sampled _ n) = mkSampled $ abs n- signum (Sampled _ n) = mkSampled $ signum n- fromInteger n = mkSampled (fromInteger n)+ (Sampled _ a) + (Sampled _ b) = mkSampled $ a + b+ (Sampled _ a) - (Sampled _ b) = mkSampled $ a - b+ (Sampled _ a) * (Sampled _ b) = mkSampled $ a * b+ abs (Sampled _ n) = mkSampled $ abs n+ signum (Sampled _ n) = mkSampled $ signum n+ fromInteger n = mkSampled (fromInteger n) instance (SingI ix, SingI m) => Real (Sampled m ix) where- toRational (Sampled _ n) = toRational n+ toRational (Sampled _ n) = toRational n instance (SingI ix, SingI m) => Fractional (Sampled m ix) where- fromRational n = mkSampled n- recip (Sampled _ n) = mkSampled $ recip n+ fromRational n = mkSampled n+ recip (Sampled _ n) = mkSampled $ recip n -- This is a bit of a hack, and may generate -ve values from fromEnum. instance (SingI ix, SingI m) => Enum (Sampled m ix) where- fromEnum (Sampled n _) = fromEnum n+ fromEnum (Sampled n _) = fromEnum n - toEnum n = mkSampled (fromIntegral scale * fromIntegral val / fromIntegral precision)- where val :: Signed ix- val = fromIntegral n- scale :: Integer- scale = fromIntegral (fromNat (sing :: Sing m))- precision :: Integer- precision = 2 ^ (fromIntegral (fromNat (sing :: Sing ix) - 1) :: Integer)+ toEnum n = mkSampled (fromIntegral scale * fromIntegral val / fromIntegral precision)+ where val :: Signed ix+ val = fromIntegral n+ scale :: Integer+ scale = fromIntegral (fromNat (sing :: Sing m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (fromNat (sing :: Sing ix) - 1) :: Integer)
Data/Sized/Signed.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable, CPP #-} -- | Signed, fixed sized numbers. --@@ -10,23 +10,30 @@ -- Portability: ghc module Data.Sized.Signed- ( Signed- , toVector- , fromVector- , S2, S3, S4, S5, S6, S7, S8, S9- , S10, S11, S12, S13, S14, S15, S16, S17, S18, S19- , S20, S21, S22, S23, S24, S25, S26, S27, S28, S29- , S30, S31, S32- ) where+ ( Signed+ , toVector+ , fromVector+ , S2, S3, S4, S5, S6, S7, S8, S9+ , S10, S11, S12, S13, S14, S15, S16, S17, S18, S19+ , S20, S21, S22, S23, S24, S25, S26, S27, S28, S29+ , S30, S31, S32+ ) where import Data.Array.IArray(elems, (!)) import Data.Sized.Matrix as M import Data.Sized.Fin import Data.Bits+#if __GLASGOW_HASKELL__ >= 708 import Data.Typeable+#endif newtype Signed (ix :: Nat) = Signed Integer- deriving (Eq, Ord, Typeable)+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ ) -- 'toVector' turns a sized 'Signed' value into a 'Vector' of 'Bool's. toVector :: forall ix . (SingI ix) => Signed ix -> Vector ix Bool@@ -35,74 +42,81 @@ -- 'fromVector' turns a 'Vector' of 'Bool's into a sized 'Signed' value. fromVector :: (SingI ix) => Vector ix Bool -> Signed ix fromVector m = mkSigned $- sum [ n- | (n,b) <- zip (iterate (* 2) 1)- (elems m)- , b- ]+ sum [ n+ | (n,b) <- zip (iterate (* 2) 1)+ (elems m)+ , b+ ] -- mkSigned :: forall ix . (SingI ix) => Integer -> Signed ix mkSigned v = res where sz' = 2 ^ bitCount bitCount :: Integer- bitCount = fromIntegral (fromNat (sing :: Sing ix) - 1)- res = case divMod v sz' of- (s,v') | even s -> Signed v'- | otherwise -> Signed (v' - sz')+ bitCount = fromIntegral (fromNat (sing :: Sing ix) - 1)+ res = case divMod v sz' of+ (s,v') | even s -> Signed v'+ | otherwise -> Signed (v' - sz') instance (SingI ix) => Show (Signed ix) where- show (Signed a) = show a+ show (Signed a) = show a instance (SingI ix) => Read (Signed ix) where- readsPrec i str = [ (mkSigned a,r) | (a,r) <- readsPrec i str ]+ readsPrec i str = [ (mkSigned a,r) | (a,r) <- readsPrec i str ] instance (SingI ix) => Integral (Signed ix) where- toInteger (Signed m) = m- quotRem (Signed a) (Signed b) =- case quotRem a b of- (q,r) -> (mkSigned q,mkSigned r)+ toInteger (Signed m) = m+ quotRem (Signed a) (Signed b) =+ case quotRem a b of+ (q,r) -> (mkSigned q,mkSigned r) instance (SingI ix) => Num (Signed ix) where- (Signed a) + (Signed b) = mkSigned $ a + b- (Signed a) - (Signed b) = mkSigned $ a - b- (Signed a) * (Signed b) = mkSigned $ a * b- abs (Signed n) = mkSigned $ abs n- signum (Signed n) = mkSigned $ signum n- fromInteger n = mkSigned n+ (Signed a) + (Signed b) = mkSigned $ a + b+ (Signed a) - (Signed b) = mkSigned $ a - b+ (Signed a) * (Signed b) = mkSigned $ a * b+ abs (Signed n) = mkSigned $ abs n+ signum (Signed n) = mkSigned $ signum n+ fromInteger n = mkSigned n instance (SingI ix) => Real (Signed ix) where- toRational (Signed n) = toRational n+ toRational (Signed n) = toRational n instance (SingI ix) => Enum (Signed ix) where- fromEnum (Signed n) = fromEnum n- toEnum n = mkSigned (toInteger n)+ fromEnum (Signed n) = fromEnum n+ toEnum n = mkSigned (toInteger n) instance (SingI ix) => Bits (Signed ix) where- bitSizeMaybe = return . finiteBitSize- bitSize = finiteBitSize- complement (Signed v) = Signed (complement v)- isSigned _ = True- a `xor` b = fromVector (M.zipWith (/=) (toVector a) (toVector b))- a .|. b = fromVector (M.zipWith (||) (toVector a) (toVector b))- a .&. b = fromVector (M.zipWith (&&) (toVector a) (toVector b))- shiftL (Signed v) i = mkSigned (v * (2 ^ i))- shiftR (Signed v) i = mkSigned (v `div` (2 ^ i))- rotate v i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` mLeng)))- where m = toVector v- mLeng = size $ M.zeroOf m- testBit u idx = toVector u ! (fromIntegral idx)- -- new is 7.6?- bit i = fromVector (forAll $ \ ix -> if ix == fromIntegral i then True else False)- popCount n = sum $ fmap (\ b -> if b then 1 else 0) $ elems $ toVector n+#if MIN_VERSION_base(4,7,0)+ bitSizeMaybe = return . finiteBitSize+#endif+ bitSize = finiteBitSize+ complement (Signed v) = Signed (complement v)+ isSigned _ = True+ a `xor` b = fromVector (M.zipWith (/=) (toVector a) (toVector b))+ a .|. b = fromVector (M.zipWith (||) (toVector a) (toVector b))+ a .&. b = fromVector (M.zipWith (&&) (toVector a) (toVector b))+ shiftL (Signed v) i = mkSigned (v * (2 ^ i))+ shiftR (Signed v) i = mkSigned (v `div` (2 ^ i))+ rotate v i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` mLeng)))+ where m = toVector v+ mLeng = size $ M.zeroOf m+ testBit u idx = toVector u ! (fromIntegral idx)+ -- new is 7.6?+ bit i = fromVector (forAll $ \ ix -> if ix == fromIntegral i then True else False)+ popCount n = sum $ fmap (\ b -> if b then 1 else 0) $ elems $ toVector n +#if MIN_VERSION_base(4,7,0) instance (SingI ix) => FiniteBits (Signed ix) where- finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+ finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#else+finiteBitSize :: forall (ix :: Nat). SingI ix => Signed ix -> Int+finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#endif instance forall ix . (SingI ix) => Bounded (Signed ix) where- minBound = Signed (- maxMagnitude)- where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1)- maxBound = Signed (maxMagnitude - 1)- where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1)+ minBound = Signed (- maxMagnitude)+ where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1)+ maxBound = Signed (maxMagnitude - 1)+ where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1) type S2 = Signed 2
Data/Sized/Sparse/Matrix.hs view
@@ -7,8 +7,9 @@ -- Stability: unstable -- Portability: ghc -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables,- UndecidableInstances, MultiParamTypeClasses, TypeOperators, DataKinds #-}+{-# LANGUAGE NoImplicitPrelude, TypeFamilies, RankNTypes, FlexibleInstances,+ ScopedTypeVariables, UndecidableInstances, MultiParamTypeClasses,+ TypeOperators, DataKinds #-} module Data.Sized.Sparse.Matrix where import Data.Array.Base as B@@ -20,6 +21,7 @@ import qualified Data.Set as Set import Data.Set (Set) import Control.Applicative+import Prelude.Compat data SpMatrix ix a = SpMatrix a (Map ix a) @@ -44,7 +46,7 @@ -- Might be just internal, because nothing else leaks defaults. prune :: (Bounded ix, Ix ix, Eq a) => a -> SpMatrix ix a -> SpMatrix ix a prune d sm@(SpMatrix d' m) | d == d' = SpMatrix d (Map.filter (/= d) m)- | otherwise = sparse d (fill sm) -- it might be possible to do better; think about it+ | otherwise = sparse d (fill sm) -- it might be possible to do better; think about it -- | Make a Matrix sparse, with a default 'zero' value. sparse :: (Bounded ix, Ix ix, Eq a) => a -> M.Matrix ix a -> SpMatrix ix a@@ -54,38 +56,38 @@ SpMatrix (m,n) a -> SpMatrix (m',n') a -> SpMatrix (m,n') a mm s1 s2 = SpMatrix 0 mp where- mp = Map.fromList [ ((x,y),v)- | (x,y) <- X.universe- , let s = (rs B.! x) `Set.intersection` (cs B.! y)- , not (Set.null s)- , let v = foldb1 (+) [(getElem s1 (x,k)) * (getElem s2 (k,y)) | k <- Set.toList s ]- , v /= 0- ]- (SpMatrix _ mp1) = prune 0 s1- (SpMatrix _ mp2) = prune 0 s2- rs = rowSets (Map.keysSet mp1)- cs = columnSets (Map.keysSet mp2)+ mp = Map.fromList [ ((x,y),v)+ | (x,y) <- X.universe+ , let s = (rs B.! x) `Set.intersection` (cs B.! y)+ , not (Set.null s)+ , let v = foldb1 (+) [(getElem s1 (x,k)) * (getElem s2 (k,y)) | k <- Set.toList s ]+ , v /= 0+ ]+ (SpMatrix _ mp1) = prune 0 s1+ (SpMatrix _ mp2) = prune 0 s2+ rs = rowSets (Map.keysSet mp1)+ cs = columnSets (Map.keysSet mp2) - foldb1 _ [x] = x- foldb1 f xs = foldb1 f (take len_before xs) `f` foldb1 f (drop len_before xs)- where len = length xs- len_before = len `div` 2+ foldb1 _ [x] = x+ foldb1 f xs = foldb1 f (take len_before xs) `f` foldb1 f (drop len_before xs)+ where len = length xs+ len_before = len `div` 2 rowSets :: (Bounded a, Ix a, Ord b) => Set (a,b) -> M.Matrix a (Set b) rowSets set = B.accum f (pure Set.empty) (Set.toList set)- where- f set' e = Set.insert e set'+ where+ f set' e = Set.insert e set' columnSets :: (Bounded b, Ix b, Ord a) => Set (a,b) -> M.Matrix b (Set a) columnSets = rowSets . Set.map (\ (a,b) -> (b,a)) instance (Bounded i, Ix i) => Applicative (SpMatrix i) where- pure a = SpMatrix a (Map.empty)- sm1@(SpMatrix d1 m1) <*> sm2@(SpMatrix d2 m2)- = SpMatrix (d1 d2) (Map.fromList [ (k, (getElem sm1 k) (getElem sm2 k)) | k <- Set.toList keys ])- where keys = Map.keysSet m1 `Set.union` Map.keysSet m2+ pure a = SpMatrix a (Map.empty)+ sm1@(SpMatrix d1 m1) <*> sm2@(SpMatrix d2 m2)+ = SpMatrix (d1 d2) (Map.fromList [ (k, (getElem sm1 k) (getElem sm2 k)) | k <- Set.toList keys ])+ where keys = Map.keysSet m1 `Set.union` Map.keysSet m2 instance (Show a, Show ix, Bounded ix, Ix ix) => Show (SpMatrix ix a) where show m = show (fill m)
Data/Sized/Unsigned.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable, CPP #-} -- | Unsigned, fixed sized numbers. --@@ -10,25 +10,32 @@ -- Portability: ghc module Data.Sized.Unsigned- ( Unsigned- , toVector- , fromVector- , showBits- , U1, U2, U3, U4, U5, U6, U7, U8, U9- , U10, U11, U12, U13, U14, U15, U16, U17, U18, U19- , U20, U21, U22, U23, U24, U25, U26, U27, U28, U29- , U30, U31, U32- ) where+ ( Unsigned+ , toVector+ , fromVector+ , showBits+ , U1, U2, U3, U4, U5, U6, U7, U8, U9+ , U10, U11, U12, U13, U14, U15, U16, U17, U18, U19+ , U20, U21, U22, U23, U24, U25, U26, U27, U28, U29+ , U30, U31, U32+ ) where import Data.Array.IArray(elems, (!)) import Data.Sized.Matrix as M import Data.Sized.Fin import Data.Bits import Data.Ix+#if __GLASGOW_HASKELL__ >= 708 import Data.Typeable+#endif newtype Unsigned (ix :: Nat) = Unsigned Integer- deriving (Eq, Ord, Typeable)+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ ) -- 'toVector' turns a sized 'Unsigned' value into a 'Vector' of 'Bool's. toVector :: forall ix . (SingI ix) => Unsigned ix -> Vector ix Bool@@ -37,69 +44,76 @@ -- 'fromVector' turns a 'Vector' of 'Bool's into sized 'Unsigned' value. fromVector :: (SingI ix) => Vector ix Bool -> Unsigned ix fromVector m = mkUnsigned $- sum [ n- | (n,b) <- zip (iterate (* 2) 1)- (elems m)- , b- ]+ sum [ n+ | (n,b) <- zip (iterate (* 2) 1)+ (elems m)+ , b+ ] mkUnsigned :: forall ix . (SingI ix) => Integer -> Unsigned ix mkUnsigned x = Unsigned (x `mod` (2 ^ bitCount)) where bitCount = fromNat (sing :: Sing ix) instance Show (Unsigned ix) where- show (Unsigned a) = show a+ show (Unsigned a) = show a instance (SingI ix) => Read (Unsigned ix) where- readsPrec i str = [ (mkUnsigned a,r) | (a,r) <- readsPrec i str ]+ readsPrec i str = [ (mkUnsigned a,r) | (a,r) <- readsPrec i str ] instance (SingI ix) => Integral (Unsigned ix) where- toInteger (Unsigned m) = m- quotRem (Unsigned a) (Unsigned b) =- case quotRem a b of- (q,r) -> (mkUnsigned q,mkUnsigned r) -- TODO: check for size+ toInteger (Unsigned m) = m+ quotRem (Unsigned a) (Unsigned b) =+ case quotRem a b of+ (q,r) -> (mkUnsigned q,mkUnsigned r) -- TODO: check for size instance (SingI ix) => Num (Unsigned ix) where- (Unsigned a) + (Unsigned b) = mkUnsigned $ a + b- (Unsigned a) - (Unsigned b) = mkUnsigned $ a - b- (Unsigned a) * (Unsigned b) = mkUnsigned $ a * b- abs (Unsigned n) = mkUnsigned $ abs n- signum (Unsigned n) = mkUnsigned $ signum n- fromInteger n = mkUnsigned n+ (Unsigned a) + (Unsigned b) = mkUnsigned $ a + b+ (Unsigned a) - (Unsigned b) = mkUnsigned $ a - b+ (Unsigned a) * (Unsigned b) = mkUnsigned $ a * b+ abs (Unsigned n) = mkUnsigned $ abs n+ signum (Unsigned n) = mkUnsigned $ signum n+ fromInteger n = mkUnsigned n instance (SingI ix) => Real (Unsigned ix) where- toRational (Unsigned n) = toRational n+ toRational (Unsigned n) = toRational n instance (SingI ix) => Enum (Unsigned ix) where- fromEnum (Unsigned n) = fromEnum n- toEnum n = mkUnsigned (toInteger n)+ fromEnum (Unsigned n) = fromEnum n+ toEnum n = mkUnsigned (toInteger n) instance (SingI ix) => Bits (Unsigned ix) where- bitSizeMaybe = return . finiteBitSize- bitSize = finiteBitSize- complement (Unsigned v) = Unsigned (complement v)- isSigned _ = False- (Unsigned a) `xor` (Unsigned b) = Unsigned (a `xor` b)- (Unsigned a) .|. (Unsigned b) = Unsigned (a .|. b)- (Unsigned a) .&. (Unsigned b) = Unsigned (a .&. b)- shiftL (Unsigned v) i = mkUnsigned (shiftL v i)- shiftR (Unsigned v) i = mkUnsigned (shiftR v i)+#if MIN_VERSION_base(4,7,0)+ bitSizeMaybe = return . finiteBitSize+#endif+ bitSize = finiteBitSize+ complement (Unsigned v) = Unsigned (complement v)+ isSigned _ = False+ (Unsigned a) `xor` (Unsigned b) = Unsigned (a `xor` b)+ (Unsigned a) .|. (Unsigned b) = Unsigned (a .|. b)+ (Unsigned a) .&. (Unsigned b) = Unsigned (a .&. b)+ shiftL (Unsigned v) i = mkUnsigned (shiftL v i)+ shiftR (Unsigned v) i = mkUnsigned (shiftR v i) -- TODO: fix- -- it might be possible to loosen the Integral requirement--- rotate (Ui i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.population m)))--- where m = toVector v+ -- it might be possible to loosen the Integral requirement+-- rotate (Ui i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.population m)))+-- where m = toVector v - rotate v i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` mLeng)))- where m = toVector v- mLeng = size $ M.zeroOf m+ rotate v i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` mLeng)))+ where m = toVector v+ mLeng = size $ M.zeroOf m - testBit (Unsigned u) idx = testBit u idx- bit i = fromVector (forAll $ \ ix -> if ix == fromIntegral i then True else False)- popCount n = sum $ fmap (\ b -> if b then 1 else 0) $ elems $ toVector n+ testBit (Unsigned u) idx = testBit u idx+ bit i = fromVector (forAll $ \ ix -> if ix == fromIntegral i then True else False)+ popCount n = sum $ fmap (\ b -> if b then 1 else 0) $ elems $ toVector n +#if MIN_VERSION_base(4,7,0) instance (SingI ix) => FiniteBits (Unsigned ix) where- finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+ finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#else+finiteBitSize :: forall (ix :: Nat). SingI ix => Unsigned ix -> Int+finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#endif showBits :: (SingI ix) => Unsigned ix -> String showBits u = "0b" ++ reverse@@ -108,8 +122,8 @@ ] instance (SingI ix) => Bounded (Unsigned ix) where- minBound = Unsigned 0- maxBound = Unsigned (2 ^ (fromNat (sing :: Sing ix)) - 1)+ minBound = Unsigned 0+ maxBound = Unsigned (2 ^ (fromNat (sing :: Sing ix)) - 1) -- We do not address efficiency in this implementation. instance (SingI ix) => Ix (Unsigned ix) where
+ README.md view
@@ -0,0 +1,19 @@+# sized-types [](http://hackage.haskell.org/package/sized-types) [](https://travis-ci.org/ku-fpg/sized-types)++To build development version, and run tests use++```+% cabal configure -fall+% cabal build+```++To run tests, do++```+% make runtests+```++The reference outputs are in `/ref`, and the outputs from the current run are in `/run`.+++
− qc/QC.hs
@@ -1,21 +0,0 @@---- Copy this module if you need Quick Check.-module QC.QC where--import qualified Test.QuickCheck as QC-import Data.Ix--import Data.Sized.Fin-import Data.Sized.Matrix--import GHC.TypeLits--instance (SingI n) => QC.Arbitrary (Fin n) where- arbitrary = QC.elements [minBound .. maxBound]--instance (QC.Arbitrary ix, Bounded ix, Ix ix, QC.Arbitrary a) => QC.Arbitrary (Matrix ix a) where- arbitrary = f $ \ ixs -> do- elems <- sequence [ QC.arbitrary | _ <- ixs ]- return $ matrix elems- where f :: (Bounded ix, Ix ix) => ([ix] -> m (Matrix ix a)) -> m (Matrix ix a)- f fn = fn (allIndices (undefined :: Matrix ix a))
sized-types.cabal view
@@ -1,5 +1,5 @@ Name: sized-types-Version: 0.5.0+Version: 0.5.1 Synopsis: Sized types in Haskell using the GHC Nat kind. Description: Providing matrixes, sparse matrixes, and signed and unsigned bit vectors, using GHC Nat kind. Category: Language@@ -9,50 +9,55 @@ Maintainer: Andy Gill <andygill@ku.edu> Copyright: (c) 2009-2013 The University of Kansas Homepage: http://www.ittc.ku.edu/csdl/fpg/Tools-Stability: beta-build-type: Simple-Cabal-Version: >= 1.6+Stability: beta+build-type: Simple+extra-source-files: CHANGELOG.md, README.md+Cabal-Version: >= 1.8 +source-repository head+ type: git+ location: https://github.com/ku-fpg/sized-types+ Flag all- Description: Enable full development tree- Default: False+ Description: Enable full development tree+ Default: False Library- Build-Depends: - base >= 4.7 && < 5,- array == 0.5.*,- containers == 0.5.*,- singletons == 0.10.*- Exposed-modules:- Data.Sized.Fin,- Data.Sized.Matrix,- Data.Sized.Sparse.Matrix,- Data.Sized.Signed,- Data.Sized.Unsigned,- Data.Sized.Sampled-- Ghc-Options: -Wall -O2+ Build-Depends: array >= 0.4,+ base >= 4.6 && < 5,+ base-compat >= 0.8.1 && < 1,+ containers == 0.5.*,+ singletons >= 0.10 && < 1.2+ Exposed-modules: Data.Sized.Fin,+ Data.Sized.Matrix,+ Data.Sized.Sparse.Matrix,+ Data.Sized.Signed,+ Data.Sized.Unsigned,+ Data.Sized.Sampled+ Ghc-Options: -Wall -Executable sized-types-test1+test-suite sized-types-test1 if flag(all)- Build-Depends: base, QuickCheck >= 2.0- buildable: True- Other-modules:- QC+ buildable: True else- Build-depends: base- buildable: False- Main-Is: Test1.hs- Hs-Source-Dirs: ., test, qc- Ghc-Options: -Wall+ buildable: False+ type: exitcode-stdio-1.0+ Build-Depends: base,+ QuickCheck >= 2.0,+ sized-types == 0.5.1+ Main-Is: Test1.hs+ Other-modules: QC.QC+ Hs-Source-Dirs: test+ Ghc-Options: -Wall Executable sized-types-example1 if flag(all)- Build-Depends: base- buildable: True+ buildable: True else- Build-depends: base- buildable: False- Main-Is: Example1.hs- Hs-Source-Dirs: ., test- Ghc-Options: -Wall+ buildable: False+ Build-depends: base,+ base-compat >= 0.8.1 && < 1,+ sized-types == 0.5.1+ Main-Is: Example1.hs+ Hs-Source-Dirs: test+ Ghc-Options: -Wall
test/Example1.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators #-}+{-# LANGUAGE CPP, DataKinds, NoImplicitPrelude, TypeFamilies, TypeOperators #-} module Main where @@ -6,44 +6,49 @@ import Data.Sized.Matrix import Data.Sized.Signed as S import Data.Sized.Unsigned as U-import Control.Applicative+#if !(MIN_VERSION_base(4,7,0))+import GHC.TypeLits+#endif+import Prelude.Compat -- NatType equivalences required for the above and beside tests.---type instance (3 + 3) = 6---type instance (4 + 4) = 8+#if !(MIN_VERSION_base(4,7,0))+type instance (3 + 3) = 6+type instance (4 + 4) = 8+#endif main :: IO () main = do- print example1- print example2- print $ transpose example2- print $ example2 `mm` transpose example2- print $ fmap odd example2- print $ example2 `above` example2- print $ example2 `beside` example2- print $ example3- print $ example4- print $ example5- print $ example6- print $ example7+ print example1+ print example2+ print $ transpose example2+ print $ example2 `mm` transpose example2+ print $ fmap odd example2+ print $ example2 `above` example2+ print $ example2 `beside` example2+ print $ example3+ print $ example4+ print $ example5+ print $ example6+ print $ example7 -- cropAt function no longer supported--- print $ example8- print $ fmap (\ v -> if v == (0 :: Double)- then S ""- else showAsE 3 v)- $ fmap (fromIntegral) example6+-- print $ example8+ print $ fmap (\ v -> if v == (0 :: Double)+ then S ""+ else showAsE 3 v)+ $ fmap (fromIntegral) example6 - let s :: [Signed 4]- s = [ x * y | x <- [1..5], y <- [0..5]]- print s+ let s :: [Signed 4]+ s = [ x * y | x <- [1..5], y <- [0..5]]+ print s - let u :: [Unsigned 4]- u = [ x * y | x <- [1..5], y <- [0..5]]- print u+ let u :: [Unsigned 4]+ u = [ x * y | x <- [1..5], y <- [0..5]]+ print u - print $ fmap S.toVector s- print $ fmap U.toVector u+ print $ fmap S.toVector s+ print $ fmap U.toVector u example1 :: Matrix (Fin 5,Fin 5) Int@@ -64,7 +69,7 @@ example6 :: Matrix (Fin 3,Fin 4) Int example6 = forEach example2 $ \ (i,j) a ->- if i == 0 || j == 0 then a else 0+ if i == 0 || j == 0 then a else 0 example7 :: Matrix (Fin 10,Fin 10) Int example7 = matrix [1..100]
+ test/QC/QC.hs view
@@ -0,0 +1,19 @@+-- Copy this module if you need Quick Check.+{-# OPTIONS_GHC -fno-warn-orphans #-}+module QC.QC where++import Data.Ix+import Data.Sized.Fin+import Data.Sized.Matrix++import qualified Test.QuickCheck as QC++instance (SingI n) => QC.Arbitrary (Fin n) where+ arbitrary = QC.elements [minBound .. maxBound]++instance (QC.Arbitrary ix, Bounded ix, Ix ix, QC.Arbitrary a) => QC.Arbitrary (Matrix ix a) where+ arbitrary = f $ \ ixs -> do+ elems <- sequence [ QC.arbitrary | _ <- ixs ]+ return $ matrix elems+ where f :: (Bounded ix, Ix ix) => ([ix] -> m (Matrix ix a)) -> m (Matrix ix a)+ f fn = fn (allIndices (undefined :: Matrix ix a))
test/Test1.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators #-}+{-# LANGUAGE CPP, DataKinds, TypeFamilies, TypeOperators #-} module Main where @@ -7,19 +7,23 @@ import QC.QC() import Test.QuickCheck as QC -- import qualified Data.Sized.Sparse.Matrix as SM-+#if !(MIN_VERSION_base(4,7,0))+import GHC.TypeLits+#endif -- NatType equivalences required for the join tests.---type instance (4 + 5) = 9---type instance (3 + 7) = 10+#if !(MIN_VERSION_base(4,7,0))+type instance (4 + 5) = 9+type instance (3 + 7) = 10+#endif -- Small first cut at tests. main :: IO () main = do- quickCheck prop_mm1- quickCheck prop_fmap1- quickCheck prop_joins- putStrLn "[Done]"+ quickCheck prop_mm1+ quickCheck prop_fmap1+ quickCheck prop_joins+ putStrLn "[Done]" prop_mm1 :: Vector2 3 4 Int -> Vector2 4 5 Int@@ -27,14 +31,14 @@ -> Bool prop_mm1 m1 m2 m3 = ((m1 `mm` m2) `mm` m3) == (m1 `mm` (m2 `mm` m3)) where- _types = (m1 :: Vector2 3 4 Int,- m2 :: Vector2 4 5 Int,- m3 :: Vector2 5 2 Int)+ _types = (m1 :: Vector2 3 4 Int,+ m2 :: Vector2 4 5 Int,+ m3 :: Vector2 5 2 Int) prop_fmap1 :: Vector2 9 29 Int -> Bool prop_fmap1 m1 = fmap (+1) m1 == forEach m1 (\ _i a -> a + 1) where- _types = (m1 :: Vector2 9 29 Int)+ _types = (m1 :: Vector2 9 29 Int) prop_joins :: Vector2 3 4 Int -> Vector2 3 5 Int@@ -42,6 +46,6 @@ -> Vector2 7 5 Int -> Bool prop_joins m1 m2 m3 m4 = (m1 `above` m3) `beside` (m2 `above` m4)- == (m1 `beside` m2) `above` (m3 `beside` m4)+ == (m1 `beside` m2) `above` (m3 `beside` m4) where _types = (m1 :: Vector2 3 4 Int,- m4 :: Vector2 7 5 Int)+ m4 :: Vector2 7 5 Int)