module Data.Vector.Fixed (
Dim
, Z
, S
, N1
, N2
, N3
, N4
, N5
, N6
, Vector(..)
, VectorN
, Arity
, Fun(..)
, length
, convertContinuation
, New
, vec
, con
, (|>)
, replicate
, replicateM
, basis
, generate
, generateM
, head
, tail
, tailWith
, (!)
, eq
, map
, mapM
, mapM_
, imap
, imapM
, imapM_
, sequence
, sequence_
, foldl
, foldl1
, foldM
, ifoldl
, ifoldM
, sum
, maximum
, minimum
, zipWith
, zipWithM
, izipWith
, izipWithM
, convert
, toList
, fromList
, VecList(..)
) where
import Data.Vector.Fixed.Internal
import qualified Prelude as P
import Prelude hiding ( replicate,map,zipWith,maximum,minimum
, foldl,foldl1,length,sum
, head,tail,mapM,mapM_,sequence,sequence_
)
type N1 = S Z
type N2 = S N1
type N3 = S N2
type N4 = S N3
type N5 = S N4
type N6 = S N5
convertContinuation :: forall n a r. (Arity n)
=> (forall v. (Dim v ~ n, Vector v a) => v a -> r)
-> Fun n a r
convertContinuation f = fmap f g
where
g = construct :: Fun n a (VecList n a)
newtype New n v a = New (Fn n a (v a))
vec :: New Z v a -> v a
vec (New v) = v
con :: Vector v a => New (Dim v) v a
con = f2n construct
(|>) :: New (S n) v a -> a -> New n v a
New f |> a = New (f a)
infixl 1 |>
f2n :: Fun n a (v a) -> New n v a
f2n (Fun f) = New f
replicate :: Vector v a => a -> v a
replicate x = create $ Cont
$ replicateF x
data T_replicate n = T_replicate
replicateF :: forall n a b. Arity n => a -> Fun n a b -> b
replicateF x (Fun h)
= apply (\T_replicate -> (x, T_replicate))
(T_replicate :: T_replicate n)
h
replicateM :: (Vector v a, Monad m) => m a -> m (v a)
replicateM x = replicateFM x construct
replicateFM :: forall m n a b. (Monad m, Arity n) => m a -> Fun n a b -> m b
replicateFM act (Fun h)
= applyM (\T_replicate -> do { a <- act; return (a, T_replicate) } )
(T_replicate :: T_replicate n)
h
basis :: forall v a. (Vector v a, Num a) => Int -> v a
basis n = create $ Cont
$ basisF n
newtype T_basis n = T_basis Int
basisF :: forall n a b. (Num a, Arity n) => Int -> Fun n a b -> b
basisF n0 (Fun f)
= apply (\(T_basis n) -> ((if n == 0 then 1 else 0) :: a, T_basis (n 1)))
(T_basis n0 :: T_basis n)
f
generate :: forall v a. (Vector v a) => (Int -> a) -> v a
generate f = create $ Cont
$ generateF f
newtype T_generate n = T_generate Int
generateF :: forall n a b. (Arity n) => (Int -> a) -> Fun n a b -> b
generateF g (Fun f)
= apply (\(T_generate n) -> (g n, T_generate (n + 1)))
(T_generate 0 :: T_generate n)
f
generateM :: forall m v a. (Monad m, Vector v a) => (Int -> m a) -> m (v a)
generateM f = generateFM f construct
generateFM :: forall m n a b. (Monad m, Arity n) => (Int -> m a) -> Fun n a b -> m b
generateFM g (Fun f)
= applyM (\(T_generate n) -> do { a <- g n; return (a, T_generate (n + 1)) } )
(T_generate 0 :: T_generate n)
f
head :: (Vector v a, Dim v ~ S n) => v a -> a
head v = inspectV v
$ headF
data T_head a n = T_head (Maybe a)
headF :: forall n a. Arity (S n) => Fun (S n) a a
headF = Fun $ accum (\(T_head m) a -> T_head $ case m of { Nothing -> Just a; x -> x })
(\(T_head (Just x)) -> x)
(T_head Nothing :: T_head a (S n))
tail :: (Vector v a, Vector w a, Dim v ~ S (Dim w))
=> v a -> w a
tail v = create $ Cont
$ inspectV v
. tailF
tailF :: Arity n => Fun n a b -> Fun (S n) a b
tailF (Fun f) = Fun (\_ -> f)
tailWith :: (Arity n, Vector v a, Dim v ~ S n)
=> (forall w. (Vector w a, Dim w ~ n) => w a -> r)
-> v a
-> r
tailWith f v = inspectV v
$ tailF
$ convertContinuation f
(!) :: (Vector v a) => v a -> Int -> a
v ! i = inspectV v
$ elemF i
newtype T_Elem a n = T_Elem (Either Int a)
elemF :: forall n a. Arity n => Int -> Fun n a a
elemF n
| n < 0 = error "Data.Vector.Fixed.!: index out of range"
| otherwise = Fun $ accum
(\(T_Elem x) a -> T_Elem $ case x of
Left 0 -> Right a
Left i -> Left (i 1)
r -> r
)
(\(T_Elem x) -> case x of
Left _ -> error "Data.Vector.Fixed.!: index out of range"
Right a -> a
)
( T_Elem (Left n) :: T_Elem a n)
foldl :: Vector v a => (b -> a -> b) -> b -> v a -> b
foldl f z v = inspectV v
$ foldlF f z
foldM :: (Vector v a, Monad m) => (b -> a -> m b) -> b -> v a -> m b
foldM f x v = foldl go (return x) v
where
go m a = do b <- m
f b a
newtype T_foldl b n = T_foldl b
foldlF :: forall n a b. Arity n => (b -> a -> b) -> b -> Fun n a b
foldlF f b = Fun $ accum (\(T_foldl r) a -> T_foldl (f r a))
(\(T_foldl r) -> r)
(T_foldl b :: T_foldl b n)
foldl1 :: (Vector v a, Dim v ~ S n) => (a -> a -> a) -> v a -> a
foldl1 f v = inspectV v
$ foldl1F f
newtype T_foldl1 a n = T_foldl1 (Maybe a)
foldl1F :: forall n a. (Arity (S n)) => (a -> a -> a) -> Fun (S n) a a
foldl1F f = Fun $ accum (\(T_foldl1 r) a -> T_foldl1 $ Just $ maybe a (flip f a) r)
(\(T_foldl1 (Just x)) -> x)
(T_foldl1 Nothing :: T_foldl1 a (S n))
ifoldl :: Vector v a => (b -> Int -> a -> b) -> b -> v a -> b
ifoldl f z v = inspectV v
$ ifoldlF f z
ifoldM :: (Vector v a, Monad m) => (b -> Int -> a -> m b) -> b -> v a -> m b
ifoldM f x v = ifoldl go (return x) v
where
go m i a = do { b <- m; f b i a }
data T_ifoldl b n = T_ifoldl !Int b
ifoldlF :: forall n a b. Arity n => (b -> Int -> a -> b) -> b -> Fun n a b
ifoldlF f b = Fun $
accum (\(T_ifoldl i r) a -> T_ifoldl (i + 1) (f r i a))
(\(T_ifoldl _ r) -> r)
(T_ifoldl 0 b :: T_ifoldl b n)
sum :: (Vector v a, Num a) => v a -> a
sum = foldl (+) 0
maximum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a
maximum = foldl1 max
minimum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a
minimum = foldl1 min
eq :: (Vector v a, Eq a) => v a -> v a -> Bool
eq v w = inspectV w
$ inspectV v
$ fmap (fmap runID)
$ izipWithFM (\_ a b -> return (a == b))
$ foldlF (&&) True
map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b
map f v = create $ Cont
$ inspectV v
. fmap runID
. mapFM (return . f)
sequence :: (Vector v a, Vector v (m a), Monad m) => v (m a) -> m (v a)
sequence = mapM id
sequence_ :: (Vector v (m a), Monad m) => v (m a) -> m ()
sequence_ = mapM_ id
mapM :: (Vector v a, Vector v b, Monad m) => (a -> m b) -> v a -> m (v b)
mapM f v = inspectV v
$ mapFM f
$ construct
mapM_ :: (Vector v a, Monad m) => (a -> m b) -> v a -> m ()
mapM_ f = foldl (\m a -> m >> f a >> return ()) (return ())
newtype T_map b c n = T_map (Fn n b c)
mapFM :: forall m n a b c. (Arity n, Monad m) => (a -> m b) -> Fun n b c -> Fun n a (m c)
mapFM f (Fun h) = Fun $ accumM (\(T_map g) a -> do { b <- f a; return (T_map (g b)) })
(\(T_map g) -> return g)
(return $ T_map h :: m (T_map b c n))
imap :: (Vector v a, Vector v b) =>
(Int -> a -> b) -> v a -> v b
imap f v = create $ Cont
$ inspectV v
. fmap runID
. imapFM (\i a -> return $ f i a)
imapM :: (Vector v a, Vector v b, Monad m) =>
(Int -> a -> m b) -> v a -> m (v b)
imapM f v = inspectV v
$ imapFM f
$ construct
imapM_ :: (Vector v a, Monad m) => (Int -> a -> m b) -> v a -> m ()
imapM_ f = ifoldl (\m i a -> m >> f i a >> return ()) (return ())
data T_imap b c n = T_imap !Int (Fn n b c)
imapFM :: forall m n a b c. (Arity n, Monad m)
=> (Int -> a -> m b) -> Fun n b c -> Fun n a (m c)
imapFM f (Fun h) = Fun $
accumM (\(T_imap i g) a -> do b <- f i a
return (T_imap (i + 1) (g b)))
(\(T_imap _ g) -> return g)
(return $ T_imap 0 h :: m (T_imap b c n))
zipWith :: (Vector v a, Vector v b, Vector v c)
=> (a -> b -> c) -> v a -> v b -> v c
zipWith f v u = create $ Cont
$ inspectV u
. inspectV v
. (fmap (fmap runID))
. izipWithFM (\_ a b -> return (f a b))
zipWithM :: (Vector v a, Vector v b, Vector v c, Monad m)
=> (a -> b -> m c) -> v a -> v b -> m (v c)
zipWithM f v u = inspectV u
$ inspectV v
$ izipWithFM (const f)
$ construct
izipWith :: (Vector v a, Vector v b, Vector v c)
=> (Int -> a -> b -> c) -> v a -> v b -> v c
izipWith f v u = create $ Cont
$ inspectV u
. inspectV v
. fmap (fmap runID)
. izipWithFM (\i a b -> return $ f i a b)
izipWithM :: (Vector v a, Vector v b, Vector v c, Monad m)
=> (Int -> a -> b -> m c) -> v a -> v b -> m (v c)
izipWithM f v u = inspectV u
$ inspectV v
$ izipWithFM f
$ construct
data T_izip a c r n = T_izip Int (VecList n a) (Fn n c r)
izipWithFM :: forall m n a b c d. (Arity n, Monad m)
=> (Int -> a -> b -> m c) -> Fun n c d -> Fun n a (Fun n b (m d))
izipWithFM f (Fun g0) =
fmap (\v -> Fun $ accumM
(\(T_izip i (VecList (a:as)) g) b -> do x <- f i a b
return $ T_izip (i+1) (VecList as) (g x)
)
(\(T_izip _ _ x) -> return x)
(return $ T_izip 0 v g0 :: m (T_izip a c d n))
) construct
convert :: (Vector v a, Vector w a, Dim v ~ Dim w) => v a -> w a
convert v = inspectV v construct
toList :: (Vector v a) => v a -> [a]
toList v
= case inspectV v construct of VecList xs -> xs
fromList :: forall v a. (Vector v a) => [a] -> v a
fromList xs
| length r == P.length xs = convert r
| otherwise = error "Data.Vector.Fixed.fromList: bad list length"
where
r = VecList xs :: VecList (Dim v) a
newtype VecList n a = VecList [a]
deriving (Show,Eq)
type instance Dim (VecList n) = n
newtype Flip f a n = Flip (f n a)
newtype T_list a n = T_list ([a] -> [a])
instance Arity n => Vector (VecList n) a where
construct = Fun $ accum
(\(T_list xs) x -> T_list (xs . (x:)))
(\(T_list xs) -> VecList (xs []) :: VecList n a)
(T_list id :: T_list a n)
inspect v (Fun f) = apply
(\(Flip (VecList (x:xs))) -> (x, Flip (VecList xs)))
(Flip v)
f
instance Arity n => VectorN VecList n a
newtype Id a = Id { runID :: a }
instance Monad Id where
return = Id
Id a >>= f = f a