diff --git a/Data/Sized/Arith.hs b/Data/Sized/Arith.hs deleted file mode 100644 --- a/Data/Sized/Arith.hs +++ /dev/null @@ -1,84 +0,0 @@ --- | Basic type-level arithmetic, using base two. --- --- Copyright: (c) 2009 University of Kansas --- License: BSD3 --- --- Maintainer: Andy Gill --- Stability: unstable --- Portability: ghc - - -{-# LANGUAGE TypeFamilies, EmptyDataDecls, UndecidableInstances #-} -module Data.Sized.Arith where - -import Data.Ix - -data N1 - -data X0 = X0 - deriving (Eq,Ord) - -data X0_ a = X0_ Integer -- times 2 plus 0 -data X1_ a = X1_ Integer -- times 2 plus 1 - -type family ADD a b -type instance ADD N1 N1 = APP0 N1 ---type instance ADD N1 X0 = N1 -type instance ADD N1 (X0_ b) = APP1 (ADD N1 b) -type instance ADD N1 (X1_ b) = APP0 b -type instance ADD X0 N1 = N1 -- MIR ---type instance ADD X0 X0 = X0 ---type instance ADD X0 (X0_ b) = X0_ b ---type instance ADD X0 (X1_ b) = APP1 b -type instance ADD (X0_ a) N1 = APP1 (ADD a N1) -- MIR ---type instance ADD (X0_ a) X0 = APP0 a -- MIR -type instance ADD (X0_ a) (X0_ b) = APP0 (ADD a b) -type instance ADD (X0_ a) (X1_ b) = APP1 (ADD a b) -type instance ADD (X1_ a) N1 = APP0 a -- MIR ---type instance ADD (X1_ a) X0 = APP1 a -- MIR -type instance ADD (X1_ a) (X0_ b) = APP1 (ADD a b) -- MIR -type instance ADD (X1_ a) (X1_ b) = APP0 (SUCC (ADD a b)) - -type instance ADD a X0 = a -type instance ADD X0 a = a - - -type family NOT a -type instance NOT N1 = X0 -type instance NOT X0 = N1 -type instance NOT (X0_ a) = APP1 (NOT a) -type instance NOT (X1_ a) = APP0 (NOT a) - -type SUB a b = ADD a (SUCC (NOT b)) - -type family MUL a b -type instance MUL x X0 = X0 -type instance MUL x (X0_ b) = ADD x (MUL x (ADD (X0_ b) N1)) -type instance MUL x (X1_ b) = ADD x (MUL x (ADD (X1_ b) N1)) -type instance MUL x N1 = SUB X0 x - - -type family SUCC a -type instance SUCC N1 = X0 -type instance SUCC X0 = X1_ X0 -type instance SUCC (X0_ a) = APP1 a -type instance SUCC (X1_ a) = APP0 (SUCC a) - - -type family LOG a -type instance LOG X0 = X0 -type instance LOG (X0_ a) = ADD (X1_ X0) (LOG a) -type instance LOG (X1_ a) = ADD (X1_ X0) (LOG a) - -type family APP1 a -type instance APP1 N1 = N1 -type instance APP1 X0 = X1_ X0 -type instance APP1 (X0_ a) = X1_ (X0_ a) -type instance APP1 (X1_ a) = X1_ (X1_ a) - -type family APP0 a -type instance APP0 N1 = X0_ N1 -type instance APP0 X0 = X0 -type instance APP0 (X0_ a) = X0_ (X0_ a) -type instance APP0 (X1_ a) = X0_ (X1_ a) - diff --git a/Data/Sized/Fin.hs b/Data/Sized/Fin.hs new file mode 100644 --- /dev/null +++ b/Data/Sized/Fin.hs @@ -0,0 +1,93 @@ +-- | Fin types +-- +-- Copyright: (c) 2013 University of Kansas +-- License: BSD3 +-- +-- Maintainer: Andy Gill +-- Stability: unstable +-- Portability: ghc +{-# LANGUAGE TypeFamilies, ScopedTypeVariables, UndecidableInstances, FlexibleInstances, GADTs, DeriveDataTypeable #-} +{-# LANGUAGE DataKinds, KindSignatures, TypeOperators #-} +module Data.Sized.Fin + ( -- TNat + Fin + , fromNat + , corners + , universe + , size + , module Data.Singletons + , Nat + ) + where + +import Data.Ix +import Data.Typeable +import Data.Singletons +import Data.Singletons.TypeLits + +--type TNat (a::Nat) = Sing a + +newtype Fin (n :: Nat) = Fin Integer + deriving (Eq, Ord, Typeable) + +fromNat :: Sing (n :: Nat) -> Integer +fromNat = fromSing + +-- A finite (bounding) corners of an finite indexed entity +corners :: forall i . (Bounded i) => (i,i) +corners = (minBound :: i,maxBound) + +-- | A list of all possible values of a type. +universe :: (Bounded ix, Ix ix) => [ix] +universe = range corners + +-- property:length (universe :: [a]) == size a +size :: forall ix . (Bounded ix, Ix ix) => ix -> Int +size _ = rangeSize (corners :: (ix,ix)) + +mkFin :: forall x . SingI x => Integer -> Fin x +mkFin n | m == 0 = error "<>" + | n < 0 = error $ show n ++ " (:: Fin " ++ show m ++ ") is below upper bound" + | n >= m = error $ show n ++ " (:: Fin " ++ show m ++ ") is above upper bound" + | otherwise = Fin n + where m = fromNat (sing :: Sing x) + +instance Show (Fin a) where + show (Fin a) = show a + +instance SingI a => Read (Fin a) where + readsPrec i str0 = [ (mkFin v,str1) | (v,str1) <- readsPrec i str0 ] + +instance SingI a => Num (Fin a) where + (Fin a) + (Fin b) = mkFin (a + b) + (Fin a) * (Fin b) = mkFin (a * b) + (Fin a) - (Fin b) = mkFin (a - b) + abs (Fin a) = mkFin (abs a) + signum (Fin a) = mkFin (signum a) + fromInteger n = mkFin (fromInteger n) + +instance (SingI a) => Ix (Fin a) where + range (Fin n, Fin m) = [ mkFin x | x <- range (n,m) ] + index (Fin n, Fin m) (Fin i) = index (n,m) i + inRange (Fin n, Fin m) (Fin i) = inRange (n,m) i + rangeSize (Fin n, Fin m) = fromIntegral $ max ((m - n) + 1) 0 + +instance SingI a => Bounded (Fin a) where + minBound = mkFin 0 + maxBound = n where n = mkFin (fromSing (sing :: Sing a) - 1) + +instance Enum (Fin a) where + fromEnum (Fin n) = fromIntegral n + toEnum n = Fin (fromIntegral n) + +instance (SingI a) => Real (Fin a) where + toRational (Fin n) = toRational n + +instance (SingI a) => Integral (Fin a) where + quot (Fin n) (Fin m) = mkFin (n `quot` m) + rem (Fin n) (Fin m) = mkFin (n `rem` m) + div (Fin n) (Fin m) = mkFin (n `div` m) + mod (Fin n) (Fin m) = mkFin (n `mod` m) + quotRem a b = (a `quot` b,a `rem` b) + divMod a b = (a `div` b,a `mod` b) + toInteger (Fin n) = n diff --git a/Data/Sized/Ix.hs b/Data/Sized/Ix.hs deleted file mode 100644 --- a/Data/Sized/Ix.hs +++ /dev/null @@ -1,742 +0,0 @@ --- | Sized types X0 to X256. --- --- Copyright: (c) 2009 University of Kansas --- License: BSD3 --- --- Maintainer: Andy Gill --- Stability: unstable --- Portability: ghc - -{-# LANGUAGE TypeFamilies, EmptyDataDecls, UndecidableInstances, ScopedTypeVariables #-} -module Data.Sized.Ix - ( X0 - , X1 - , X2 - , X3 - , X4 - , X5 - , X6 - , X7 - , X8 - , X9 - , X10 - , X11 - , X12 - , X13 - , X14 - , X15 - , X16 - , X17 - , X18 - , X19 - , X20 - , X21 - , X22 - , X23 - , X24 - , X25 - , X26 - , X27 - , X28 - , X29 - , X30 - , X31 - , X32 - , X33 - , X34 - , X35 - , X36 - , X37 - , X38 - , X39 - , X40 - , X41 - , X42 - , X43 - , X44 - , X45 - , X46 - , X47 - , X48 - , X49 - , X50 - , X51 - , X52 - , X53 - , X54 - , X55 - , X56 - , X57 - , X58 - , X59 - , X60 - , X61 - , X62 - , X63 - , X64 - , X65 - , X66 - , X67 - , X68 - , X69 - , X70 - , X71 - , X72 - , X73 - , X74 - , X75 - , X76 - , X77 - , X78 - , X79 - , X80 - , X81 - , X82 - , X83 - , X84 - , X85 - , X86 - , X87 - , X88 - , X89 - , X90 - , X91 - , X92 - , X93 - , X94 - , X95 - , X96 - , X97 - , X98 - , X99 - , X100 - , X101 - , X102 - , X103 - , X104 - , X105 - , X106 - , X107 - , X108 - , X109 - , X110 - , X111 - , X112 - , X113 - , X114 - , X115 - , X116 - , X117 - , X118 - , X119 - , X120 - , X121 - , X122 - , X123 - , X124 - , X125 - , X126 - , X127 - , X128 - , X129 - , X130 - , X131 - , X132 - , X133 - , X134 - , X135 - , X136 - , X137 - , X138 - , X139 - , X140 - , X141 - , X142 - , X143 - , X144 - , X145 - , X146 - , X147 - , X148 - , X149 - , X150 - , X151 - , X152 - , X153 - , X154 - , X155 - , X156 - , X157 - , X158 - , X159 - , X160 - , X161 - , X162 - , X163 - , X164 - , X165 - , X166 - , X167 - , X168 - , X169 - , X170 - , X171 - , X172 - , X173 - , X174 - , X175 - , X176 - , X177 - , X178 - , X179 - , X180 - , X181 - , X182 - , X183 - , X184 - , X185 - , X186 - , X187 - , X188 - , X189 - , X190 - , X191 - , X192 - , X193 - , X194 - , X195 - , X196 - , X197 - , X198 - , X199 - , X200 - , X201 - , X202 - , X203 - , X204 - , X205 - , X206 - , X207 - , X208 - , X209 - , X210 - , X211 - , X212 - , X213 - , X214 - , X215 - , X216 - , X217 - , X218 - , X219 - , X220 - , X221 - , X222 - , X223 - , X224 - , X225 - , X226 - , X227 - , X228 - , X229 - , X230 - , X231 - , X232 - , X233 - , X234 - , X235 - , X236 - , X237 - , X238 - , X239 - , X240 - , X241 - , X242 - , X243 - , X244 - , X245 - , X246 - , X247 - , X248 - , X249 - , X250 - , X251 - , X252 - , X253 - , X254 - , X255 - , X256 - , Size(..) - , all - , Index --- , Row --- , Column - , coerceSize - , ADD - , SUB - ) where - -import Prelude hiding (all) -import Data.Ix -import Data.Sized.Arith - --- | A list of all possible indices. --- Unlike 'indices' in Matrix, this does not need the 'Matrix' --- argument, because the types determine the contents. -all :: forall i . (Size i) => [i] -all = if size (error "all witness" :: i) == 0 then [] else range (minBound,maxBound) - ---- because of TH's lack of type families, will be added later. -type family Index a ---type family Row a ---type family Column a - -class (Eq ix, Ord ix, Show ix, Ix ix, Bounded ix) => Size ix where - -- | return the size (number of possible elements) in type 'ix'. - size :: ix -> Int - -- | add an arbitary index to a specific 'ix' position. - addIndex :: ix -> Index ix -> ix - -- | look at an 'ix' as an 'Index', typically just an 'Int'. - toIndex :: ix -> Index ix - -type instance Index () = () - -instance Size () where - size () = 1 - addIndex () () = () - toIndex () = () - - -type instance Index (a,b) = (Index a,Index b) ---type instance Row (a,b) = a ---type instance Column (a,b) = b - -instance (Size x, Size y) => Size (x,y) where - size ~(a,b) = size a * size b - addIndex (a,b) (a',b') = (addIndex a a',addIndex b b') - toIndex (a,b) = (toIndex a, toIndex b) --- seeIn2D (x,y) = (x,y) - -type instance Index (a,b,c) = (Index a,Index b,Index c) --- type instance Row (a,b,c) = a ---type instance Column (a,b,c) = (b,c) - -instance (Size x, Size y, Size z) => Size (x,y,z) where - size (a,b,c) = size a * size b * size c - addIndex (a,b,c) (a',b',c') = (addIndex a a',addIndex b b',addIndex c c') - toIndex (a,b,c) = (toIndex a, toIndex b,toIndex c) --- seeIn2D (_a,_b) = error "Can not display 3D matrix in 2D" - -type instance Index (a,b,c,d) = (Index a,Index b,Index c,Index d) - -instance (Size x, Size y, Size z,Size z2) => Size (x,y,z,z2) where - size (a,b,c,d) = size a * size b * size c * size d - addIndex (a,b,c,d) (a',b',c',d') = (addIndex a a',addIndex b b',addIndex c c',addIndex d d') - toIndex (a,b,c,d) = (toIndex a, toIndex b,toIndex c,toIndex d) --- seeIn2D (_a,_b) = error "Can not display 4D matrix in 2D" - --- | A good way of converting from one index type to another index type, typically in another base. -coerceSize :: (Index ix1 ~ Index ix2, Size ix1, Size ix2, Num ix2) => ix1 -> ix2 -coerceSize ix = addIndex 0 (toIndex ix) - -type instance Index X0 = Int ---type instance Row X0 = X1 ---type instance Column X0 = X0 - -instance Size X0 where - size _ = 0 - addIndex X0 _n = X0 - toIndex X0 = 0 --- seeIn2D (_,y) = y - -instance Integral X0 where - toInteger a = toInteger (size a) -instance Real X0 where -instance Enum X0 where -instance Num X0 where - -instance Size a => Bounded (X1_ a) where - minBound = X1_ 0 - maxBound = let a = X1_ (fromIntegral (size a) - 1) in a - -instance (Size a) => Real (X1_ a) where -instance (Size a, Size (X1_ a), Integral a) => Integral (X1_ a) where - quotRem (X1_ a) (X1_ b) = (X1_ (a `quot` b),X1_ (a `rem` b)) - divMod (X1_ a) (X1_ b) = (X1_ (a `div` b),X1_ (a `mod` b)) - toInteger (X1_ a) = toInteger a - -type instance Index (X1_ a) = Int ---type instance Row (X1_ a) = X1 ---type instance Column (X1_ a) = X1_ a - -instance Size a => Size (X1_ a) where - size = const s - where s = 2 * size (undefined :: a) + 1 - addIndex (X1_ v) n = mkX1_ (v + fromIntegral n) -- fix bounds issues - toIndex (X1_ v) = fromIntegral v --- seeIn2D (_,y) = y - -type instance Index (X0_ a) = Int ---type instance Row (X0_ a) = X1 ---type instance Column (X0_ a) = X0_ a - -instance Size a => Bounded (X0_ a) where - minBound = X0_ 0 - maxBound = let a = X0_ (fromIntegral (size a) - 1) in a - -instance Size a => Size (X0_ a) where - size = const s - where s = 2 * size (undefined :: a) - addIndex (X0_ v) n = mkX0_ (v + fromIntegral n) -- fix bounds issues - toIndex (X0_ v) = fromIntegral v --- seeIn2D (_,y) = y - -instance (Size a) => Real (X0_ a) where -instance (Size a, Size (X0_ a), Integral a) => Integral (X0_ a) where - quotRem (X0_ a) (X0_ b) = (X0_ (a `quot` b),X0_ (a `rem` b)) - divMod (X0_ a) (X0_ b) = (X0_ (a `div` b),X0_ (a `mod` b)) - toInteger (X0_ a) = a - - ---- instances -instance Eq (X0_ a) where - (X0_ a) == (X0_ b) = a == b - -instance Ord (X0_ a) where - (X0_ a) `compare` (X0_ b) = a `compare` b - - -instance (Size a) => Ix (X0_ a) where - range (X0_ a,X0_ b) = map mkX0_ (range (a,b)) - index (X0_ a,X0_ b) (X0_ i) = index (a,b) i - inRange (X0_ a,X0_ b) (X0_ i) = inRange (a,b) i - -instance (Size a) => Enum (X0_ a) where - toEnum n = mkX0_ (fromIntegral n) - fromEnum (X0_ n) = fromIntegral n - -instance (Size a) => Num (X0_ a) where - fromInteger n = mkX0_ (fromInteger n) -- bounds checking needed! - abs a = a - signum (X0_ a) = if a == 0 then 0 else 1 - (X0_ a) + (X0_ b) = mkX0_ (a + b) - (X0_ a) - (X0_ b) = mkX0_ (a - b) - (X0_ a) * (X0_ b) = mkX0_ (a * b) - - -instance Show (X0_ a) where - show (X0_ a) = show a - -instance Eq (X1_ a) where - (X1_ a) == (X1_ b) = a == b - -instance Ord (X1_ a) where - (X1_ a) `compare` (X1_ b) = a `compare` b - -instance (Size a) => Ix (X1_ a) where - range (X1_ a,X1_ b) = map (mkX1_ . fromIntegral) (range (a,b)) - index (X1_ a,X1_ b) (X1_ i) = index (a,b) i - inRange (X1_ a,X1_ b) (X1_ i) = inRange (a,b) i - -instance (Size a) => Enum (X1_ a) where - toEnum n = mkX1_ (fromIntegral n) - fromEnum (X1_ n) = fromIntegral n - -instance (Size a) => Num (X1_ a) where - fromInteger n = mkX1_ (fromInteger n) -- bounds checking needed! - abs a = a - signum (X1_ a) = if a == 0 then 0 else 1 - (X1_ a) + (X1_ b) = mkX1_ (a + b) - (X1_ a) - (X1_ b) = mkX1_ (a - b) - (X1_ a) * (X1_ b) = mkX1_ (a * b) - -instance Show (X1_ a) where - show (X1_ a) = show a - -instance Bounded X0 where - minBound = error "minBound not defined for X0" - maxBound = error "maxBound not defined for X0" - -instance Ix X0 where - range (X0,X0) = [] - inRange (X0,X0) X0 = False - -instance Show X0 where - show X0 = "-" - -mkX0_ :: forall a . Size a => Integer -> X0_ a -mkX0_ n | n < 0 = error $ "out of range: ((" ++ show n ++ ") :: X" ++ show s ++ ") < 0" - | n >= s = error $ "out of range: (" ++ show n ++ " :: X" ++ show s ++ ") >= " ++ show s - | otherwise = r - where - r :: X0_ a - r = X0_ n - s = fromIntegral (size r) - -mkX1_ :: forall a . Size a => Integer -> X1_ a -mkX1_ n | n < 0 = error $ "out of range: ((" ++ show n ++ ") :: X" ++ show s ++ ") < 0" - | n >= s = error $ "out of range: (" ++ show n ++ " :: X" ++ show s ++ ") >= " ++ show s - | otherwise = r - where - r :: X1_ a - r = X1_ n - s = fromIntegral (size r) ------- - -type X1 = X1_ X0 -type X2 = X0_ (X1_ X0) -type X3 = X1_ (X1_ X0) -type X4 = X0_ (X0_ (X1_ X0)) -type X5 = X1_ (X0_ (X1_ X0)) -type X6 = X0_ (X1_ (X1_ X0)) -type X7 = X1_ (X1_ (X1_ X0)) -type X8 = X0_ (X0_ (X0_ (X1_ X0))) -type X9 = X1_ (X0_ (X0_ (X1_ X0))) -type X10 = X0_ (X1_ (X0_ (X1_ X0))) -type X11 = X1_ (X1_ (X0_ (X1_ X0))) -type X12 = X0_ (X0_ (X1_ (X1_ X0))) -type X13 = X1_ (X0_ (X1_ (X1_ X0))) -type X14 = X0_ (X1_ (X1_ (X1_ X0))) -type X15 = X1_ (X1_ (X1_ (X1_ X0))) -type X16 = X0_ (X0_ (X0_ (X0_ (X1_ X0)))) -type X17 = X1_ (X0_ (X0_ (X0_ (X1_ X0)))) -type X18 = X0_ (X1_ (X0_ (X0_ (X1_ X0)))) -type X19 = X1_ (X1_ (X0_ (X0_ (X1_ X0)))) -type X20 = X0_ (X0_ (X1_ (X0_ (X1_ X0)))) -type X21 = X1_ (X0_ (X1_ (X0_ (X1_ X0)))) -type X22 = X0_ (X1_ (X1_ (X0_ (X1_ X0)))) -type X23 = X1_ (X1_ (X1_ (X0_ (X1_ X0)))) -type X24 = X0_ (X0_ (X0_ (X1_ (X1_ X0)))) -type X25 = X1_ (X0_ (X0_ (X1_ (X1_ X0)))) -type X26 = X0_ (X1_ (X0_ (X1_ (X1_ X0)))) -type X27 = X1_ (X1_ (X0_ (X1_ (X1_ X0)))) -type X28 = X0_ (X0_ (X1_ (X1_ (X1_ X0)))) -type X29 = X1_ (X0_ (X1_ (X1_ (X1_ X0)))) -type X30 = X0_ (X1_ (X1_ (X1_ (X1_ X0)))) -type X31 = X1_ (X1_ (X1_ (X1_ (X1_ X0)))) -type X32 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))) -type X33 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))) -type X34 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))) -type X35 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))) -type X36 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))) -type X37 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))) -type X38 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))) -type X39 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))) -type X40 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))) -type X41 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))) -type X42 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))) -type X43 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))) -type X44 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))) -type X45 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))) -type X46 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))) -type X47 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))) -type X48 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))) -type X49 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))) -type X50 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))) -type X51 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))) -type X52 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))) -type X53 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))) -type X54 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))) -type X55 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))) -type X56 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))) -type X57 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))) -type X58 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))) -type X59 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))) -type X60 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))) -type X61 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))) -type X62 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))) -type X63 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))) -type X64 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X65 = X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X66 = X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X67 = X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X68 = X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X69 = X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X70 = X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X71 = X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))) -type X72 = X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X73 = X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X74 = X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X75 = X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X76 = X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X77 = X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X78 = X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X79 = X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))) -type X80 = X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X81 = X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X82 = X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X83 = X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X84 = X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X85 = X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X86 = X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X87 = X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))) -type X88 = X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X89 = X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X90 = X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X91 = X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X92 = X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X93 = X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X94 = X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X95 = X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))) -type X96 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X97 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X98 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X99 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X100 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X101 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X102 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X103 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))) -type X104 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X105 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X106 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X107 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X108 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X109 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X110 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X111 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))) -type X112 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X113 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X114 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X115 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X116 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X117 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X118 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X119 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))) -type X120 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X121 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X122 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X123 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X124 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X125 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X126 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X127 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))) -type X128 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X129 = X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X130 = X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X131 = X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X132 = X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X133 = X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X134 = X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X135 = X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X136 = X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X137 = X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X138 = X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X139 = X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X140 = X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X141 = X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X142 = X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X143 = X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))) -type X144 = X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X145 = X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X146 = X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X147 = X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X148 = X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X149 = X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X150 = X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X151 = X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X152 = X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X153 = X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X154 = X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X155 = X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X156 = X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X157 = X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X158 = X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X159 = X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))) -type X160 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X161 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X162 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X163 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X164 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X165 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X166 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X167 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X168 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X169 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X170 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X171 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X172 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X173 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X174 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X175 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))) -type X176 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X177 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X178 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X179 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X180 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X181 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X182 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X183 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X184 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X185 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X186 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X187 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X188 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X189 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X190 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X191 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))) -type X192 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X193 = X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X194 = X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X195 = X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X196 = X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X197 = X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X198 = X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X199 = X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X200 = X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X201 = X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X202 = X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X203 = X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X204 = X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X205 = X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X206 = X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X207 = X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))) -type X208 = X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X209 = X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X210 = X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X211 = X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X212 = X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X213 = X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X214 = X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X215 = X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X216 = X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X217 = X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X218 = X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X219 = X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X220 = X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X221 = X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X222 = X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X223 = X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))) -type X224 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X225 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X226 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X227 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X228 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X229 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X230 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X231 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X232 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X233 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X234 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X235 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X236 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X237 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X238 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X239 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))) -type X240 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X241 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X242 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X243 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X244 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X245 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X246 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X247 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X248 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X249 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X250 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X251 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X252 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X253 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X254 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X255 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))) -type X256 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))) - diff --git a/Data/Sized/Matrix.hs b/Data/Sized/Matrix.hs --- a/Data/Sized/Matrix.hs +++ b/Data/Sized/Matrix.hs @@ -1,216 +1,166 @@ -- | Sized matrixes. --- --- Copyright: (c) 2009 University of Kansas +-- +-- Copyright: (c) 2013 University of Kansas -- License: BSD3 -- -- Maintainer: Andy Gill -- Stability: unstable -- Portability: ghc -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables, UndecidableInstances, MultiParamTypeClasses #-} -module Data.Sized.Matrix - ( module Data.Sized.Matrix - , module Data.Sized.Ix - ) where +{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables, + UndecidableInstances, MultiParamTypeClasses, TypeOperators, DataKinds, FlexibleContexts, DeriveDataTypeable #-} +module Data.Sized.Matrix where -import Data.Array as A hiding (indices,(!), ixmap, assocs) -import qualified Data.Array as A import Prelude as P hiding (all) import Control.Applicative import qualified Data.Traversable as T import qualified Data.Foldable as F -import qualified Data.List as L -import Numeric +import qualified Data.List as L hiding (all) +import Data.Array.Base as B +import Data.Array.IArray as I +import GHC.TypeLits +import Data.Typeable +import Numeric -import Data.Sized.Ix +import Data.Sized.Fin --- | A 'Matrix' is an array with the sized determined uniquely by the --- /type/ of the index type, 'ix'. -data Matrix ix a = Matrix (Array ix a) - | NullMatrix -- consider using Int as index, and keeping ix as phantom, - -- instead of this NullMatrix. - deriving (Eq,Ord) +-- | 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) --- | '!' looks up an element in the matrix. -(!) :: (Size n) => Matrix n a -> n -> a -(!) (Matrix xs) n = xs A.! n -(!) NullMatrix _ = error "Attending to index into a Null Matrix, should *never* happen" +-- | A 'Vector' is a 1D Matrix, using a TypeNat to define its length. +type Vector (ix :: Nat) a = Matrix (Fin ix) a -instance (Size i) => Functor (Matrix i) where +-- | A 'Vector2' is a 2D Matrix, using a TypeNat's to define its size. +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 NullMatrix = NullMatrix --- | 'toList' turns a matrix into an always finite list. -toList :: (Size i) => Matrix i a -> [a] -toList (Matrix a) = elems a -toList NullMatrix = [] +instance IArray Matrix a where + bounds (Matrix arr) = B.bounds arr + numElements (Matrix arr) = B.numElements arr + unsafeArray (a,b) ass = Matrix $ B.unsafeArray (a,b) ass + unsafeAt (Matrix arr) i = B.unsafeAt arr i --- | 'fromList' turns a finite list into a matrix. You often need to give the type of the result. -fromList :: forall i a . (Size i) => [a] -> Matrix i a -fromList xs | size witness == 0 = NullMatrix - | size witness == L.length xs = Matrix $ listArray (low,high) xs - | otherwise = error $ "bad length of fromList for Matrix, " - ++ "expecting " ++ show (size witness) ++ " elements" +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. + 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." - where - witness :: i - witness = undefined + where + size' = rangeSize (low,high) low :: i low = minBound high :: i high = maxBound --- | 'matrix' turns a finite list into a matrix. You often need to give the type of the result. -matrix :: (Size i) => [a] -> Matrix i a -matrix = fromList - --- | 'indices' is a version of 'Data.Sized.Ix.all' that takes a type, for forcing the result type using the Matrix type. -indices :: (Size i) => Matrix i a -> [i] -indices _ = all - --- | what is the length of a matrix? -length :: (Size i) => Matrix i a -> Int -length = size . zeroOf - --- | 'assocs' extracts the index/value pairs. -assocs :: (Size i) => Matrix i a -> [(i,a)] -assocs (Matrix a) = A.assocs a -assocs NullMatrix = [] - -(//) :: (Size i) => Matrix i e -> [(i, e)] -> Matrix i e -(//) (Matrix arr) ixs = Matrix (arr A.// ixs) -(//) (NullMatrix) _ = NullMatrix +-- | what is the population of a matrix? +population :: forall i a . (Bounded i, Ix i) => Matrix i a -> Int +population _ = rangeSize (minBound :: i,maxBound) -accum :: (Size i) => (e -> a -> e) -> Matrix i e -> [(i, a)] -> Matrix i e -accum f (Matrix arr) ixs = Matrix (A.accum f arr ixs) +allIndices :: (Bounded i, Ix i) => Matrix i a -> [i] +allIndices _ = universe -- | 'zeroOf' is for use to force typing issues, and is 0. -zeroOf :: (Size i) => Matrix i a -> i +zeroOf :: (Bounded i, Ix i) => Matrix i a -> i zeroOf _ = minBound -- | 'coord' returns a matrix filled with indexes. -coord :: (Size i) => Matrix i i -coord = fromList all +coord :: (Bounded i, Ix i) => Matrix i i +coord = matrix universe -- | Same as for lists. -zipWith :: (Size i) => (a -> b -> c) -> Matrix i a -> Matrix i b -> Matrix i c +zipWith :: (Bounded i, Ix i) => (a -> b -> c) -> Matrix i a -> Matrix i b -> Matrix i c zipWith f a b = forAll $ \ i -> f (a ! i) (b ! i) -- | 'forEach' takes a matrix, and calls a function for each element, to give a new matrix of the same size. -forEach :: (Size i) => Matrix i a -> (i -> a -> b) -> Matrix i b +forEach :: (Bounded i, Ix i) => Matrix i a -> (i -> a -> b) -> Matrix i b forEach a f = Data.Sized.Matrix.zipWith f coord a -- | 'forAll' creates a matrix out of a mapping from the coordinates. -forAll :: (Size i) => (i -> a) -> Matrix i a +forAll :: (Bounded i, Ix i) => (i -> a) -> Matrix i a forAll f = fmap f coord -instance (Size i) => Applicative (Matrix i) where - pure a = fmap (const a) coord -- possible because we are a fixed size - a <*> b = forAll $ \ i -> (a ! i) (b ! i) - -- | 'mm' is the 2D matrix multiply. -mm :: (Size m, Size n, Size m', Size n', n ~ m', Num a) => Matrix (m,n) a -> Matrix (m',n') a -> Matrix (m,n') a -mm a b = forAll $ \ (i,j) -> sum [ a ! (i,r) * b ! (r,j) | r <- all ] - +mm :: (Bounded m, Ix m, Bounded n, Ix n, Bounded o, Ix o, Num a) => Matrix (m,n) a -> Matrix (n,o) a -> Matrix (m,o) a +mm a b = forAll $ \ (i,j) -> sum [ a ! (i,r) * b ! (r,j) | r <- universe ] + -- | 'transpose' a 2D matrix. -transpose :: (Size x, Size y) => Matrix (x,y) a -> Matrix (y,x) a -transpose = ixmap $ \ (x,y) -> (y,x) +transpose :: (Bounded x, Ix x, Bounded y, Ix y) => Matrix (x,y) a -> Matrix (y,x) a +transpose = ixmap corners $ \ (x,y) -> (y,x) -- | return the identity for a specific matrix size. -identity :: (Size x, Num a) => Matrix (x,x) a +identity :: (Bounded x, Ix x, Num a) => Matrix (x,x) a identity = (\ (x,y) -> if x == y then 1 else 0) <$> coord +-- | append to 1D vectors +append :: (SingI left, SingI right, SingI (left + right)) + => Vector left a -> Vector right a -> Vector (left + right) a +append m1 m2 = matrix (I.elems m1 ++ I.elems m2) + +-- TODO. Is the type constraint for 'both' sufficient ? +-- In an earlier version we had: +-- , ADD top bottom ~ both +-- , SUB both top ~ bottom +-- , SUB both bottom ~ top + -- | stack two matrixes 'above' each other. -above :: (Size m, Size top, Size bottom, Size both - , ADD top bottom ~ both - , SUB both top ~ bottom - , SUB both bottom ~ top - ) - => Matrix (top,m) a -> Matrix (bottom,m) a -> Matrix (both,m) a -above m1 m2 = fromList (toList m1 ++ toList m2) +above :: (SingI top, SingI bottom, SingI y, SingI (top + bottom)) + => Vector2 top y a -> Vector2 bottom y a -> Vector2 (top + bottom) y a +above m1 m2 = matrix (I.elems m1 ++ I.elems m2) + -- | stack two matrixes 'beside' each other. -beside - :: (Size m, - Size left, - Size right, - Size both - , ADD left right ~ both - , SUB both left ~ right - , SUB both right ~ left - ) => - Matrix (m, left) a -> Matrix (m, right) a -> Matrix (m, both) a +beside :: (SingI left, SingI right, SingI x, SingI (left + right)) + => Vector2 x left a -> Vector2 x right a -> Vector2 x (left + right) a beside m1 m2 = transpose (transpose m1 `above` transpose m2) --- | append two 1-d matrixes -append :: - (Size left, - Size right, - Size both - , ADD left right ~ both - , SUB both left ~ right - , SUB both right ~ left - ) => Matrix left a -> Matrix right a -> Matrix both a -append m1 m2 = fromList (toList m1 ++ toList m2) - --- | look at a matrix through a lens to another matrix. -ixmap :: (Size i, Size j) => (i -> j) -> Matrix j a -> Matrix i a -ixmap f m = (\ i -> m ! f i) <$> coord - -- | look at a matrix through a functor lens, to another matrix. -ixfmap :: (Size i, Size j, Functor f) => (i -> f j) -> Matrix j a -> Matrix i (f a) +ixfmap :: (Bounded i, Ix i, Bounded j, Ix j, Functor f) => (i -> f j) -> Matrix j a -> Matrix i (f a) ixfmap f m = (fmap (\ j -> m ! j) . f) <$> coord +-- FIXME. This is difficult to do with the simplifications appearing Sized. +-- The Index class no longer exists (which required addIndex) +-- Is this required ??? + -- | grab /part/ of a matrix. -cropAt :: (Index i ~ Index ix, Size i, Size ix) => Matrix ix a -> ix -> Matrix i a -cropAt m corner = ixmap (\ i -> (addIndex corner (toIndex i))) m +--cropAt :: (Index i ~ Index ix, Bounded i, Ix i, Bounded ix, Ix ix) => Matrix ix a -> ix -> Matrix i a +--cropAt m corner = ixmap (\ i -> (addIndex corner (toIndex i))) m -- | slice a 2D matrix into rows. -rows :: (Bounded n, Size n, Bounded m, Size m) => Matrix (m,n) a -> Matrix m (Matrix n a) -rows a = (\ m -> matrix [ a ! (m,n) | n <- all ]) <$> coord +rows :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix (m,n) a -> Matrix m (Matrix n a) +rows a = (\ m -> matrix [ a ! (m,n) | n <- universe ]) <$> coord -- | slice a 2D matrix into columns. -columns :: (Bounded n, Size n, Bounded m, Size m) => Matrix (m,n) a -> Matrix n (Matrix m a) +columns :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix (m,n) a -> Matrix n (Matrix m a) columns = rows . transpose -- | join a matrix of matrixes into a single matrix. -joinRows :: (Bounded n, Size n, Bounded m, Size m) => Matrix m (Matrix n a) -> Matrix (m,n) a +joinRows :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix m (Matrix n a) -> Matrix (m,n) a joinRows a = (\ (m,n) -> (a ! m) ! n) <$> coord -- | join a matrix of matrixes into a single matrix. -joinColumns :: (Bounded n, Size n, Bounded m, Size m) => Matrix n (Matrix m a) -> Matrix (m,n) a +joinColumns :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix n (Matrix m a) -> Matrix (m,n) a joinColumns a = (\ (m,n) -> (a ! n) ! m) <$> coord --- | generate a 2D single row from a 1D matrix. -unitRow :: (Size m, Bounded m) => Matrix m a -> Matrix (X1, m) a -unitRow = ixmap snd - --- | generate a 1D matrix from a 2D matrix. -unRow :: (Size m, Bounded m) => Matrix (X1, m) a -> Matrix m a -unRow = ixmap (\ n -> (0,n)) - --- | generate a 2D single column from a 1D matrix. -unitColumn :: (Size m, Bounded m) => Matrix m a -> Matrix (m, X1) a -unitColumn = ixmap fst - --- | generate a 1D matrix from a 2D matrix. -unColumn :: (Size m, Bounded m) => Matrix (m, X1) a -> Matrix m a -unColumn = ixmap (\ n -> (n,0)) - --- | very general; required that m and n have the same number of elements, rebundle please. -squash :: (Size n, Size m) => Matrix m a -> Matrix n a -squash = fromList . toList +instance (Bounded ix, Ix ix) => T.Traversable (Matrix ix) where + traverse f a = matrix <$> (T.traverse f $ I.elems a) -instance (Size ix) => T.Traversable (Matrix ix) where - traverse f a = matrix <$> (T.traverse f $ toList a) - -instance (Size ix) => F.Foldable (Matrix ix) where - foldMap f m = F.foldMap f (toList m) +instance (Bounded ix, Ix ix) => F.Foldable (Matrix ix) where + foldMap f m = F.foldMap f (I.elems m) --- | 'showMatrix' displays a 2D matrix, and is the worker for 'show'. --- --- > GHCi> matrix [1..42] :: Matrix (X7,X6) Int +-- | 'show2D' displays a 2D matrix, and is the worker for 'show'. +-- +-- > GHCi> matrix [1..42] :: Matrix (Fin 7, Fin 6) Int -- > [ 1, 2, 3, 4, 5, 6, -- > 7, 8, 9, 10, 11, 12, -- > 13, 14, 15, 16, 17, 18, @@ -220,21 +170,23 @@ -- > 37, 38, 39, 40, 41, 42 ] -- > -showMatrix :: (Size n, Size m) => Matrix (m, n) String -> String -showMatrix m = (joinLines $ map showRow m_rows) +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 " ") + joinLines = unlines . addTail . L.zipWith (++) ("[":repeat " ") addTail xs = init xs ++ [last xs ++ " ]"] - showRow r = concat (toList $ Data.Sized.Matrix.zipWith showEle r m_cols_size) + 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 = toList $ rows m' - m_cols_size = fmap (maximum . map L.length . toList) m_cols + 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) -instance (Show a, Size ix) => Show (Matrix ix a) where - show = showMatrix . fmap show . unitRow +-- TODO: read instance -- | 'S' is shown as the contents, without the quotes. -- One use is a matrix of S, so that you can do show-style functions @@ -244,36 +196,8 @@ instance Show S where show (S s) = s -showAsE :: (RealFloat a) => Int -> a -> S +showAsE :: (RealFloat a) => Int -> a -> S showAsE i a = S $ showEFloat (Just i) a "" -showAsF :: (RealFloat a) => Int -> a -> S +showAsF :: (RealFloat a) => Int -> a -> S showAsF i a = S $ showFFloat (Just i) a "" - -scanM :: (Size ix, Bounded ix, Enum ix) - => ((left,a,right) -> (right,b,left)) - -> (left, Matrix ix a,right) - -> (right,Matrix ix b,left) -scanM f (l,m,r) = ( fst3 (tmp ! minBound), snd3 `fmap` tmp, trd3 (tmp ! maxBound) ) - where tmp = forEach m $ \ i a -> f (prev i, a, next i) - prev i = if i == minBound then l else (trd3 (tmp ! (pred i))) - next i = if i == maxBound then r else (fst3 (tmp ! (succ i))) - fst3 (a,_,_) = a - snd3 (_,b,_) = b - trd3 (_,_,c) = c - -scanL :: (Size ix, Bounded ix, Enum ix) - => ((a,right) -> (right,b)) - -> (Matrix ix a,right) - -> (right,Matrix ix b) -scanL = error "to be written" - -scanR :: (Size ix, Bounded ix, Enum ix) - => ((left,a) -> (b,left)) - -> (left, Matrix ix a) - -> (Matrix ix b,left) -scanR f (l,m) = ( fst `fmap` tmp, snd (tmp ! maxBound) ) - where tmp = forEach m $ \ i a -> f (prev i,a) - prev i = if i == minBound then l else (snd (tmp ! (pred i))) - - diff --git a/Data/Sized/Sampled.hs b/Data/Sized/Sampled.hs --- a/Data/Sized/Sampled.hs +++ b/Data/Sized/Sampled.hs @@ -1,55 +1,53 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, ExistentialQuantification #-} module Data.Sized.Sampled where -import Data.Ratio import Data.Sized.Signed as S import Data.Sized.Matrix as M -import Data.Sized.Ix +import Data.Sized.Fin -- A signed fixed precision number, with max value m, via n sampled bits. -- We add an extra bit, to represent the *sign*. -data Sampled m n = Sampled (Signed n) Rational +data Sampled (m :: Nat) (n :: Nat) = Sampled (Signed n) Rational -- deriving Show -toMatrix :: (Size n) => Sampled m n -> Matrix n Bool -toMatrix (Sampled sig _) = S.toMatrix sig +toVector :: (SingI m, SingI n) => Sampled m n -> Vector n Bool +toVector (Sampled sig _) = S.toVector sig -fromMatrix :: forall n m . (Size n, Size m) => Matrix n Bool -> Sampled m n -fromMatrix m = mkSampled (fromIntegral scale * fromIntegral val / fromIntegral precision) +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.fromMatrix m + val = S.fromVector v scale :: Integer - scale = fromIntegral (size (undefined :: m)) + scale = fromIntegral (fromNat (sing :: Sing m)) precision :: Integer - precision = 2 ^ (fromIntegral (size (undefined :: n) - 1) :: Integer) - + precision = 2 ^ (fromIntegral (fromNat (sing :: Sing n) - 1) :: Integer) -mkSampled :: forall n m . (Size n, Size m) => Rational -> Sampled m n +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 (size (undefined :: m)) + scale = fromIntegral (fromNat (sing :: Sing m)) precision :: Integer - precision = 2 ^ (fromIntegral (size (undefined :: n) - 1) :: 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 + else if val1 <= -precision then minBound + else fromInteger val1 -instance (Size ix) => Eq (Sampled m ix) where +instance (SingI ix) => Eq (Sampled m ix) where (Sampled a _) == (Sampled b _) = a == b -instance (Size ix) => Ord (Sampled m ix) where +instance (SingI ix) => Ord (Sampled m ix) where (Sampled a _) `compare` (Sampled b _) = a `compare` b -instance (Size ix) => Show (Sampled m ix) where +instance (SingI ix) => Show (Sampled m ix) where show (Sampled _ s) = show (fromRational s :: Double) -instance (Size ix, Size m) => Read (Sampled m ix) where +instance (SingI ix, SingI m) => Read (Sampled m ix) where readsPrec i str = [ (mkSampled a,r) | (a,r) <- readsPrec i str ] -instance (Size ix, Size m) => Num (Sampled m ix) where +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 @@ -57,23 +55,21 @@ signum (Sampled _ n) = mkSampled $ signum n fromInteger n = mkSampled (fromInteger n) -instance (Size ix, Size m) => Real (Sampled m ix) where +instance (SingI ix, SingI m) => Real (Sampled m ix) where toRational (Sampled _ n) = toRational n - -instance (Size ix, Size m) => Fractional (Sampled m ix) where + +instance (SingI ix, SingI m) => Fractional (Sampled m ix) where 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 (Size ix, Size m) => Enum (Sampled m ix) where +instance (SingI ix, SingI m) => Enum (Sampled m ix) where 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 (size (undefined :: m)) + scale = fromIntegral (fromNat (sing :: Sing m)) precision :: Integer - precision = 2 ^ (fromIntegral (size (undefined :: ix) - 1) :: Integer) - - + precision = 2 ^ (fromIntegral (fromNat (sing :: Sing ix) - 1) :: Integer) diff --git a/Data/Sized/Signed.hs b/Data/Sized/Signed.hs --- a/Data/Sized/Signed.hs +++ b/Data/Sized/Signed.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable #-} -- | Signed, fixed sized numbers. -- @@ -11,118 +11,128 @@ module Data.Sized.Signed ( Signed - , toMatrix - , fromMatrix + , 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.Ix -import Data.List as L +import Data.Sized.Fin import Data.Bits +import Data.Typeable -newtype Signed ix = Signed Integer +newtype Signed (ix :: Nat) = Signed Integer + deriving (Eq, Ord, Typeable) --- 'toMatrix' turns a sized 'Signed' value into a 'Matrix' of 'Bool's. -toMatrix :: forall ix . (Size ix) => Signed ix -> Matrix ix Bool -toMatrix s@(Signed v) = matrix $ take (size (error "toMatrix" :: ix)) $ map odd $ iterate (`div` 2) v +-- 'toVector' turns a sized 'Signed' value into a 'Vector' of 'Bool's. +toVector :: forall ix . (SingI ix) => Signed ix -> Vector ix Bool +toVector (Signed v) = matrix $ take (fromIntegral $ fromSing (sing :: Sing ix)) $ map odd $ iterate (`div` 2) v --- 'toMatrix' turns a a 'Matrix' of 'Bool's into sized 'Signed' value. -fromMatrix :: (Size ix) => Matrix ix Bool -> Signed ix -fromMatrix m = mkSigned $ +-- '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) - (M.toList m) + (elems m) , b ] -- -mkSigned :: forall ix . (Size ix) => Integer -> Signed ix +mkSigned :: forall ix . (SingI ix) => Integer -> Signed ix mkSigned v = res - where sz' = 2 ^ (fromIntegral bitCount :: Integer) - bitCount = size (error "mkUnsigned" :: ix) - 1 - res = case divMod v sz' of - (s,v') | even s -> Signed v' - | otherwise -> Signed (v' - sz') + 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') -instance (Size ix) => Eq (Signed ix) where - (Signed a) == (Signed b) = a == b -instance (Size ix) => Ord (Signed ix) where - (Signed a) `compare` (Signed b) = a `compare` b -instance (Size ix) => Show (Signed ix) where +instance (SingI ix) => Show (Signed ix) where show (Signed a) = show a -instance (Enum ix, Size ix) => Read (Signed ix) where + +instance (SingI ix) => Read (Signed ix) where readsPrec i str = [ (mkSigned a,r) | (a,r) <- readsPrec i str ] -instance (Size ix) => Integral (Signed ix) where + +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) -instance (Size ix) => Num (Signed ix) where + +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 -instance (Size ix) => Real (Signed ix) where + +instance (SingI ix) => Real (Signed ix) where toRational (Signed n) = toRational n -instance (Size ix) => Enum (Signed ix) where + +instance (SingI ix) => Enum (Signed ix) where fromEnum (Signed n) = fromEnum n toEnum n = mkSigned (toInteger n) -instance (Size ix, Integral ix) => Bits (Signed ix) where - bitSize s = size (undefined :: ix) - bitSizeMaybe = Just . bitSize - complement = fromMatrix . fmap not . toMatrix + +instance (SingI ix) => Bits (Signed ix) where + bitSizeMaybe = return . finiteBitSize + bitSize = finiteBitSize + complement (Signed v) = Signed (complement v) isSigned _ = True - a `xor` b = fromMatrix (M.zipWith (/=) (toMatrix a) (toMatrix b)) - a .|. b = fromMatrix (M.zipWith (||) (toMatrix a) (toMatrix b)) - a .&. b = fromMatrix (M.zipWith (&&) (toMatrix a) (toMatrix b)) + 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 = fromMatrix (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.length m))) - where m = toMatrix v - testBit u idx = toMatrix u ! (fromIntegral idx) -instance (Size ix, Integral ix) => FiniteBits (Signed ix) where - finiteBitSize s = size (undefined :: ix) + 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 -instance forall ix . (Size ix) => Bounded (Signed ix) where +instance (SingI ix) => FiniteBits (Signed ix) where + finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix)) + +instance forall ix . (SingI ix) => Bounded (Signed ix) where minBound = Signed (- maxMagnitude) - where maxMagnitude = 2 ^ (size (error "Bounded/Signed" :: ix) -1) + where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1) maxBound = Signed (maxMagnitude - 1) - where maxMagnitude = 2 ^ (size (error "Bounded/Signed" :: ix) -1) + where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1) -type S2 = Signed X2 -type S3 = Signed X3 -type S4 = Signed X4 -type S5 = Signed X5 -type S6 = Signed X6 -type S7 = Signed X7 -type S8 = Signed X8 -type S9 = Signed X9 -type S10 = Signed X10 -type S11 = Signed X11 -type S12 = Signed X12 -type S13 = Signed X13 -type S14 = Signed X14 -type S15 = Signed X15 -type S16 = Signed X16 -type S17 = Signed X17 -type S18 = Signed X18 -type S19 = Signed X19 -type S20 = Signed X20 -type S21 = Signed X21 -type S22 = Signed X22 -type S23 = Signed X23 -type S24 = Signed X24 -type S25 = Signed X25 -type S26 = Signed X26 -type S27 = Signed X27 -type S28 = Signed X28 -type S29 = Signed X29 -type S30 = Signed X30 -type S31 = Signed X31 -type S32 = Signed X32 +type S2 = Signed 2 +type S3 = Signed 3 +type S4 = Signed 4 +type S5 = Signed 5 +type S6 = Signed 6 +type S7 = Signed 7 +type S8 = Signed 8 +type S9 = Signed 9 +type S10 = Signed 10 +type S11 = Signed 11 +type S12 = Signed 12 +type S13 = Signed 13 +type S14 = Signed 14 +type S15 = Signed 15 +type S16 = Signed 16 +type S17 = Signed 17 +type S18 = Signed 18 +type S19 = Signed 19 +type S20 = Signed 20 +type S21 = Signed 21 +type S22 = Signed 22 +type S23 = Signed 23 +type S24 = Signed 24 +type S25 = Signed 25 +type S26 = Signed 26 +type S27 = Signed 27 +type S28 = Signed 28 +type S29 = Signed 29 +type S30 = Signed 30 +type S31 = Signed 31 +type S32 = Signed 32 diff --git a/Data/Sized/Sparse/Matrix.hs b/Data/Sized/Sparse/Matrix.hs --- a/Data/Sized/Sparse/Matrix.hs +++ b/Data/Sized/Sparse/Matrix.hs @@ -1,5 +1,5 @@ -- | Sparse Matrix. --- +-- -- Copyright: (c) 2009 University of Kansas -- License: BSD3 -- @@ -7,58 +7,62 @@ -- Stability: unstable -- Portability: ghc -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables, + UndecidableInstances, MultiParamTypeClasses, TypeOperators, DataKinds #-} module Data.Sized.Sparse.Matrix where - -import Data.Sized.Ix as X + +import Data.Array.Base as B +import Data.Ix +import Data.Sized.Fin as X import qualified Data.Sized.Matrix as M import qualified Data.Map as Map import Data.Map (Map) import qualified Data.Set as Set import Data.Set (Set) import Control.Applicative - -data Matrix ix a = Matrix a (Map ix a) -instance Functor (Matrix ix) where - fmap f (Matrix d mp) = Matrix (f d) (fmap f mp) +data SpMatrix ix a = SpMatrix a (Map ix a) --- 'fromAssocList' generates a sparse matrix. -fromAssocList :: (Ord i, Eq a) => a -> [(i,a)] -> Matrix i a -fromAssocList d xs = Matrix d (Map.fromList [ (i,a) | (i,a) <- xs, a /= d ]) +instance Functor (SpMatrix ix) where + fmap f (SpMatrix d mp) = SpMatrix (f d) (fmap f mp) -toAssocList :: (Matrix i a) -> (a,[(i,a)]) -toAssocList (Matrix d mp) = (d,Map.toList mp) +-- 'fromAssocList' generates a sparse matrix. +fromAssocList :: (Ord i, Eq a) => a -> [(i,a)] -> SpMatrix i a +fromAssocList d xs = SpMatrix d (Map.fromList [ (i,a) | (i,a) <- xs, a /= d ]) --- | '!' looks up an element in the sparse matrix. If the element is not found --- in the sparse matrix, '!' returns the default value. -(!) :: (Ord ix) => Matrix ix a -> ix -> a -(!) (Matrix d sm) ix = Map.findWithDefault d ix sm +toAssocList :: (SpMatrix i a) -> (a,[(i,a)]) +toAssocList (SpMatrix d mp) = (d,Map.toList mp) -fill :: (Size ix) => Matrix ix a -> M.Matrix ix a -fill sm = M.forAll $ \ i -> sm ! i +-- | 'getElem' looks up an element in the sparse matrix. If the element is not found +-- in the sparse matrix, 'getElem' returns the default value. +getElem :: (Ord ix) => SpMatrix ix a -> ix -> a +getElem (SpMatrix d sm) ix = Map.findWithDefault d ix sm +fill :: (Bounded ix, Ix ix) => SpMatrix ix a -> M.Matrix ix a +fill sm = M.forAll $ \ i -> getElem sm i + -- Might be just internal, because nothing else leaks defaults. -prune :: (Size ix, Eq a) => a -> Matrix ix a -> Matrix ix a -prune d sm@(Matrix d' m) | d == d' = Matrix d (Map.filter (/= d) m) +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 -- | Make a Matrix sparse, with a default 'zero' value. -sparse :: (Size ix, Eq a) => a -> M.Matrix ix a -> Matrix ix a -sparse d other = Matrix d (Map.fromList [ (i,v) | (i,v) <- M.assocs other, v /= d ]) +sparse :: (Bounded ix, Ix ix, Eq a) => a -> M.Matrix ix a -> SpMatrix ix a +sparse d other = SpMatrix d (Map.fromList [ (i,v) | (i,v) <- assocs other, v /= d ]) -mm :: (Size m, Size n, Size m', Size n', n ~ m', Eq a, Num a) => Matrix (m,n) a -> Matrix (m',n') a -> Matrix (m,n') a -mm s1 s2 = Matrix 0 mp +mm :: (Bounded m, Ix m, Bounded n, Ix n, Bounded m', Ix m', Bounded n', Ix n', n ~ m', Num a, Eq a) => + 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.all - , let s = (rs M.! x) `Set.intersection` (cs M.! y) + | (x,y) <- X.universe + , let s = (rs B.! x) `Set.intersection` (cs B.! y) , not (Set.null s) - , let v = foldb1 (+) [ s1 ! (x,k) * s2 ! (k,y) | k <- Set.toList s ] + , let v = foldb1 (+) [(getElem s1 (x,k)) * (getElem s2 (k,y)) | k <- Set.toList s ] , v /= 0 - ] - (Matrix _ mp1) = prune 0 s1 - (Matrix _ mp2) = prune 0 s2 + ] + (SpMatrix _ mp1) = prune 0 s1 + (SpMatrix _ mp2) = prune 0 s2 rs = rowSets (Map.keysSet mp1) cs = columnSets (Map.keysSet mp2) @@ -69,27 +73,25 @@ -rowSets :: (Size a, Ord b) => Set (a,b) -> M.Matrix a (Set b) -rowSets set = M.accum f (pure Set.empty) (Set.toList set) +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' - -columnSets :: (Size b, Ord a) => Set (a,b) -> M.Matrix b (Set a) + +columnSets :: (Bounded b, Ix b, Ord a) => Set (a,b) -> M.Matrix b (Set a) columnSets = rowSets . Set.map (\ (a,b) -> (b,a)) -instance (Size i) => Applicative (Matrix i) where - pure a = Matrix a (Map.empty) - sm1@(Matrix d1 m1) <*> sm2@(Matrix d2 m2) - = Matrix (d1 d2) (Map.fromList [ (k,(sm1 ! k) (sm2 ! k)) | k <- Set.toList keys ]) +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 -instance (Show a, Size ix) => Show (Matrix ix a) where - show m = show (fill m) +instance (Show a, Show ix, Bounded ix, Ix ix) => Show (SpMatrix ix a) where + show m = show (fill m) -transpose :: (Size x, Size y, Eq a) => Matrix (x,y) a -> Matrix (y,x) a -transpose (Matrix d m) = Matrix d (Map.fromList [ ((y,x),a) | ((x,y),a) <- Map.assocs m ]) +transpose :: (Bounded x, Ix x, Bounded y, Ix y, Eq a) => SpMatrix (x,y) a -> SpMatrix (y,x) a +transpose (SpMatrix d m) = SpMatrix d (Map.fromList [ ((y,x),a) | ((x,y),a) <- Map.assocs m ]) -zipWith :: (Size x) => (a -> b -> c) -> Matrix x a -> Matrix x b -> Matrix x c -zipWith f m1 m2 = pure f <*> m1 <*> m2 - - +zipWith :: (Bounded x, Ix x) => (a -> b -> c) -> SpMatrix x a -> SpMatrix x b -> SpMatrix x c +zipWith f m1 m2 = pure f <*> m1 <*> m2 diff --git a/Data/Sized/Unsigned.hs b/Data/Sized/Unsigned.hs --- a/Data/Sized/Unsigned.hs +++ b/Data/Sized/Unsigned.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable #-} -- | Unsigned, fixed sized numbers. -- @@ -11,90 +11,108 @@ module Data.Sized.Unsigned ( Unsigned - , toMatrix - , fromMatrix + , 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.Ix +import Data.Sized.Fin import Data.Bits import Data.Ix +import Data.Typeable -newtype Unsigned ix = Unsigned Integer +newtype Unsigned (ix :: Nat) = Unsigned Integer + deriving (Eq, Ord, Typeable) -toMatrix :: forall ix . (Size ix) => Unsigned ix -> Matrix ix Bool -toMatrix (Unsigned v) = matrix $ take (size (error "toMatrix" :: ix)) $ map odd $ iterate (`div` 2) v +-- 'toVector' turns a sized 'Unsigned' value into a 'Vector' of 'Bool's. +toVector :: forall ix . (SingI ix) => Unsigned ix -> Vector ix Bool +toVector (Unsigned v) = matrix $ take (fromIntegral $ fromSing (sing :: Sing ix)) $ map odd $ iterate (`div` 2) v -fromMatrix :: (Size ix) => Matrix ix Bool -> Unsigned ix -fromMatrix m = mkUnsigned $ +-- '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) - (M.toList m) + (elems m) , b ] -mkUnsigned :: forall ix . (Size ix) => Integer -> Unsigned ix -mkUnsigned v = res - where sz' = 2 ^ (fromIntegral bitCount :: Integer) - bitCount = size (error "mkUnsigned" :: ix) - res = Unsigned (v `mod` sz') +mkUnsigned :: forall ix . (SingI ix) => Integer -> Unsigned ix +mkUnsigned x = Unsigned (x `mod` (2 ^ bitCount)) + where bitCount = fromNat (sing :: Sing ix) -instance (Size ix) => Eq (Unsigned ix) where - (Unsigned a) == (Unsigned b) = a == b -instance (Size ix) => Ord (Unsigned ix) where - (Unsigned a) `compare` (Unsigned b) = a `compare` b -instance (Size ix) => Show (Unsigned ix) where +instance Show (Unsigned ix) where show (Unsigned a) = show a -instance (Size ix) => Read (Unsigned ix) where + +instance (SingI ix) => Read (Unsigned ix) where readsPrec i str = [ (mkUnsigned a,r) | (a,r) <- readsPrec i str ] -instance (Size ix) => Integral (Unsigned ix) where + +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) -instance (Size ix) => Num (Unsigned ix) where + (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 -instance (Size ix) => Real (Unsigned ix) where + +instance (SingI ix) => Real (Unsigned ix) where toRational (Unsigned n) = toRational n -instance (Size ix) => Enum (Unsigned ix) where + +instance (SingI ix) => Enum (Unsigned ix) where fromEnum (Unsigned n) = fromEnum n toEnum n = mkUnsigned (toInteger n) -instance (Size ix, Integral ix) => Bits (Unsigned ix) where - bitSize s = size (undefined :: ix) - bitSizeMaybe = Just . bitSize - complement = fromMatrix . fmap not . toMatrix + +instance (SingI ix) => Bits (Unsigned ix) where + bitSizeMaybe = return . finiteBitSize + bitSize = finiteBitSize + complement (Unsigned v) = Unsigned (complement v) isSigned _ = False - a `xor` b = fromMatrix (M.zipWith (/=) (toMatrix a) (toMatrix b)) - a .|. b = fromMatrix (M.zipWith (||) (toMatrix a) (toMatrix b)) - a .&. b = fromMatrix (M.zipWith (&&) (toMatrix a) (toMatrix b)) - shiftL (Unsigned v) i = mkUnsigned (v * (2 ^ i)) - shiftR (Unsigned v) i = mkUnsigned (v `div` (2 ^ i)) + (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 v i = fromMatrix (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.length m))) - where m = toMatrix v - testBit u idx = toMatrix u ! (fromIntegral idx) -instance (Size ix, Integral ix) => FiniteBits (Unsigned ix) where - finiteBitSize s = size (undefined :: ix) +-- rotate (Ui i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.population m))) +-- where m = toVector v -instance forall ix . (Size ix) => Bounded (Unsigned ix) where - minBound = Unsigned 0 - maxBound = Unsigned (2 ^ (size (error "Bounded/Unsigned" :: ix)) - 1) + rotate v i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` mLeng))) + where m = toVector v + mLeng = size $ M.zeroOf m --- Unsigned ix as member of Size class. --- We do not address efficiency in this implementation. + 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 -type instance Index (Unsigned ix) = Int +instance (SingI ix) => FiniteBits (Unsigned ix) where + finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix)) -instance forall ix . (Size ix) => Ix (Unsigned ix) where +showBits :: (SingI ix) => Unsigned ix -> String +showBits u = "0b" ++ reverse + [ if testBit u i then '1' else '0' + | i <- [0..(finiteBitSize u - 1)] + ] + +instance (SingI ix) => Bounded (Unsigned ix) where + 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 range (l, u) = [l .. u] inRange (l, u) v = (l <= v) && (v <= u) index (l, u) v | inRange (l,u) v = fromIntegral (v - l) @@ -102,43 +120,38 @@ rangeSize (l, u) | l <= u = fromIntegral $ (toInteger u) - (toInteger l) + 1 | otherwise = 0 -instance forall ix . (Size ix) => Size (Unsigned ix) where - size = const s - where s = fromIntegral $ toInteger (maxBound :: Unsigned ix) + 1 - addIndex v n = v + (fromIntegral n) -- fix bounds issues - toIndex v = fromIntegral v -- | common; numerically boolean. -type U1 = Unsigned X1 +type U1 = Unsigned 1 -type U2 = Unsigned X2 -type U3 = Unsigned X3 -type U4 = Unsigned X4 -type U5 = Unsigned X5 -type U6 = Unsigned X6 -type U7 = Unsigned X7 -type U8 = Unsigned X8 -type U9 = Unsigned X9 -type U10 = Unsigned X10 -type U11 = Unsigned X11 -type U12 = Unsigned X12 -type U13 = Unsigned X13 -type U14 = Unsigned X14 -type U15 = Unsigned X15 -type U16 = Unsigned X16 -type U17 = Unsigned X17 -type U18 = Unsigned X18 -type U19 = Unsigned X19 -type U20 = Unsigned X20 -type U21 = Unsigned X21 -type U22 = Unsigned X22 -type U23 = Unsigned X23 -type U24 = Unsigned X24 -type U25 = Unsigned X25 -type U26 = Unsigned X26 -type U27 = Unsigned X27 -type U28 = Unsigned X28 -type U29 = Unsigned X29 -type U30 = Unsigned X30 -type U31 = Unsigned X31 -type U32 = Unsigned X32 +type U2 = Unsigned 2 +type U3 = Unsigned 3 +type U4 = Unsigned 4 +type U5 = Unsigned 5 +type U6 = Unsigned 6 +type U7 = Unsigned 7 +type U8 = Unsigned 8 +type U9 = Unsigned 9 +type U10 = Unsigned 10 +type U11 = Unsigned 11 +type U12 = Unsigned 12 +type U13 = Unsigned 13 +type U14 = Unsigned 14 +type U15 = Unsigned 15 +type U16 = Unsigned 16 +type U17 = Unsigned 17 +type U18 = Unsigned 18 +type U19 = Unsigned 19 +type U20 = Unsigned 20 +type U21 = Unsigned 21 +type U22 = Unsigned 22 +type U23 = Unsigned 23 +type U24 = Unsigned 24 +type U25 = Unsigned 25 +type U26 = Unsigned 26 +type U27 = Unsigned 27 +type U28 = Unsigned 28 +type U29 = Unsigned 29 +type U30 = Unsigned 30 +type U31 = Unsigned 31 +type U32 = Unsigned 32 diff --git a/Data/Sized/Vector.hs b/Data/Sized/Vector.hs deleted file mode 100644 --- a/Data/Sized/Vector.hs +++ /dev/null @@ -1,107 +0,0 @@ - -{-# LANGUAGE TypeFamilies, EmptyDataDecls, UndecidableInstances, FlexibleInstances, OverlappingInstances #-} - -module Data.Sized.Vector where - -import qualified Data.Array as A -import qualified Data.List as L - -data Vector ix a = Vector (A.Array ix a) --- deriving Show - -vector :: (Bounds ix) => ix -> [a] -> Vector ix a -vector ix vals = Vector (A.listArray (toBounds ix) vals) - -instance (Bounds ix) => Functor (Vector ix) where - fmap f (Vector xs) = Vector (fmap f xs) - -class (A.Ix ix) => Bounds ix where - toBounds :: ix -> (ix,ix) - fromBounds :: (ix,ix) -> ix - range :: (ix,ix) -> [ix] - -instance Bounds Int where - toBounds ix = (0,ix - 1) - fromBounds (low,high) = (high - low) + 1 - range (low,high) = [low..high] - -instance (Bounds a, Bounds b) => Bounds (a,b) where - toBounds (ix1,ix2) = ((l1,l2),(h1,h2)) - where (l1,h1) = toBounds ix1 - (l2,h2) = toBounds ix2 - fromBounds ((l1,l2),(h1,h2)) = (ix1,ix2) - where ix1 = fromBounds (l1,h1) - ix2 = fromBounds (l2,h2) - range ((l1,l2),(h1,h2)) = [(x,y) | x <- range (l1,h1), y <- range (l2,h2)] - -(!) :: (Bounds ix) => Vector ix a -> ix -> a -(!) (Vector a) x = a A.! x - -toList :: (Bounds ix) => Vector ix a -> [a] -toList (Vector a) = A.elems a - -assocs :: (Bounds ix) => Vector ix a -> [(ix,a)] -assocs (Vector a) = A.assocs a - -size :: Bounds ix => Vector ix a -> ix -size (Vector a) = fromBounds $ A.bounds a - -bounds v = toBounds $ size v - -indices :: (Bounds ix) => Vector ix a -> [ix] -indices (Vector a) = A.indices a - -ixmap :: (Bounds i, Bounds j) => i -> (i -> j) -> Vector j a -> Vector i a -ixmap b f v = vector b [v ! f idx | idx <- range (toBounds b)] - -transpose :: (Bounds x, Bounds y) => Vector (x,y) a -> Vector (y,x) a -transpose v = ixmap (y',x') (\ (x,y) -> (y,x)) v - where (x',y') = size v - -identity :: (Bounds ix, Num a) => ix -> Vector (ix,ix) a -identity ix = vector (ix,ix) [if x == y then 1 else 0 | (x,y) <- range $ toBounds (ix,ix)] - -rows :: (Bounds x, Bounds y) => Vector (x,y) a -> Vector x (Vector y a) -rows v = vector xmax $ map (vector ymax) [[v ! (x,y) | y <- range (yl,yh)] | x <- range (xl,xh)] - where (xmax,ymax) = size v - ((xl,yl),(xh,yh)) = bounds v - -cols :: (Bounds x, Bounds y) => Vector (x,y) a -> Vector y (Vector x a) -cols v = vector ymax $ map (vector xmax) [[v ! (x,y) | x <- range (xl,xh)] | y <- range (yl,yh)] - where (xmax,ymax) = size v - ((xl,yl),(xh,yh)) = bounds v - -above :: (Bounds x, Bounds y, Num x, Num y) => Vector (x,y) a -> Vector (x,y) a -> Vector (x,y) a -above v1 v2 | numcols v1 == numcols v2 = vector (numrows v1 + numrows v2, numcols v1) xs - | otherwise = error "Column count mismatch" - where numcols v = snd $ size v - numrows v = fst $ size v - xs = toList v1 ++ toList v2 - -beside :: (Bounds x, Bounds y, Num x, Num y) => Vector (x,y) a -> Vector (x,y) a -> Vector (x,y) a -beside v1 v2 = transpose $ transpose v1 `above` transpose v2 - -show' v = showMatrix' (size v) (foo v) - -foo v = toList $ fmap toList $ rows $ fmap show v - - -seeIn2D :: (Bounds ix, Num ix) => Vector ix a -> Vector (ix,ix) a -seeIn2D v = vector (1,size v) (toList v) - - -instance (Show a, Bounds ix) => Show (Vector (ix,ix) a) where show vector = show' vector -instance (Show a, Bounds ix, Num ix) => Show (Vector ix a) where show vector = show' $ seeIn2D vector - - ---instance (Show a, Size ix,Size (Row ix), Size (Column ix)) => Show (Vector ix a) where --- show arr = showMatrix' (fmap show (ixmap seeIn2D arr)) - -showMatrix' :: (Bounds ix) => (ix,ix) -> [[String]] -> String -showMatrix' (x,y) m = joinLines $ L.zipWith showRow m (map (const False) (init m) ++ [True]) - where - joinLines = unlines . L.zipWith (++) ("[":repeat " ") - showRow r f = concat (L.zipWith3 showEle r m_cols_size (map (const False) (init r) ++ [f])) - showEle str s f = take (s - L.length str) (cycle " ") ++ " " ++ str ++ (if f then " ]" else ",") - m_cols = L.transpose m - m_cols_size = fmap (maximum . map L.length) m_cols diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,6 +1,2 @@ -module Main (main) where - import Distribution.Simple - -main :: IO () main = defaultMain diff --git a/qc/QC.hs b/qc/QC.hs --- a/qc/QC.hs +++ b/qc/QC.hs @@ -1,21 +1,21 @@ -- Copy this module if you need Quick Check. -module QC where +module QC.QC where import qualified Test.QuickCheck as QC -import Data.Sized.Ix() -import Data.Sized.Matrix as M -import Data.Sized.Arith +import Data.Ix -instance Size n => QC.Arbitrary (X0_ n) where +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 Size n => QC.Arbitrary (X1_ n) where - arbitrary = QC.elements [minBound .. maxBound] -instance (QC.Arbitrary ix, Size ix, QC.Arbitrary a) => QC.Arbitrary (Matrix ix a) where +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 :: (Size ix) => ([ix] -> m (Matrix ix a)) -> m (Matrix ix a) - f fn = fn M.all + where f :: (Bounded ix, Ix ix) => ([ix] -> m (Matrix ix a)) -> m (Matrix ix a) + f fn = fn (allIndices (undefined :: Matrix ix a)) diff --git a/sized-types.cabal b/sized-types.cabal --- a/sized-types.cabal +++ b/sized-types.cabal @@ -1,13 +1,13 @@ Name: sized-types -Version: 0.3.5.2 -Synopsis: Sized types in Haskell. -Description: Providing indices, matrixes, sparse matrixes, and signed and unsigned bit vectors. +Version: 0.5.0 +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 License: BSD3 License-file: LICENSE -Author: Andy Gill, Tristan Bull +Author: Andy Gill Maintainer: Andy Gill -Copyright: (c) 2009 The University of Kansas +Copyright: (c) 2009-2013 The University of Kansas Homepage: http://www.ittc.ku.edu/csdl/fpg/Tools Stability: beta build-type: Simple @@ -18,49 +18,41 @@ Default: False Library - Build-Depends: base >= 4.7 && < 5, containers, array + Build-Depends: + base >= 4.7 && < 5, + array == 0.5.*, + containers == 0.5.*, + singletons == 0.10.* Exposed-modules: - Data.Sized.Arith, - Data.Sized.Ix, + Data.Sized.Fin, Data.Sized.Matrix, Data.Sized.Sparse.Matrix, Data.Sized.Signed, Data.Sized.Unsigned, - Data.Sized.Vector, Data.Sized.Sampled - Ghc-Options: -Wall + Ghc-Options: -Wall -O2 Executable sized-types-test1 - if flag(all) - Build-Depends: base, QuickCheck >= 2.0 - buildable: True - Other-modules: - QC - else - Build-depends: base - buildable: False - Main-Is: Test1.hs - Hs-Source-Dirs: ., test, qc - Ghc-Options: -Wall + if flag(all) + Build-Depends: base, QuickCheck >= 2.0 + buildable: True + Other-modules: + QC + else + Build-depends: base + buildable: False + Main-Is: Test1.hs + Hs-Source-Dirs: ., test, qc + Ghc-Options: -Wall Executable sized-types-example1 - if flag(all) - Build-Depends: base - buildable: True - else - Build-depends: base - buildable: False - Main-Is: Example1.hs - Hs-Source-Dirs: ., test - Ghc-Options: -Wall - -source-repository head - type: git - location: git://github.com/ku-fpg/sized-types - -source-repository this - type: git - location: git://github.com/ku-fpg/sized-types - branch: sized-types-0.3 - tag: 0.3.5.1 + if flag(all) + Build-Depends: base + buildable: True + else + Build-depends: base + buildable: False + Main-Is: Example1.hs + Hs-Source-Dirs: ., test + Ghc-Options: -Wall diff --git a/test/Example1.hs b/test/Example1.hs --- a/test/Example1.hs +++ b/test/Example1.hs @@ -1,10 +1,18 @@ +{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators #-} + module Main where +import Data.Sized.Fin import Data.Sized.Matrix import Data.Sized.Signed as S import Data.Sized.Unsigned as U import Control.Applicative +-- NatType equivalences required for the above and beside tests. +--type instance (3 + 3) = 6 +--type instance (4 + 4) = 8 + + main :: IO () main = do print example1 @@ -18,48 +26,50 @@ print $ example4 print $ example5 print $ example6 - print $ example7 - print $ example8 + 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 - - let s :: [Signed X4] + 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 u :: [Unsigned X4] + let u :: [Unsigned 4] u = [ x * y | x <- [1..5], y <- [0..5]] print u - - print $ fmap S.toMatrix s - print $ fmap U.toMatrix u - -example1 :: Matrix (X5,X5) Int + print $ fmap S.toVector s + print $ fmap U.toVector u + + +example1 :: Matrix (Fin 5,Fin 5) Int example1 = identity -example2 :: Matrix (X3,X4) Int +example2 :: Matrix (Fin 3,Fin 4) Int example2 = matrix [1..12] -example3 :: Matrix (X4,X5) Double +example3 :: Matrix (Fin 4,Fin 5) Double example3 = pure 1.2 -example4 :: Matrix (X4,X5) (X4,X5) +example4 :: Matrix (Fin 4,Fin 5) (Fin 4,Fin 5) example4 = coord -- also works in 2D -example5 :: Matrix X6 Bool +example5 :: Matrix (Fin 6) Bool example5 = forAll $ \ i -> i > 3 -example6 :: Matrix (X3,X4) Int -example6 = forEach example2 $ \ (i,j) a -> +example6 :: Matrix (Fin 3,Fin 4) Int +example6 = forEach example2 $ \ (i,j) a -> if i == 0 || j == 0 then a else 0 - -example7 :: Matrix (X10,X10) Int + +example7 :: Matrix (Fin 10,Fin 10) Int example7 = matrix [1..100] -example8 :: Matrix (X4,X5) Int -example8 = example7 `cropAt` (2,3) +-- cropAt function no longer supported +-- example8 :: Matrix (Fin 4,Fin 5) Int +-- example8 = example7 `cropAt` (2,3) diff --git a/test/Test1.hs b/test/Test1.hs --- a/test/Test1.hs +++ b/test/Test1.hs @@ -1,36 +1,47 @@ +{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators #-} + module Main where - -import Data.Sized.Ix + import Data.Sized.Matrix +import QC.QC() import Test.QuickCheck as QC -import QC -import qualified Data.Sized.Sparse.Matrix as SM -import Control.Applicative -import Data.Sized.Arith +-- import qualified Data.Sized.Sparse.Matrix as SM -import Data.Array +-- NatType equivalences required for the join tests. +--type instance (4 + 5) = 9 +--type instance (3 + 7) = 10 + -- Small first cut at tests. +main :: IO () main = do quickCheck prop_mm1 quickCheck prop_fmap1 quickCheck prop_joins putStrLn "[Done]" +prop_mm1 :: Vector2 3 4 Int + -> Vector2 4 5 Int + -> Vector2 5 2 Int + -> Bool prop_mm1 m1 m2 m3 = ((m1 `mm` m2) `mm` m3) == (m1 `mm` (m2 `mm` m3)) where - _types = (m1 :: Matrix (X3,X4) Int, - m2 :: Matrix (X4,X5) Int, - m3 :: Matrix (X5,X2) Int) - -prop_fmap1 m1 = fmap (+1) m1 == forEach m1 (\ i a -> a + 1) + _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 :: Matrix (X9,X29) Int) + _types = (m1 :: Vector2 9 29 Int) +prop_joins :: Vector2 3 4 Int + -> Vector2 3 5 Int + -> Vector2 7 4 Int + -> 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) - where _types = (m1 :: Matrix (X3,X4) Int, - m4 :: Matrix (X7,X5) Int) - - + where _types = (m1 :: Vector2 3 4 Int, + m4 :: Vector2 7 5 Int)