module Data.Vector.Fixed.Cont (
S
, Z
, Add
, NatIso
, ToPeano
, ToNat
, N1
, N2
, N3
, N4
, N5
, N6
, Fn
, Fun(..)
, Arity(..)
, apply
, applyM
, constFun
, curryFirst
, uncurryFirst
, curryLast
, curryMany
, apLast
, shuffleFun
, withFun
, Dim
, Vector(..)
, VectorN
, length
, Index(..)
, ContVec(..)
, cvec
, fromList
, fromList'
, fromListM
, toList
, replicate
, replicateM
, generate
, generateM
, unfoldr
, basis
, empty
, cons
, consV
, snoc
, concat
, mk1
, mk2
, mk3
, mk4
, mk5
, map
, imap
, mapM
, imapM
, mapM_
, imapM_
, scanl
, scanl1
, sequence
, sequence_
, distribute
, collect
, distributeM
, collectM
, tail
, reverse
, zipWith
, zipWith3
, izipWith
, izipWith3
, zipWithM
, zipWithM_
, izipWithM
, izipWithM_
, runContVec
, head
, index
, element
, elementTy
, vector
, foldl
, foldl1
, foldr
, ifoldl
, ifoldr
, foldM
, ifoldM
, sum
, minimum
, maximum
, and
, or
, all
, any
, find
, gfoldl
, gunfold
) where
import Control.Applicative (Applicative(..),(<$>),(<|>))
import Control.Monad (liftM)
import Data.Coerce
import Data.Complex (Complex(..))
import Data.Data (Typeable,Data)
import Data.Typeable (Proxy(..))
import GHC.TypeLits
import qualified Data.Foldable as F
import qualified Data.Traversable as F
import Prelude hiding ( replicate,map,zipWith,zipWith3,maximum,minimum,and,or,any,all
, foldl,foldr,foldl1,length,sum,reverse,scanl,scanl1
, head,tail,mapM,mapM_,sequence,sequence_,concat
)
data Z deriving Typeable
data S n deriving Typeable
type family Add n m :: *
type instance Add Z n = n
type instance Add (S n) k = S (Add n k)
type N1 = S Z
type N2 = S N1
type N3 = S N2
type N4 = S N3
type N5 = S N4
type N6 = S N5
class (ToNat a ~ b, ToPeano b ~ a) => NatIso (a :: *) (b :: Nat) where
type family ToNat (a :: * ) :: Nat where
ToNat Z = 0
ToNat (S k) = 1 + ToNat k
type family ToPeano (b :: Nat) :: * where
ToPeano 0 = Z
ToPeano n = S (ToPeano (n 1))
instance NatIso Z 0 where
instance ( NatIso k (n 1)
, ToPeano (n 1) ~ k
, ToPeano n ~ S k
, n ~ (1 + (n 1))
) => NatIso (S k) n where
type family Fn n a b
type instance Fn Z a b = b
type instance Fn (S n) a b = a -> Fn n a b
newtype Fun n a b = Fun { unFun :: Fn n a b }
instance Arity n => Functor (Fun n a) where
fmap f fun
= accum (\(T_Flip g) a -> T_Flip (curryFirst g a))
(\(T_Flip x) -> f (unFun x))
(T_Flip fun)
instance Arity n => Applicative (Fun n a) where
pure x = accum (\Proxy _ -> Proxy)
(\Proxy -> x)
Proxy
(Fun f0 :: Fun n a (p -> q)) <*> (Fun g0 :: Fun n a p)
= accum (\(T_ap f g) a -> T_ap (f a) (g a))
(\(T_ap f g) -> f g)
(T_ap f0 g0 :: T_ap a (p -> q) p n)
instance Arity n => Monad (Fun n a) where
return = pure
f >>= g = shuffleFun g <*> f
data T_ap a b c n = T_ap (Fn n a b) (Fn n a c)
class Arity n where
accum :: (forall k. t (S k) -> a -> t k)
-> (t Z -> b)
-> t n
-> Fun n a b
applyFun :: (forall k. t (S k) -> (a, t k))
-> t n
-> Fn n a b
-> (b, t Z)
applyFunM :: Monad m
=> (forall k. t (S k) -> m (a, t k))
-> t n
-> m (ContVec n a, t Z)
arity :: n -> Int
reverseF :: Fun n a b -> Fun n a b
uncurryMany :: Fun (Add n k) a b -> Fun n a (Fun k a b)
gunfoldF :: (Data a)
=> (forall b x. Data b => c (b -> x) -> c x)
-> T_gunfold c r a n -> c r
newtype T_gunfold c r a n = T_gunfold (c (Fn n a r))
apply :: Arity n
=> (forall k. t (S k) -> (a, t k))
-> t n
-> ContVec n a
apply step z = ContVec $ \(Fun f) -> fst $ applyFun step z f
applyM :: (Monad m, Arity n)
=> (forall k. t (S k) -> m (a, t k))
-> t n
-> m (ContVec n a)
applyM f t = do (v,_) <- applyFunM f t
return v
instance Arity Z where
accum _ g t = Fun $ g t
applyFun _ t h = (h,t)
applyFunM _ t = return (empty, t)
arity _ = 0
reverseF = id
gunfoldF _ (T_gunfold c) = c
uncurryMany = coerce
instance Arity n => Arity (S n) where
accum f g t = Fun $ \a -> unFun $ accum f g (f t a)
applyFun f t h = case f t of (a,u) -> applyFun f u (h a)
applyFunM f t = do (a,t') <- f t
(vec,tZ) <- applyFunM f t'
return (cons a vec , tZ)
arity _ = 1 + arity (undefined :: n)
reverseF f = Fun $ \a -> unFun (reverseF $ apLast f a)
gunfoldF f c = gunfoldF f (apGunfold f c)
uncurryMany :: forall k a b. Fun (Add (S n) k) a b -> Fun (S n) a (Fun k a b)
uncurryMany f
= coerce
(fmap uncurryMany (curryFirst f) :: a -> Fun n a (Fun k a b))
apGunfold :: Data a
=> (forall b x. Data b => c (b -> x) -> c x)
-> T_gunfold c r a (S n)
-> T_gunfold c r a n
apGunfold f (T_gunfold c) = T_gunfold $ f c
newtype T_Flip a b n = T_Flip (Fun n a b)
newtype T_Counter n = T_Counter Int
constFun :: Fun n a b -> Fun (S n) a b
constFun (Fun f) = Fun $ \_ -> f
curryFirst :: Fun (S n) a b -> a -> Fun n a b
curryFirst = coerce
uncurryFirst :: (a -> Fun n a b) -> Fun (S n) a b
uncurryFirst = coerce
curryLast :: Arity n => Fun (S n) a b -> Fun n a (a -> b)
curryLast (Fun f0) = accum (\(T_fun f) a -> T_fun (f a))
(\(T_fun f) -> f)
(T_fun f0)
newtype T_fun a b n = T_fun (Fn (S n) a b)
curryMany :: forall n k a b. Arity n
=> Fun (Add n k) a b -> Fun n a (Fun k a b)
curryMany (Fun f0) = accum
(\(T_curry f) a -> T_curry (f a))
(\(T_curry f) -> Fun f)
( T_curry f0 :: T_curry a b k n)
newtype T_curry a b k n = T_curry (Fn (Add n k) a b)
apLast :: Arity n => Fun (S n) a b -> a -> Fun n a b
apLast f x = fmap ($ x) $ curryLast f
withFun :: (Fun n a b -> Fun n a b) -> Fun (S n) a b -> Fun (S n) a b
withFun f fun = Fun $ \a -> unFun $ f $ curryFirst fun a
shuffleFun :: Arity n
=> (b -> Fun n a r) -> Fun n a (b -> r)
shuffleFun f0
= accum (\(T_shuffle f) a -> T_shuffle $ \x -> f x a)
(\(T_shuffle f) -> f)
(T_shuffle (fmap unFun f0))
newtype T_shuffle x a r n = T_shuffle (x -> Fn n a r)
type family Dim (v :: * -> *)
class Arity (Dim v) => Vector v a where
construct :: Fun (Dim v) a (v a)
inspect :: v a -> Fun (Dim v) a b -> b
basicIndex :: v a -> Int -> a
basicIndex v i = index i (cvec v)
class (Vector (v n) a, Dim (v n) ~ n) => VectorN v n a
length :: forall v a. Arity (Dim v) => v a -> Int
length _ = arity (undefined :: Dim v)
class Index k n where
getF :: k -> Fun n a a
putF :: k -> a -> Fun n a r -> Fun n a r
lensF :: Functor f => k -> (a -> f a) -> Fun n a r -> Fun n a (f r)
instance Arity n => Index Z (S n) where
getF _ = Fun $ \(a :: a) -> unFun (pure a :: Fun n a a)
putF _ a (Fun f) = Fun $ \_ -> f a
lensF _ f fun = Fun $ \(a :: a) -> unFun $
(\g -> g <$> f a) <$> shuffleFun (curryFirst fun)
instance Index k n => Index (S k) (S n) where
getF _ = Fun $ \(_::a) -> unFun (getF (undefined :: k) :: Fun n a a)
putF _ a (f :: Fun (S n) a b)
= withFun (putF (undefined :: k) a) f
lensF _ f fun = Fun $ \a -> unFun (lensF (undefined :: k) f (curryFirst fun a))
newtype ContVec n a = ContVec (forall r. Fun n a r -> r)
type instance Dim (ContVec n) = n
instance Arity n => Vector (ContVec n) a where
construct = accum
(\(T_mkN f) a -> T_mkN (f . cons a))
(\(T_mkN f) -> f empty)
(T_mkN id)
inspect (ContVec c) f = c f
newtype T_mkN n_tot a n = T_mkN (ContVec n a -> ContVec n_tot a)
instance Arity n => VectorN ContVec n a
instance (Arity n) => Functor (ContVec n) where
fmap = map
instance (Arity n) => Applicative (ContVec n) where
pure = replicate
(<*>) = zipWith ($)
instance (Arity n) => F.Foldable (ContVec n) where
foldr = foldr
instance (Arity n) => F.Traversable (ContVec n) where
sequenceA v = inspect v $ sequenceAF construct
sequenceAF :: forall f n a b. (Applicative f, Arity n)
=> Fun n a b -> Fun n (f a) (f b)
sequenceAF (Fun f0)
= accum (\(T_sequenceA f) a -> T_sequenceA (f <*> a))
(\(T_sequenceA f) -> f)
(T_sequenceA (pure f0) :: T_sequenceA f a b n)
newtype T_sequenceA f a b n = T_sequenceA (f (Fn n a b))
cvec :: (Vector v a, Dim v ~ n) => v a -> ContVec n a
cvec v = ContVec (inspect v)
empty :: ContVec Z a
empty = ContVec (\(Fun r) -> r)
fromList :: Arity n => [a] -> ContVec n a
fromList xs =
apply step (T_flist xs)
where
step (T_flist [] ) = error "Data.Vector.Fixed.Cont.fromList: too few elements"
step (T_flist (a:as)) = (a, T_flist as)
fromList' :: forall n a. Arity n => [a] -> ContVec n a
fromList' xs = ContVec $ \(Fun fun) ->
let (r,rest) = applyFun step (T_flist xs :: T_flist a n) fun
step (T_flist [] ) = error "Data.Vector.Fixed.Cont.fromList': too few elements"
step (T_flist (a:as)) = (a, T_flist as)
in case rest of
T_flist [] -> r
_ -> error "Data.Vector.Fixed.Cont.fromList': too many elements"
fromListM :: forall n a. Arity n => [a] -> Maybe (ContVec n a)
fromListM xs = do
(v,rest) <- applyFunM step (T_flist xs :: T_flist a n)
case rest of
T_flist [] -> return v
_ -> Nothing
where
step (T_flist [] ) = Nothing
step (T_flist (a:as)) = return (a, T_flist as)
newtype T_flist a n = T_flist [a]
toList :: (Arity n) => ContVec n a -> [a]
toList = foldr (:) []
replicate :: (Arity n) => a -> ContVec n a
replicate a = apply (\Proxy -> (a, Proxy)) Proxy
replicateM :: (Arity n, Monad m) => m a -> m (ContVec n a)
replicateM act
= applyM (\Proxy -> do { a <- act; return (a, Proxy)}) Proxy
generate :: (Arity n) => (Int -> a) -> ContVec n a
generate f =
apply (\(T_Counter n) -> (f n, T_Counter (n + 1)))
(T_Counter 0)
generateM :: (Monad m, Arity n) => (Int -> m a) -> m (ContVec n a)
generateM f =
applyM (\(T_Counter n) -> do { a <- f n; return (a, T_Counter (n + 1)) } )
(T_Counter 0)
unfoldr :: Arity n => (b -> (a,b)) -> b -> ContVec n a
unfoldr f b0 =
apply (\(T_unfoldr b) -> let (a,b') = f b in (a, T_unfoldr b'))
(T_unfoldr b0)
newtype T_unfoldr b n = T_unfoldr b
basis :: (Num a, Arity n) => Int -> ContVec n a
basis n0 =
apply (\(T_Counter n) -> (if n == 0 then 1 else 0, T_Counter (n 1)))
(T_Counter n0)
mk1 :: a -> ContVec N1 a
mk1 a1 = ContVec $ \(Fun f) -> f a1
mk2 :: a -> a -> ContVec N2 a
mk2 a1 a2 = ContVec $ \(Fun f) -> f a1 a2
mk3 :: a -> a -> a -> ContVec N3 a
mk3 a1 a2 a3 = ContVec $ \(Fun f) -> f a1 a2 a3
mk4 :: a -> a -> a -> a -> ContVec N4 a
mk4 a1 a2 a3 a4 = ContVec $ \(Fun f) -> f a1 a2 a3 a4
mk5 :: a -> a -> a -> a -> a -> ContVec N5 a
mk5 a1 a2 a3 a4 a5 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 a5
map :: (Arity n) => (a -> b) -> ContVec n a -> ContVec n b
map = imap . const
imap :: (Arity n) => (Int -> a -> b) -> ContVec n a -> ContVec n b
imap f (ContVec contA) = ContVec $
contA . imapF f
mapM :: (Arity n, Monad m) => (a -> m b) -> ContVec n a -> m (ContVec n b)
mapM = imapM . const
imapM :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVec n a -> m (ContVec n b)
imapM f v
= inspect v
$ imapMF f construct
mapM_ :: (Arity n, Monad m) => (a -> m b) -> ContVec n a -> m ()
mapM_ f = foldl (\m a -> m >> f a >> return ()) (return ())
imapM_ :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVec n a -> m ()
imapM_ f = ifoldl (\m i a -> m >> f i a >> return ()) (return ())
imapMF :: (Arity n, Monad m)
=> (Int -> a -> m b) -> Fun n b r -> Fun n a (m r)
imapMF f (Fun funB) =
accum (\(T_mapM i m) a -> T_mapM (i+1) $ do b <- f i a
fun <- m
return $ fun b
)
(\(T_mapM _ m) -> m)
(T_mapM 0 (return funB))
data T_mapM a m r n = T_mapM Int (m (Fn n a r))
imapF :: Arity n
=> (Int -> a -> b) -> Fun n b r -> Fun n a r
imapF f (Fun funB) =
accum (\(T_map i g) b -> T_map (i+1) (g (f i b)))
(\(T_map _ r) -> r)
( T_map 0 funB)
data T_map a r n = T_map Int (Fn n a r)
scanl :: (Arity n) => (b -> a -> b) -> b -> ContVec n a -> ContVec (S n) b
scanl f b0 (ContVec cont) = ContVec $
cont . scanlF f b0
scanl1 :: (Arity n) => (a -> a -> a) -> ContVec n a -> ContVec n a
scanl1 f (ContVec cont) = ContVec $
cont . scanl1F f
scanlF :: forall n a b r. (Arity n) => (b -> a -> b) -> b -> Fun (S n) b r -> Fun n a r
scanlF f b0 (Fun fun0)
= accum step fini start
where
step :: forall k. T_scanl r b (S k) -> a -> T_scanl r b k
step (T_scanl b fn) a = let b' = f b a in T_scanl b' (fn b')
fini (T_scanl _ r) = r
start = T_scanl b0 (fun0 b0) :: T_scanl r b n
scanl1F :: forall n a r. (Arity n) => (a -> a -> a) -> Fun n a r -> Fun n a r
scanl1F f (Fun fun0) = accum step fini start
where
step :: forall k. T_scanl1 r a (S k) -> a -> T_scanl1 r a k
step (T_scanl1 Nothing fn) a = T_scanl1 (Just a) (fn a)
step (T_scanl1 (Just x) fn) a = let a' = f x a in T_scanl1 (Just a') (fn a')
fini (T_scanl1 _ r) = r
start = T_scanl1 Nothing fun0 :: T_scanl1 r a n
data T_scanl r a n = T_scanl a (Fn n a r)
data T_scanl1 r a n = T_scanl1 (Maybe a) (Fn n a r)
sequence :: (Arity n, Monad m) => ContVec n (m a) -> m (ContVec n a)
sequence = mapM id
sequence_ :: (Arity n, Monad m) => ContVec n (m a) -> m ()
sequence_ = mapM_ id
distribute :: (Functor f, Arity n) => f (ContVec n a) -> ContVec n (f a)
distribute f0
= apply step start
where
step (T_distribute f) = ( fmap (\(x:_) -> x) f
, T_distribute $ fmap (\(_:x) -> x) f)
start = T_distribute (fmap toList f0)
collect :: (Functor f, Arity n) => (a -> ContVec n b) -> f a -> ContVec n (f b)
collect f = distribute . fmap f
distributeM :: (Monad m, Arity n) => m (ContVec n a) -> ContVec n (m a)
distributeM f0
= apply step start
where
step (T_distribute f) = ( liftM (\(x:_) -> x) f
, T_distribute $ liftM (\(_:x) -> x) f)
start = T_distribute (liftM toList f0)
collectM :: (Monad m, Arity n) => (a -> ContVec n b) -> m a -> ContVec n (m b)
collectM f = distributeM . liftM f
newtype T_distribute a f n = T_distribute (f [a])
tail :: ContVec (S n) a -> ContVec n a
tail (ContVec cont) = ContVec $ \f -> cont $ constFun f
cons :: a -> ContVec n a -> ContVec (S n) a
cons a (ContVec cont) = ContVec $ \f -> cont $ curryFirst f a
consV :: ContVec (S Z) a -> ContVec n a -> ContVec (S n) a
consV (ContVec cont1) (ContVec cont)
= ContVec $ \f -> cont $ curryFirst f $ cont1 $ Fun id
snoc :: Arity n => a -> ContVec n a -> ContVec (S n) a
snoc a (ContVec cont) = ContVec $ \f -> cont $ apLast f a
concat :: (Arity n, Arity k, Arity (Add n k))
=> ContVec n a -> ContVec k a -> ContVec (Add n k) a
concat v u = inspect u
$ inspect v
$ curryMany construct
reverse :: Arity n => ContVec n a -> ContVec n a
reverse (ContVec cont) = ContVec $ cont . reverseF
zipWith :: (Arity n) => (a -> b -> c)
-> ContVec n a -> ContVec n b -> ContVec n c
zipWith = izipWith . const
zipWith3 :: (Arity n) => (a -> b -> c -> d)
-> ContVec n a -> ContVec n b -> ContVec n c -> ContVec n d
zipWith3 f v1 v2 v3 = zipWith (\a (b, c) -> f a b c) v1 (zipWith (,) v2 v3)
izipWith :: (Arity n) => (Int -> a -> b -> c)
-> ContVec n a -> ContVec n b -> ContVec n c
izipWith f vecA vecB = ContVec $ \funC ->
inspect vecB
$ inspect vecA
$ izipWithF f funC
izipWith3 :: (Arity n) => (Int -> a -> b -> c -> d)
-> ContVec n a -> ContVec n b -> ContVec n c -> ContVec n d
izipWith3 f v1 v2 v3 = izipWith (\i a (b, c) -> f i a b c) v1 (zipWith (,) v2 v3)
zipWithM :: (Arity n, Monad m) => (a -> b -> m c)
-> ContVec n a -> ContVec n b -> m (ContVec n c)
zipWithM f v w = sequence $ zipWith f v w
zipWithM_ :: (Arity n, Monad m)
=> (a -> b -> m c) -> ContVec n a -> ContVec n b -> m ()
zipWithM_ f xs ys = sequence_ (zipWith f xs ys)
izipWithM :: (Arity n, Monad m) => (Int -> a -> b -> m c)
-> ContVec n a -> ContVec n b -> m (ContVec n c)
izipWithM f v w = sequence $ izipWith f v w
izipWithM_ :: (Arity n, Monad m)
=> (Int -> a -> b -> m c) -> ContVec n a -> ContVec n b -> m ()
izipWithM_ f xs ys = sequence_ (izipWith f xs ys)
izipWithF :: (Arity n)
=> (Int -> a -> b -> c) -> Fun n c r -> Fun n a (Fun n b r)
izipWithF f (Fun g0) =
fmap (\v -> accum
(\(T_izip i (a:as) g) b -> T_izip (i+1) as (g $ f i a b))
(\(T_izip _ _ x) -> x)
(T_izip 0 v g0)
) makeList
makeList :: Arity n => Fun n a [a]
makeList = accum
(\(T_mkList xs) x -> T_mkList (xs . (x:)))
(\(T_mkList xs) -> xs [])
(T_mkList id)
newtype T_mkList a n = T_mkList ([a] -> [a])
data T_izip a c r n = T_izip Int [a] (Fn n c r)
runContVec :: Fun n a r
-> ContVec n a
-> r
runContVec f (ContVec c) = c f
vector :: (Vector v a, Dim v ~ n) => ContVec n a -> v a
vector = runContVec construct
head :: Arity (S n) => ContVec (S n) a -> a
head
= runContVec
$ accum (\(T_head m) a -> T_head $ case m of { Nothing -> Just a; x -> x })
(\(T_head (Just x)) -> x)
(T_head Nothing)
data T_head a n = T_head (Maybe a)
index :: Arity n => Int -> ContVec n a -> a
index n
| n < 0 = error "Data.Vector.Fixed.Cont.index: index out of range"
| otherwise = runContVec $ accum
(\(T_Index x) a -> T_Index $ case x of
Left 0 -> Right a
Left i -> Left (i 1)
r -> r
)
(\(T_Index x) -> case x of
Left _ -> error "Data.Vector.Fixed.index: index out of range"
Right a -> a
)
(T_Index (Left n))
newtype T_Index a n = T_Index (Either Int a)
element :: (Arity n, Functor f)
=> Int -> (a -> f a) -> ContVec n a -> f (ContVec n a)
element i f v = inspect v
$ elementF i f construct
elementTy :: (Arity n, Index k n, Functor f)
=> k -> (a -> f a) -> ContVec n a -> f (ContVec n a)
elementTy k f v = inspect v
$ lensF k f construct
elementF :: forall a n f r. (Arity n, Functor f)
=> Int -> (a -> f a) -> Fun n a r -> Fun n a (f r)
elementF n f (Fun fun0) = accum step fini start
where
step :: forall k. T_lens f a r (S k) -> a -> T_lens f a r k
step (T_lens (Left (0,fun))) a = T_lens $ Right $ fmap fun $ f a
step (T_lens (Left (i,fun))) a = T_lens $ Left (i1, fun a)
step (T_lens (Right fun)) a = T_lens $ Right $ fmap ($ a) fun
fini :: T_lens f a r Z -> f r
fini (T_lens (Left _)) = error "Data.Vector.Fixed.lensF: Index out of range"
fini (T_lens (Right r)) = r
start :: T_lens f a r n
start = T_lens $ Left (n,fun0)
data T_lens f a r n = T_lens (Either (Int,(Fn n a r)) (f (Fn n a r)))
foldl :: Arity n => (b -> a -> b) -> b -> ContVec n a -> b
foldl f = ifoldl (\b _ a -> f b a)
ifoldl :: Arity n => (b -> Int -> a -> b) -> b -> ContVec n a -> b
ifoldl f b v
= inspect v
$ accum (\(T_ifoldl i r) a -> T_ifoldl (i+1) (f r i a))
(\(T_ifoldl _ r) -> r)
(T_ifoldl 0 b)
foldM :: (Arity n, Monad m)
=> (b -> a -> m b) -> b -> ContVec n a -> m b
foldM f x
= foldl (\m a -> do{ b <- m; f b a}) (return x)
ifoldM :: (Arity n, Monad m)
=> (b -> Int -> a -> m b) -> b -> ContVec n a -> m b
ifoldM f x
= ifoldl (\m i a -> do{ b <- m; f b i a}) (return x)
data T_ifoldl b n = T_ifoldl !Int b
foldl1 :: (Arity (S n)) => (a -> a -> a) -> ContVec (S n) a -> a
foldl1 f
= runContVec
$ accum (\(T_foldl1 r ) a -> T_foldl1 $ Just $ maybe a (flip f a) r)
(\(T_foldl1 (Just x)) -> x)
(T_foldl1 Nothing)
newtype T_foldl1 a n = T_foldl1 (Maybe a)
foldr :: Arity n => (a -> b -> b) -> b -> ContVec n a -> b
foldr = ifoldr . const
ifoldr :: Arity n => (Int -> a -> b -> b) -> b -> ContVec n a -> b
ifoldr f z
= runContVec
$ accum (\(T_ifoldr i g) a -> T_ifoldr (i+1) (g . f i a))
(\(T_ifoldr _ g) -> g z)
(T_ifoldr 0 id)
data T_ifoldr b n = T_ifoldr Int (b -> b)
sum :: (Num a, Arity n) => ContVec n a -> a
sum = foldl (+) 0
minimum :: (Ord a, Arity (S n)) => ContVec (S n) a -> a
minimum = foldl1 min
maximum :: (Ord a, Arity (S n)) => ContVec (S n) a -> a
maximum = foldl1 max
and :: Arity n => ContVec n Bool -> Bool
and = foldr (&&) True
or :: Arity n => ContVec n Bool -> Bool
or = foldr (||) False
all :: Arity n => (a -> Bool) -> ContVec n a -> Bool
all f = foldr (\x b -> f x && b) True
any :: Arity n => (a -> Bool) -> ContVec n a -> Bool
any f = foldr (\x b -> f x || b) True
find :: Arity n => (a -> Bool) -> ContVec n a -> Maybe a
find f = foldl (\r x -> r <|> if f x then Just x else Nothing) Nothing
gfoldl :: forall c v a. (Vector v a, Data a)
=> (forall x y. Data x => c (x -> y) -> x -> c y)
-> (forall x . x -> c x)
-> v a -> c (v a)
gfoldl f inj v
= inspect v
$ gfoldlF f (inj $ unFun (construct :: Fun (Dim v) a (v a)))
gunfold :: forall con c v a. (Vector v a, Data a)
=> (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> con -> c (v a)
gunfold f inj _
= gunfoldF f gun
where
con = construct :: Fun (Dim v) a (v a)
gun = T_gunfold (inj $ unFun con) :: T_gunfold c (v a) a (Dim v)
gfoldlF :: (Arity n, Data a)
=> (forall x y. Data x => c (x -> y) -> x -> c y)
-> c (Fn n a r) -> Fun n a (c r)
gfoldlF f c0 = accum
(\(T_gfoldl c) x -> T_gfoldl (f c x))
(\(T_gfoldl c) -> c)
(T_gfoldl c0)
newtype T_gfoldl c r a n = T_gfoldl (c (Fn n a r))
type instance Dim Complex = N2
instance RealFloat a => Vector Complex a where
construct = Fun (:+)
inspect (x :+ y) (Fun f) = f x y
type instance Dim ((,) a) = N2
instance (b~a) => Vector ((,) b) a where
construct = Fun (,)
inspect (a,b) (Fun f) = f a b
type instance Dim ((,,) a b) = N3
instance (b~a, c~a) => Vector ((,,) b c) a where
construct = Fun (,,)
inspect (a,b,c) (Fun f) = f a b c
type instance Dim ((,,,) a b c) = N4
instance (b~a, c~a, d~a) => Vector ((,,,) b c d) a where
construct = Fun (,,,)
inspect (a,b,c,d) (Fun f) = f a b c d
type instance Dim ((,,,,) a b c d) = N5
instance (b~a, c~a, d~a, e~a) => Vector ((,,,,) b c d e) a where
construct = Fun (,,,,)
inspect (a,b,c,d,e) (Fun f) = f a b c d e
type instance Dim ((,,,,,) a b c d e) = N6
instance (b~a, c~a, d~a, e~a, f~a) => Vector ((,,,,,) b c d e f) a where
construct = Fun (,,,,,)
inspect (a,b,c,d,e,f) (Fun fun) = fun a b c d e f
type instance Dim ((,,,,,,) a b c d e f) = S N6
instance (b~a, c~a, d~a, e~a, f~a, g~a) => Vector ((,,,,,,) b c d e f g) a where
construct = Fun (,,,,,,)
inspect (a,b,c,d,e,f,g) (Fun fun) = fun a b c d e f g
type instance Dim Proxy = Z
instance Vector Proxy a where
construct = Fun Proxy
inspect _ = unFun