{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Chimera.Internal (
Chimera,
VChimera,
UChimera,
tabulate,
tabulateFix,
tabulateFix',
iterate,
iterateWithIndex,
unfoldr,
cycle,
fromListWithDef,
fromVectorWithDef,
fromInfinite,
interleave,
prependVector,
index,
foldr,
toList,
toInfinite,
tabulateM,
tabulateFixM,
tabulateFixM',
iterateM,
iterateWithIndexM,
unfoldrM,
mapSubvectors,
imapSubvectors,
traverseSubvectors,
zipWithSubvectors,
zipWithMSubvectors,
sliceSubvectors,
) where
import Control.Applicative
import Control.Monad.Fix
import Control.Monad.Trans.Class
import qualified Control.Monad.Trans.State.Lazy as LazyState
import Control.Monad.Zip
import Data.Bits
import Data.Coerce
import qualified Data.Foldable as F
import Data.Functor.Identity
import Data.List.Infinite (Infinite (..))
import qualified Data.List.Infinite as Inf
import qualified Data.Primitive.Array as A
import Data.Typeable
import qualified Data.Vector as V
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import GHC.Exts (fromListN)
import Prelude hiding (Applicative (..), and, cycle, div, drop, foldr, fromIntegral, iterate, not, or, (*), (^))
#ifdef MIN_VERSION_mtl
import Control.Monad.Reader (MonadReader, ask, local)
#endif
#ifdef MIN_VERSION_distributive
import Data.Distributive
#ifdef MIN_VERSION_adjunctions
import qualified Data.Functor.Rep as Rep
#endif
#endif
import Data.Chimera.FromIntegral
newtype Chimera v a = Chimera {forall {k} (v :: k -> *) (a :: k). Chimera v a -> Array (v a)
unChimera :: A.Array (v a)}
deriving
( forall a b. a -> Chimera v b -> Chimera v a
forall a b. (a -> b) -> Chimera v a -> Chimera v b
forall (v :: * -> *) a b.
Functor v =>
a -> Chimera v b -> Chimera v a
forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Chimera v a -> Chimera v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Chimera v b -> Chimera v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> Chimera v b -> Chimera v a
fmap :: forall a b. (a -> b) -> Chimera v a -> Chimera v b
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Chimera v a -> Chimera v b
Functor
)
type VChimera = Chimera V.Vector
type UChimera = Chimera U.Vector
instance Applicative (Chimera V.Vector) where
pure :: forall a. a -> Chimera Vector a
pure a
a =
forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall a b. (a -> b) -> a -> b
$
forall a. Int -> [a] -> Array a
A.arrayFromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$
forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
a forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Int
k -> forall (v :: * -> *) a. Vector v a => Int -> a -> v a
G.replicate (Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
k) a
a) [Int
0 .. Int
bits forall a. Num a => a -> a -> a
- Int
1]
<*> :: forall a b.
Chimera Vector (a -> b) -> Chimera Vector a -> Chimera Vector b
(<*>) = forall (u :: * -> *) a (v :: * -> *) b (w :: * -> *) c.
(Vector u a, Vector v b, Vector w c) =>
(u a -> v b -> w c) -> Chimera u a -> Chimera v b -> Chimera w c
zipWithSubvectors forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
liftA2 :: forall a b c.
(a -> b -> c)
-> Chimera Vector a -> Chimera Vector b -> Chimera Vector c
liftA2 a -> b -> c
f = forall (u :: * -> *) a (v :: * -> *) b (w :: * -> *) c.
(Vector u a, Vector v b, Vector w c) =>
(u a -> v b -> w c) -> Chimera u a -> Chimera v b -> Chimera w c
zipWithSubvectors (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f)
instance Monad (Chimera V.Vector) where
Chimera Vector a
m >>= :: forall a b.
Chimera Vector a -> (a -> Chimera Vector b) -> Chimera Vector b
>>= a -> Chimera Vector b
f = forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate forall a b. (a -> b) -> a -> b
$ \Word
w -> forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index (a -> Chimera Vector b
f (forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index Chimera Vector a
m Word
w)) Word
w
instance MonadFix (Chimera V.Vector) where
mfix :: forall a. (a -> Chimera Vector a) -> Chimera Vector a
mfix = forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index
instance MonadZip (Chimera V.Vector) where
mzip :: forall a b.
Chimera Vector a -> Chimera Vector b -> Chimera Vector (a, b)
mzip = forall (u :: * -> *) a (v :: * -> *) b (w :: * -> *) c.
(Vector u a, Vector v b, Vector w c) =>
(u a -> v b -> w c) -> Chimera u a -> Chimera v b -> Chimera w c
zipWithSubvectors forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip
mzipWith :: forall a b c.
(a -> b -> c)
-> Chimera Vector a -> Chimera Vector b -> Chimera Vector c
mzipWith = forall (u :: * -> *) a (v :: * -> *) b (w :: * -> *) c.
(Vector u a, Vector v b, Vector w c) =>
(u a -> v b -> w c) -> Chimera u a -> Chimera v b -> Chimera w c
zipWithSubvectors forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith
#ifdef MIN_VERSION_mtl
instance MonadReader Word (Chimera V.Vector) where
ask :: Chimera Vector Word
ask = forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate forall a. a -> a
id
local :: forall a. (Word -> Word) -> Chimera Vector a -> Chimera Vector a
local = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ (forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index
#endif
#ifdef MIN_VERSION_distributive
instance Distributive (Chimera V.Vector) where
distribute :: forall (f :: * -> *) a.
Functor f =>
f (Chimera Vector a) -> Chimera Vector (f a)
distribute = forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index)
collect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Chimera Vector b) -> f a -> Chimera Vector (f b)
collect a -> Chimera Vector b
f = forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Chimera Vector b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index)
#ifdef MIN_VERSION_adjunctions
instance Rep.Representable (Chimera V.Vector) where
type Rep (Chimera V.Vector) = Word
tabulate :: forall a. (Rep (Chimera Vector) -> a) -> Chimera Vector a
tabulate = forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate
index :: forall a. Chimera Vector a -> Rep (Chimera Vector) -> a
index = forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index
#endif
#endif
bits :: Int
bits :: Int
bits = forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)
tabulate :: G.Vector v a => (Word -> a) -> Chimera v a
tabulate :: forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate Word -> a
f = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
(Word -> m a) -> m (Chimera v a)
tabulateM (coerce :: forall a b. Coercible a b => a -> b
coerce Word -> a
f)
{-# INLINEABLE tabulate #-}
generateArrayM :: Monad m => Int -> (Int -> m a) -> m (A.Array a)
generateArrayM :: forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Array a)
generateArrayM Int
n Int -> m a
f = forall a. Int -> [a] -> Array a
A.arrayFromListN Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> m a
f [Int
0 .. Int
n forall a. Num a => a -> a -> a
- Int
1]
tabulateM
:: (Monad m, G.Vector v a)
=> (Word -> m a)
-> m (Chimera v a)
tabulateM :: forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
(Word -> m a) -> m (Chimera v a)
tabulateM Word -> m a
f = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Array a)
generateArrayM (Int
bits forall a. Num a => a -> a -> a
+ Int
1) Int -> m (v a)
tabulateSubVector
where
tabulateSubVector :: Int -> m (v a)
tabulateSubVector Int
0 = forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> m a
f Word
0
tabulateSubVector Int
i = forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> (Int -> m a) -> m (v a)
G.generateM Int
ii (\Int
j -> Word -> m a
f (Int -> Word
int2word (Int
ii forall a. Num a => a -> a -> a
+ Int
j)))
where
ii :: Int
ii = Int
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
i forall a. Num a => a -> a -> a
- Int
1)
{-# INLINEABLE tabulateM #-}
{-# SPECIALIZE tabulateM :: G.Vector v a => (Word -> Identity a) -> Identity (Chimera v a) #-}
tabulateFix :: (G.Vector v a, Typeable v) => ((Word -> a) -> Word -> a) -> Chimera v a
tabulateFix :: forall (v :: * -> *) a.
(Vector v a, Typeable v) =>
((Word -> a) -> Word -> a) -> Chimera v a
tabulateFix (Word -> a) -> Word -> a
uf = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a, Typeable v) =>
((Word -> m a) -> Word -> m a) -> m (Chimera v a)
tabulateFixM (coerce :: forall a b. Coercible a b => a -> b
coerce (Word -> a) -> Word -> a
uf)
{-# INLINEABLE tabulateFix #-}
tabulateFix' :: (G.Vector v a, Typeable v) => ((Word -> a) -> Word -> a) -> Chimera v a
tabulateFix' :: forall (v :: * -> *) a.
(Vector v a, Typeable v) =>
((Word -> a) -> Word -> a) -> Chimera v a
tabulateFix' (Word -> a) -> Word -> a
uf = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a, Typeable v) =>
((Word -> m a) -> Word -> m a) -> m (Chimera v a)
tabulateFixM' (coerce :: forall a b. Coercible a b => a -> b
coerce (Word -> a) -> Word -> a
uf)
{-# INLINEABLE tabulateFix' #-}
tabulateFixM
:: (Monad m, G.Vector v a, Typeable v)
=> ((Word -> m a) -> Word -> m a)
-> m (Chimera v a)
tabulateFixM :: forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a, Typeable v) =>
((Word -> m a) -> Word -> m a) -> m (Chimera v a)
tabulateFixM = forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a, Typeable v) =>
Strategy -> ((Word -> m a) -> Word -> m a) -> m (Chimera v a)
tabulateFixM_ Strategy
Downwards
{-# INLINEABLE tabulateFixM #-}
{-# SPECIALIZE tabulateFixM :: (G.Vector v a, Typeable v) => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}
tabulateFixM'
:: forall m v a
. (Monad m, G.Vector v a, Typeable v)
=> ((Word -> m a) -> Word -> m a)
-> m (Chimera v a)
tabulateFixM' :: forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a, Typeable v) =>
((Word -> m a) -> Word -> m a) -> m (Chimera v a)
tabulateFixM' = forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a, Typeable v) =>
Strategy -> ((Word -> m a) -> Word -> m a) -> m (Chimera v a)
tabulateFixM_ Strategy
Full
{-# INLINEABLE tabulateFixM' #-}
{-# SPECIALIZE tabulateFixM' :: (G.Vector v a, Typeable v) => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}
data Strategy = Full | Downwards
tabulateFixM_
:: forall m v a
. (Monad m, G.Vector v a, Typeable v)
=> Strategy
-> ((Word -> m a) -> Word -> m a)
-> m (Chimera v a)
tabulateFixM_ :: forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a, Typeable v) =>
Strategy -> ((Word -> m a) -> Word -> m a) -> m (Chimera v a)
tabulateFixM_ Strategy
strat (Word -> m a) -> Word -> m a
f = m (Chimera v a)
result
where
result :: m (Chimera v a)
result :: m (Chimera v a)
result = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Array a)
generateArrayM (Int
bits forall a. Num a => a -> a -> a
+ Int
1) Int -> m (v a)
tabulateSubVector
tabulateSubVector :: Int -> m (v a)
tabulateSubVector :: Int -> m (v a)
tabulateSubVector Int
0 =
forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Strategy
strat of
Strategy
Downwards -> forall a. (a -> a) -> a
fix (Word -> m a) -> Word -> m a
f Word
0
Strategy
Full -> (Word -> m a) -> Word -> m a
f (\Word
k -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index Word
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Chimera v a)
result) Word
0
tabulateSubVector Int
i = m (v a)
subResult
where
subResult :: m (v a)
subResult = forall (v :: * -> *) a. (Vector v a, Typeable v) => Vector a -> v a
fromBoxedVector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Vector a)
subResultBoxed
subResultBoxed :: m (Vector a)
subResultBoxed = forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM Int
ii (\Int
j -> (Word -> m a) -> Word -> m a
f Word -> m a
fixF (Int -> Word
int2word (Int
ii forall a. Num a => a -> a -> a
+ Int
j)))
ii :: Int
ii = Int
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
i forall a. Num a => a -> a -> a
- Int
1)
fixF :: Word -> m a
fixF :: Word -> m a
fixF Word
k
| Word
k forall a. Ord a => a -> a -> Bool
< Int -> Word
int2word Int
ii =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index Word
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Chimera v a)
result
| Word
k forall a. Ord a => a -> a -> Bool
<= Int -> Word
int2word Int
ii forall a. Bits a => a -> Int -> a
`shiftL` Int
1 forall a. Num a => a -> a -> a
- Word
1 =
(forall a. Vector a -> Int -> a
`V.unsafeIndex` (Word -> Int
word2int Word
k forall a. Num a => a -> a -> a
- Int
ii)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Vector a)
subResultBoxed
| Bool
otherwise =
case Strategy
strat of
Strategy
Downwards -> (Word -> m a) -> Word -> m a
f Word -> m a
fixF Word
k
Strategy
Full -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index Word
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Chimera v a)
result
{-# INLINE tabulateFixM_ #-}
fromBoxedVector :: forall v a. (G.Vector v a, Typeable v) => V.Vector a -> v a
fromBoxedVector :: forall (v :: * -> *) a. (Vector v a, Typeable v) => Vector a -> v a
fromBoxedVector = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @V.Vector @v of
Just Vector :~: v
Refl -> forall a. a -> a
id
Maybe (Vector :~: v)
Nothing -> forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
G.convert
iterate :: G.Vector v a => (a -> a) -> a -> Chimera v a
iterate :: forall (v :: * -> *) a. Vector v a => (a -> a) -> a -> Chimera v a
iterate a -> a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
(a -> m a) -> a -> m (Chimera v a)
iterateM (coerce :: forall a b. Coercible a b => a -> b
coerce a -> a
f)
iterateListNM :: forall a m. Monad m => Int -> (a -> m a) -> a -> m [a]
iterateListNM :: forall a (m :: * -> *). Monad m => Int -> (a -> m a) -> a -> m [a]
iterateListNM Int
n a -> m a
f = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 then forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) else Int -> a -> m [a]
go (Int
n forall a. Num a => a -> a -> a
- Int
1)
where
go :: Int -> a -> m [a]
go :: Int -> a -> m [a]
go Int
0 a
s = forall (f :: * -> *) a. Applicative f => a -> f a
pure [a
s]
go Int
k a
s = do
a
fs <- a -> m a
f a
s
(a
s forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> m [a]
go (Int
k forall a. Num a => a -> a -> a
- Int
1) a
fs
iterateM :: (Monad m, G.Vector v a) => (a -> m a) -> a -> m (Chimera v a)
iterateM :: forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
(a -> m a) -> a -> m (Chimera v a)
iterateM a -> m a
f a
seed = do
a
nextSeed <- a -> m a
f a
seed
let z :: v a
z = forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
seed
[v a]
zs <- forall a (m :: * -> *). Monad m => Int -> (a -> m a) -> a -> m [a]
iterateListNM Int
bits v a -> m (v a)
go (forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
nextSeed)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall a b. (a -> b) -> a -> b
$ forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) (v a
z forall a. a -> [a] -> [a]
: [v a]
zs)
where
go :: v a -> m (v a)
go v a
vec = do
a
nextSeed <- a -> m a
f (forall (v :: * -> *) a. Vector v a => v a -> a
G.unsafeLast v a
vec)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> (a -> m a) -> a -> m (v a)
G.iterateNM (forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
vec forall a. Bits a => a -> Int -> a
`shiftL` Int
1) a -> m a
f a
nextSeed
{-# SPECIALIZE iterateM :: G.Vector v a => (a -> Identity a) -> a -> Identity (Chimera v a) #-}
unfoldr :: G.Vector v b => (a -> (b, a)) -> a -> Chimera v b
unfoldr :: forall (v :: * -> *) b a.
Vector v b =>
(a -> (b, a)) -> a -> Chimera v b
unfoldr a -> (b, a)
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (v :: * -> *) b a.
(Monad m, Vector v b) =>
(a -> m (b, a)) -> a -> m (Chimera v b)
unfoldrM (coerce :: forall a b. Coercible a b => a -> b
coerce a -> (b, a)
f)
unfoldrExactVecNM :: forall m a b v. (Monad m, G.Vector v b) => Int -> (a -> m (b, a)) -> a -> m (v b, a)
unfoldrExactVecNM :: forall (m :: * -> *) a b (v :: * -> *).
(Monad m, Vector v b) =>
Int -> (a -> m (b, a)) -> a -> m (v b, a)
unfoldrExactVecNM Int
n a -> m (b, a)
f a
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
LazyState.evalStateT a
s forall a b. (a -> b) -> a -> b
$ do
v b
vec <- forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
G.replicateM Int
n StateT a m b
f'
a
seed <- forall (m :: * -> *) s. Monad m => StateT s m s
LazyState.get
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v b
vec, a
seed)
where
f' :: LazyState.StateT a m b
f' :: StateT a m b
f' = do
a
seed <- forall (m :: * -> *) s. Monad m => StateT s m s
LazyState.get
(b
value, a
newSeed) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m (b, a)
f a
seed)
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
LazyState.put a
newSeed
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
value
unfoldrM :: (Monad m, G.Vector v b) => (a -> m (b, a)) -> a -> m (Chimera v b)
unfoldrM :: forall (m :: * -> *) (v :: * -> *) b a.
(Monad m, Vector v b) =>
(a -> m (b, a)) -> a -> m (Chimera v b)
unfoldrM a -> m (b, a)
f a
seed = do
let go :: Int -> a -> m [v b]
go Int
n a
s =
if Int
n forall a. Ord a => a -> a -> Bool
>= Int
bits
then forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else do
(v b
vec, a
s') <- forall (m :: * -> *) a b (v :: * -> *).
(Monad m, Vector v b) =>
Int -> (a -> m (b, a)) -> a -> m (v b, a)
unfoldrExactVecNM (Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
n) a -> m (b, a)
f a
s
[v b]
rest <- Int -> a -> m [v b]
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) a
s'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ v b
vec forall a. a -> [a] -> [a]
: [v b]
rest
(v b
z, a
seed') <- forall (m :: * -> *) a b (v :: * -> *).
(Monad m, Vector v b) =>
Int -> (a -> m (b, a)) -> a -> m (v b, a)
unfoldrExactVecNM Int
1 a -> m (b, a)
f a
seed
[v b]
zs <- Int -> a -> m [v b]
go Int
0 a
seed'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall a b. (a -> b) -> a -> b
$ forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) (v b
z forall a. a -> [a] -> [a]
: [v b]
zs)
{-# SPECIALIZE unfoldrM :: G.Vector v b => (a -> Identity (b, a)) -> a -> Identity (Chimera v b) #-}
iterateWithIndex :: G.Vector v a => (Word -> a -> a) -> a -> Chimera v a
iterateWithIndex :: forall (v :: * -> *) a.
Vector v a =>
(Word -> a -> a) -> a -> Chimera v a
iterateWithIndex Word -> a -> a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
(Word -> a -> m a) -> a -> m (Chimera v a)
iterateWithIndexM (coerce :: forall a b. Coercible a b => a -> b
coerce Word -> a -> a
f)
iterateWithIndexExactVecNM :: forall m a v. (Monad m, G.Vector v a) => Int -> (Word -> a -> m a) -> a -> m (v a)
iterateWithIndexExactVecNM :: forall (m :: * -> *) a (v :: * -> *).
(Monad m, Vector v a) =>
Int -> (Word -> a -> m a) -> a -> m (v a)
iterateWithIndexExactVecNM Int
n Word -> a -> m a
f a
s = forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Int -> (b -> m (a, b)) -> b -> m (v a)
G.unfoldrExactNM Int
n (Word, a) -> m (a, (Word, a))
go (Int -> Word
int2word Int
n, a
s)
where
go :: (Word, a) -> m (a, (Word, a))
go :: (Word, a) -> m (a, (Word, a))
go (Word
i, a
x) = do
a
x' <- Word -> a -> m a
f Word
i a
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x', (Word
i forall a. Num a => a -> a -> a
+ Word
1, a
x'))
iterateWithIndexM :: (Monad m, G.Vector v a) => (Word -> a -> m a) -> a -> m (Chimera v a)
iterateWithIndexM :: forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
(Word -> a -> m a) -> a -> m (Chimera v a)
iterateWithIndexM Word -> a -> m a
f a
seed = do
a
nextSeed <- Word -> a -> m a
f Word
1 a
seed
let z :: v a
z = forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
seed
[v a]
zs <- forall a (m :: * -> *). Monad m => Int -> (a -> m a) -> a -> m [a]
iterateListNM Int
bits v a -> m (v a)
go (forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
nextSeed)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall a b. (a -> b) -> a -> b
$ forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) (v a
z forall a. a -> [a] -> [a]
: [v a]
zs)
where
go :: v a -> m (v a)
go v a
vec =
forall (m :: * -> *) a (v :: * -> *).
(Monad m, Vector v a) =>
Int -> (Word -> a -> m a) -> a -> m (v a)
iterateWithIndexExactVecNM (forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
vec forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word -> a -> m a
f (forall (v :: * -> *) a. Vector v a => v a -> a
G.unsafeLast v a
vec)
{-# SPECIALIZE iterateWithIndexM :: G.Vector v a => (Word -> a -> Identity a) -> a -> Identity (Chimera v a) #-}
interleaveVec :: G.Vector v a => v a -> v a -> v a
interleaveVec :: forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
interleaveVec v a
as v a
bs =
forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
G.generate
(forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
as forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
(\Int
n -> (if forall a. Integral a => a -> Bool
even Int
n then v a
as else v a
bs) forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
G.! (Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
1))
interleave :: G.Vector v a => Chimera v a -> Chimera v a -> Chimera v a
interleave :: forall (v :: * -> *) a.
Vector v a =>
Chimera v a -> Chimera v a -> Chimera v a
interleave (Chimera Array (v a)
as) (Chimera Array (v a)
bs) = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> Array a
A.arrayFromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) [v a]
vecs
where
vecs :: [v a]
vecs =
forall a. Array a -> Int -> a
A.indexArray Array (v a)
as Int
0
forall a. a -> [a] -> [a]
: forall a. Array a -> Int -> a
A.indexArray Array (v a)
bs Int
0
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
interleaveVec (forall a. Array a -> Int -> a
A.indexArray Array (v a)
as Int
i) (forall a. Array a -> Int -> a
A.indexArray Array (v a)
bs Int
i)) [Int
1 .. Int
bits forall a. Num a => a -> a -> a
- Int
1]
index :: G.Vector v a => Chimera v a -> Word -> a
index :: forall (v :: * -> *) a. Vector v a => Chimera v a -> Word -> a
index (Chimera Array (v a)
vs) Word
i =
(Array (v a)
vs forall a. Array a -> Int -> a
`A.indexArray` (Int
bits forall a. Num a => a -> a -> a
- Int
lz))
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
`G.unsafeIndex` Word -> Int
word2int (Word
i forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement ((Word
1 forall a. Bits a => a -> Int -> a
`shiftL` (Int
bits forall a. Num a => a -> a -> a
- Int
1)) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
lz))
where
lz :: Int
!lz :: Int
lz = forall b. FiniteBits b => b -> Int
countLeadingZeros Word
i
{-# INLINE index #-}
toList :: G.Vector v a => Chimera v a -> [a]
toList :: forall (v :: * -> *) a. Vector v a => Chimera v a -> [a]
toList (Chimera Array (v a)
vs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList Array (v a)
vs
toInfinite :: G.Vector v a => Chimera v a -> Infinite a
toInfinite :: forall (v :: * -> *) a. Vector v a => Chimera v a -> Infinite a
toInfinite = forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> Chimera v a -> b
foldr forall a. a -> Infinite a -> Infinite a
(:<)
foldr :: G.Vector v a => (a -> b -> b) -> Chimera v a -> b
foldr :: forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> Chimera v a -> b
foldr a -> b -> b
f (Chimera Array (v a)
vs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
G.foldr a -> b -> b
f) forall a. HasCallStack => a
undefined Array (v a)
vs
measureOff :: Int -> [a] -> Either Int ([a], [a])
measureOff :: forall a. Int -> [a] -> Either Int ([a], [a])
measureOff Int
n
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)
| Bool
otherwise = forall {t} {a}. (Eq t, Num t) => t -> [a] -> Either t ([a], [a])
go Int
n
where
go :: t -> [a] -> Either t ([a], [a])
go t
m [] = forall a b. a -> Either a b
Left t
m
go t
1 (a
x : [a]
xs) = forall a b. b -> Either a b
Right ([a
x], [a]
xs)
go t
m (a
x : [a]
xs) = case t -> [a] -> Either t ([a], [a])
go (t
m forall a. Num a => a -> a -> a
- t
1) [a]
xs of
l :: Either t ([a], [a])
l@Left {} -> Either t ([a], [a])
l
Right ([a]
xs', [a]
xs'') -> forall a b. b -> Either a b
Right (a
x forall a. a -> [a] -> [a]
: [a]
xs', [a]
xs'')
measureOffVector :: G.Vector v a => Int -> v a -> Either Int (v a, v a)
measureOffVector :: forall (v :: * -> *) a.
Vector v a =>
Int -> v a -> Either Int (v a, v a)
measureOffVector Int
n v a
xs
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
l = forall a b. b -> Either a b
Right (forall (v :: * -> *) a. Vector v a => Int -> v a -> (v a, v a)
G.splitAt Int
n v a
xs)
| Bool
otherwise = forall a b. a -> Either a b
Left (Int
n forall a. Num a => a -> a -> a
- Int
l)
where
l :: Int
l = forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
xs
fromListWithDef
:: G.Vector v a
=> a
-> [a]
-> Chimera v a
fromListWithDef :: forall (v :: * -> *) a. Vector v a => a -> [a] -> Chimera v a
fromListWithDef a
a = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [v a]
go0
where
go0 :: [a] -> [v a]
go0 = \case
[] -> forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
a forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Int
k -> forall (v :: * -> *) a. Vector v a => Int -> a -> v a
G.replicate (Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
k) a
a) [Int
0 .. Int
bits forall a. Num a => a -> a -> a
- Int
1]
a
x : [a]
xs -> forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
x forall a. a -> [a] -> [a]
: Int -> [a] -> [v a]
go Int
0 [a]
xs
go :: Int -> [a] -> [v a]
go Int
k [a]
xs = case forall a. Int -> [a] -> Either Int ([a], [a])
measureOff Int
kk [a]
xs of
Left Int
l ->
forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
G.fromListN Int
kk ([a]
xs forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
l a
a)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> forall (v :: * -> *) a. Vector v a => Int -> a -> v a
G.replicate (Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
n) a
a) [Int
k forall a. Num a => a -> a -> a
+ Int
1 .. Int
bits forall a. Num a => a -> a -> a
- Int
1]
Right ([a]
ys, [a]
zs) -> forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
G.fromListN Int
kk [a]
ys forall a. a -> [a] -> [a]
: Int -> [a] -> [v a]
go (Int
k forall a. Num a => a -> a -> a
+ Int
1) [a]
zs
where
kk :: Int
kk = Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
k
fromInfinite
:: G.Vector v a
=> Infinite a
-> Chimera v a
fromInfinite :: forall (v :: * -> *) a. Vector v a => Infinite a -> Chimera v a
fromInfinite = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {v :: * -> *} {a}. Vector v a => Infinite a -> [v a]
go0
where
go0 :: Infinite a -> [v a]
go0 (a
x :< Infinite a
xs) = forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
x forall a. a -> [a] -> [a]
: forall {v :: * -> *} {a}. Vector v a => Int -> Infinite a -> [v a]
go Int
0 Infinite a
xs
go :: Int -> Infinite a -> [v a]
go Int
k Infinite a
xs = forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
G.fromListN Int
kk [a]
ys forall a. a -> [a] -> [a]
: Int -> Infinite a -> [v a]
go (Int
k forall a. Num a => a -> a -> a
+ Int
1) Infinite a
zs
where
kk :: Int
kk = Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
k
([a]
ys, Infinite a
zs) = forall a. Int -> Infinite a -> ([a], Infinite a)
Inf.splitAt Int
kk Infinite a
xs
fromVectorWithDef
:: G.Vector v a
=> a
-> v a
-> Chimera v a
fromVectorWithDef :: forall (v :: * -> *) a. Vector v a => a -> v a -> Chimera v a
fromVectorWithDef a
a = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> [v a]
go0
where
go0 :: v a -> [v a]
go0 v a
xs = case forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
G.uncons v a
xs of
Maybe (a, v a)
Nothing -> forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
a forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Int
k -> forall (v :: * -> *) a. Vector v a => Int -> a -> v a
G.replicate (Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
k) a
a) [Int
0 .. Int
bits forall a. Num a => a -> a -> a
- Int
1]
Just (a
y, v a
ys) -> forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
y forall a. a -> [a] -> [a]
: Int -> v a -> [v a]
go Int
0 v a
ys
go :: Int -> v a -> [v a]
go Int
k v a
xs = case forall (v :: * -> *) a.
Vector v a =>
Int -> v a -> Either Int (v a, v a)
measureOffVector Int
kk v a
xs of
Left Int
l ->
(v a
xs forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
G.++ forall (v :: * -> *) a. Vector v a => Int -> a -> v a
G.replicate Int
l a
a)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> forall (v :: * -> *) a. Vector v a => Int -> a -> v a
G.replicate (Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
n) a
a) [Int
k forall a. Num a => a -> a -> a
+ Int
1 .. Int
bits forall a. Num a => a -> a -> a
- Int
1]
Right (v a
ys, v a
zs) -> v a
ys forall a. a -> [a] -> [a]
: Int -> v a -> [v a]
go (Int
k forall a. Num a => a -> a -> a
+ Int
1) v a
zs
where
kk :: Int
kk = Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
k
prependVector
:: forall v a
. G.Vector v a
=> v a
-> Chimera v a
-> Chimera v a
prependVector :: forall (v :: * -> *) a.
Vector v a =>
v a -> Chimera v a -> Chimera v a
prependVector (forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
G.uncons -> Maybe (a, v a)
Nothing) Chimera v a
ch = Chimera v a
ch
prependVector (forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
G.uncons -> Just (a
pref0, v a
pref)) (Chimera Array (v a)
as) =
forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall a b. (a -> b) -> a -> b
$
forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (v :: * -> *) a. Vector v a => [LazySlice (v a)] -> v a
sliceAndConcat forall a b. (a -> b) -> a -> b
$
[forall a. Word -> Word -> a -> LazySlice a
LazySlice Word
0 Word
1 forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => a -> v a
G.singleton a
pref0] forall a. a -> [a] -> [a]
: forall t. Int -> Word -> Word -> [(Word, t)] -> [[LazySlice t]]
go Int
0 Word
1 Word
0 [(Word, v a)]
inputs
where
inputs :: [(Word, v a)]
inputs :: [(Word, v a)]
inputs =
(Int -> Word
int2word forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
pref, v a
pref)
forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip (Word
1 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL`) [Int
0 .. Int
bits forall a. Num a => a -> a -> a
- Int
1]) (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Array (v a)
as)
go :: Int -> Word -> Word -> [(Word, t)] -> [[LazySlice t]]
go :: forall t. Int -> Word -> Word -> [(Word, t)] -> [[LazySlice t]]
go Int
_ Word
_ Word
_ [] = []
go Int
n Word
need Word
off orig :: [(Word, t)]
orig@((Word
lt, t
t) : [(Word, t)]
rest)
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
bits = []
| Bool
otherwise = case forall a. Ord a => a -> a -> Ordering
compare (Word
off forall a. Num a => a -> a -> a
+ Word
need) Word
lt of
Ordering
LT -> [forall a. Word -> Word -> a -> LazySlice a
LazySlice Word
off Word
need t
t] forall a. a -> [a] -> [a]
: forall t. Int -> Word -> Word -> [(Word, t)] -> [[LazySlice t]]
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) (Word
1 forall a. Bits a => a -> Int -> a
`shiftL` (Int
n forall a. Num a => a -> a -> a
+ Int
1)) (Word
off forall a. Num a => a -> a -> a
+ Word
need) [(Word, t)]
orig
Ordering
EQ -> [forall a. Word -> Word -> a -> LazySlice a
LazySlice Word
off Word
need t
t] forall a. a -> [a] -> [a]
: forall t. Int -> Word -> Word -> [(Word, t)] -> [[LazySlice t]]
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) (Word
1 forall a. Bits a => a -> Int -> a
`shiftL` (Int
n forall a. Num a => a -> a -> a
+ Int
1)) Word
0 [(Word, t)]
rest
Ordering
GT -> case forall t. Int -> Word -> Word -> [(Word, t)] -> [[LazySlice t]]
go Int
n (Word
off forall a. Num a => a -> a -> a
+ Word
need forall a. Num a => a -> a -> a
- Word
lt) Word
0 [(Word, t)]
rest of
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"prependVector: the stream should not get exhausted prematurely"
[LazySlice t]
hd : [[LazySlice t]]
tl -> (forall a. Word -> Word -> a -> LazySlice a
LazySlice Word
off (Word
lt forall a. Num a => a -> a -> a
- Word
off) t
t forall a. a -> [a] -> [a]
: [LazySlice t]
hd) forall a. a -> [a] -> [a]
: [[LazySlice t]]
tl
data LazySlice a = LazySlice !Word !Word a
sliceAndConcat :: G.Vector v a => [LazySlice (v a)] -> v a
sliceAndConcat :: forall (v :: * -> *) a. Vector v a => [LazySlice (v a)] -> v a
sliceAndConcat =
forall (v :: * -> *) a. Vector v a => [v a] -> v a
G.concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(LazySlice Word
from Word
len v a
vec) -> forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
G.slice (Word -> Int
word2int Word
from) (Word -> Int
word2int Word
len) v a
vec)
cycle :: G.Vector v a => v a -> Chimera v a
cycle :: forall (v :: * -> *) a. Vector v a => v a -> Chimera v a
cycle v a
vec = case Word
l of
Word
0 -> forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Chimera.cycle: empty list"
Word
_ -> forall (v :: * -> *) a. Vector v a => (Word -> a) -> Chimera v a
tabulate (forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex v a
vec forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
word2int forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`rem` Word
l))
where
l :: Word
l = Int -> Word
int2word forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
vec
mapSubvectors
:: (G.Vector u a, G.Vector v b)
=> (u a -> v b)
-> Chimera u a
-> Chimera v b
mapSubvectors :: forall (u :: * -> *) a (v :: * -> *) b.
(Vector u a, Vector v b) =>
(u a -> v b) -> Chimera u a -> Chimera v b
mapSubvectors u a -> v b
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (u :: * -> *) a (v :: * -> *) b (m :: * -> *).
(Vector u a, Vector v b, Applicative m) =>
(u a -> m (v b)) -> Chimera u a -> m (Chimera v b)
traverseSubvectors (coerce :: forall a b. Coercible a b => a -> b
coerce u a -> v b
f)
imapSubvectors
:: (G.Vector u a, G.Vector v b)
=> (Word -> u a -> v b)
-> Chimera u a
-> Chimera v b
imapSubvectors :: forall (u :: * -> *) a (v :: * -> *) b.
(Vector u a, Vector v b) =>
(Word -> u a -> v b) -> Chimera u a -> Chimera v b
imapSubvectors Word -> u a -> v b
f (Chimera Array (u a)
bs) = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith Int -> u a -> v b
safeF (forall l. IsList l => Int -> [Item l] -> l
fromListN (Int
bits forall a. Num a => a -> a -> a
+ Int
1) [Int
0 .. Int
bits]) Array (u a)
bs
where
safeF :: Int -> u a -> v b
safeF Int
i u a
x =
if Int
xLen forall a. Eq a => a -> a -> Bool
== forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v b
fx
then v b
fx
else forall a. HasCallStack => [Char] -> a
error [Char]
"imapSubvectors: the function is not length-preserving"
where
xLen :: Int
xLen = forall (v :: * -> *) a. Vector v a => v a -> Int
G.length u a
x
fx :: v b
fx = Word -> u a -> v b
f (if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then Word
0 else Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
i forall a. Num a => a -> a -> a
- Int
1)) u a
x
traverseSubvectors
:: (G.Vector u a, G.Vector v b, Applicative m)
=> (u a -> m (v b))
-> Chimera u a
-> m (Chimera v b)
traverseSubvectors :: forall (u :: * -> *) a (v :: * -> *) b (m :: * -> *).
(Vector u a, Vector v b, Applicative m) =>
(u a -> m (v b)) -> Chimera u a -> m (Chimera v b)
traverseSubvectors u a -> m (v b)
f (Chimera Array (u a)
bs) = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse u a -> m (v b)
safeF Array (u a)
bs
where
safeF :: u a -> m (v b)
safeF u a
x =
( \v b
fx ->
if forall (v :: * -> *) a. Vector v a => v a -> Int
G.length u a
x forall a. Eq a => a -> a -> Bool
== forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v b
fx
then v b
fx
else forall a. HasCallStack => [Char] -> a
error [Char]
"traverseSubvectors: the function is not length-preserving"
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u a -> m (v b)
f u a
x
{-# SPECIALIZE traverseSubvectors :: (G.Vector u a, G.Vector v b) => (u a -> Identity (v b)) -> Chimera u a -> Identity (Chimera v b) #-}
zipWithSubvectors
:: (G.Vector u a, G.Vector v b, G.Vector w c)
=> (u a -> v b -> w c)
-> Chimera u a
-> Chimera v b
-> Chimera w c
zipWithSubvectors :: forall (u :: * -> *) a (v :: * -> *) b (w :: * -> *) c.
(Vector u a, Vector v b, Vector w c) =>
(u a -> v b -> w c) -> Chimera u a -> Chimera v b -> Chimera w c
zipWithSubvectors u a -> v b -> w c
f = (forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (u :: * -> *) a (v :: * -> *) b (w :: * -> *) c
(m :: * -> *).
(Vector u a, Vector v b, Vector w c, Applicative m) =>
(u a -> v b -> m (w c))
-> Chimera u a -> Chimera v b -> m (Chimera w c)
zipWithMSubvectors (coerce :: forall a b. Coercible a b => a -> b
coerce u a -> v b -> w c
f)
zipWithMSubvectors
:: (G.Vector u a, G.Vector v b, G.Vector w c, Applicative m)
=> (u a -> v b -> m (w c))
-> Chimera u a
-> Chimera v b
-> m (Chimera w c)
zipWithMSubvectors :: forall (u :: * -> *) a (v :: * -> *) b (w :: * -> *) c
(m :: * -> *).
(Vector u a, Vector v b, Vector w c, Applicative m) =>
(u a -> v b -> m (w c))
-> Chimera u a -> Chimera v b -> m (Chimera w c)
zipWithMSubvectors u a -> v b -> m (w c)
f (Chimera Array (u a)
bs1) (Chimera Array (v b)
bs2) = forall {k} (v :: k -> *) (a :: k). Array (v a) -> Chimera v a
Chimera forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith u a -> v b -> m (w c)
safeF Array (u a)
bs1 Array (v b)
bs2)
where
safeF :: u a -> v b -> m (w c)
safeF u a
x v b
y =
( \w c
fx ->
if forall (v :: * -> *) a. Vector v a => v a -> Int
G.length u a
x forall a. Eq a => a -> a -> Bool
== forall (v :: * -> *) a. Vector v a => v a -> Int
G.length w c
fx
then w c
fx
else forall a. HasCallStack => [Char] -> a
error [Char]
"traverseSubvectors: the function is not length-preserving"
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u a -> v b -> m (w c)
f u a
x v b
y
{-# SPECIALIZE zipWithMSubvectors :: (G.Vector u a, G.Vector v b, G.Vector w c) => (u a -> v b -> Identity (w c)) -> Chimera u a -> Chimera v b -> Identity (Chimera w c) #-}
sliceSubvectors
:: G.Vector v a
=> Int
-> Int
-> Chimera v a
-> [v a]
sliceSubvectors :: forall (v :: * -> *) a.
Vector v a =>
Int -> Int -> Chimera v a -> [v a]
sliceSubvectors Int
off Int
len = forall {v :: * -> *} {a}. Vector v a => Int -> [v a] -> [v a]
doTake Int
len forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {v :: * -> *} {a}. Vector v a => Int -> [v a] -> [v a]
doDrop Int
off forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (v :: k -> *) (a :: k). Chimera v a -> Array (v a)
unChimera
where
doTake :: Int -> [v a] -> [v a]
doTake !Int
_ [] = []
doTake Int
n (v a
x : [v a]
xs)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = []
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
l = v a
x forall a. a -> [a] -> [a]
: Int -> [v a] -> [v a]
doTake (Int
n forall a. Num a => a -> a -> a
- Int
l) [v a]
xs
| Bool
otherwise = [forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
G.take Int
n v a
x]
where
l :: Int
l = forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
x
doDrop :: Int -> [v a] -> [v a]
doDrop !Int
_ [] = []
doDrop Int
n (v a
x : [v a]
xs)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = v a
x forall a. a -> [a] -> [a]
: [v a]
xs
| Int
l forall a. Ord a => a -> a -> Bool
<= Int
n = Int -> [v a] -> [v a]
doDrop (Int
n forall a. Num a => a -> a -> a
- Int
l) [v a]
xs
| Bool
otherwise = forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
G.drop Int
n v a
x forall a. a -> [a] -> [a]
: [v a]
xs
where
l :: Int
l = forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
x