{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE NoStarIsType #-}
#endif
module Basement.Sized.Block
( BlockN
, MutableBlockN
, length
, lengthBytes
, toBlockN
, toBlock
, new
, newPinned
, singleton
, replicate
, thaw
, freeze
, index
, indexStatic
, map
, foldl'
, foldr
, cons
, snoc
, elem
, sub
, uncons
, unsnoc
, splitAt
, all
, any
, find
, reverse
, sortBy
, intersperse
, withPtr
, withMutablePtr
, withMutablePtrHint
, cast
, mutableCast
) where
import Data.Proxy (Proxy(..))
import Basement.Compat.Base
import Basement.Numerical.Additive (scale)
import Basement.Block (Block, MutableBlock(..), unsafeIndex)
import qualified Basement.Block as B
import qualified Basement.Block.Base as B
import Basement.Monad (PrimMonad, PrimState)
import Basement.Nat
import Basement.Types.OffsetSize
import Basement.NormalForm
import Basement.PrimType (PrimType, PrimSize, primSizeInBytes)
newtype BlockN (n :: Nat) a = BlockN { BlockN n a -> Block a
unBlock :: Block a }
deriving (BlockN n a -> ()
(BlockN n a -> ()) -> NormalForm (BlockN n a)
forall a. (a -> ()) -> NormalForm a
forall (n :: Nat) a. BlockN n a -> ()
toNormalForm :: BlockN n a -> ()
$ctoNormalForm :: forall (n :: Nat) a. BlockN n a -> ()
NormalForm, BlockN n a -> BlockN n a -> Bool
(BlockN n a -> BlockN n a -> Bool)
-> (BlockN n a -> BlockN n a -> Bool) -> Eq (BlockN n a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat) a. PrimType a => BlockN n a -> BlockN n a -> Bool
/= :: BlockN n a -> BlockN n a -> Bool
$c/= :: forall (n :: Nat) a. PrimType a => BlockN n a -> BlockN n a -> Bool
== :: BlockN n a -> BlockN n a -> Bool
$c== :: forall (n :: Nat) a. PrimType a => BlockN n a -> BlockN n a -> Bool
Eq, Int -> BlockN n a -> ShowS
[BlockN n a] -> ShowS
BlockN n a -> String
(Int -> BlockN n a -> ShowS)
-> (BlockN n a -> String)
-> ([BlockN n a] -> ShowS)
-> Show (BlockN n a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat) a.
(PrimType a, Show a) =>
Int -> BlockN n a -> ShowS
forall (n :: Nat) a. (PrimType a, Show a) => [BlockN n a] -> ShowS
forall (n :: Nat) a. (PrimType a, Show a) => BlockN n a -> String
showList :: [BlockN n a] -> ShowS
$cshowList :: forall (n :: Nat) a. (PrimType a, Show a) => [BlockN n a] -> ShowS
show :: BlockN n a -> String
$cshow :: forall (n :: Nat) a. (PrimType a, Show a) => BlockN n a -> String
showsPrec :: Int -> BlockN n a -> ShowS
$cshowsPrec :: forall (n :: Nat) a.
(PrimType a, Show a) =>
Int -> BlockN n a -> ShowS
Show, Typeable (BlockN n a)
DataType
Constr
Typeable (BlockN n a)
-> (forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockN n a -> c (BlockN n a))
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BlockN n a))
-> (BlockN n a -> Constr)
-> (BlockN n a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (BlockN n a)))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BlockN n a)))
-> ((forall b. Data b => b -> b) -> BlockN n a -> BlockN n a)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r)
-> (forall u. (forall d. Data d => d -> u) -> BlockN n a -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> BlockN n a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a))
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a))
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a))
-> Data (BlockN n a)
BlockN n a -> DataType
BlockN n a -> Constr
(forall b. Data b => b -> b) -> BlockN n a -> BlockN n a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockN n a -> c (BlockN n a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BlockN n a)
forall a.
Typeable a
-> (forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BlockN n a -> u
forall u. (forall d. Data d => d -> u) -> BlockN n a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
forall (n :: Nat) a. (KnownNat n, Data a) => Typeable (BlockN n a)
forall (n :: Nat) a. (KnownNat n, Data a) => BlockN n a -> DataType
forall (n :: Nat) a. (KnownNat n, Data a) => BlockN n a -> Constr
forall (n :: Nat) a.
(KnownNat n, Data a) =>
(forall b. Data b => b -> b) -> BlockN n a -> BlockN n a
forall (n :: Nat) a u.
(KnownNat n, Data a) =>
Int -> (forall d. Data d => d -> u) -> BlockN n a -> u
forall (n :: Nat) a u.
(KnownNat n, Data a) =>
(forall d. Data d => d -> u) -> BlockN n a -> [u]
forall (n :: Nat) a r r'.
(KnownNat n, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
forall (n :: Nat) a r r'.
(KnownNat n, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
forall (n :: Nat) a (m :: Type -> Type).
(KnownNat n, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
forall (n :: Nat) a (m :: Type -> Type).
(KnownNat n, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
forall (n :: Nat) a (c :: Type -> Type).
(KnownNat n, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BlockN n a)
forall (n :: Nat) a (c :: Type -> Type).
(KnownNat n, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockN n a -> c (BlockN n a)
forall (n :: Nat) a (t :: Type -> Type) (c :: Type -> Type).
(KnownNat n, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BlockN n a))
forall (n :: Nat) a (t :: Type -> Type -> Type)
(c :: Type -> Type).
(KnownNat n, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BlockN n a))
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BlockN n a)
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockN n a -> c (BlockN n a)
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (BlockN n a))
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BlockN n a))
$cBlockN :: Constr
$tBlockN :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
$cgmapMo :: forall (n :: Nat) a (m :: Type -> Type).
(KnownNat n, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
gmapMp :: (forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
$cgmapMp :: forall (n :: Nat) a (m :: Type -> Type).
(KnownNat n, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
gmapM :: (forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
$cgmapM :: forall (n :: Nat) a (m :: Type -> Type).
(KnownNat n, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> BlockN n a -> m (BlockN n a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> BlockN n a -> u
$cgmapQi :: forall (n :: Nat) a u.
(KnownNat n, Data a) =>
Int -> (forall d. Data d => d -> u) -> BlockN n a -> u
gmapQ :: (forall d. Data d => d -> u) -> BlockN n a -> [u]
$cgmapQ :: forall (n :: Nat) a u.
(KnownNat n, Data a) =>
(forall d. Data d => d -> u) -> BlockN n a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
$cgmapQr :: forall (n :: Nat) a r r'.
(KnownNat n, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
$cgmapQl :: forall (n :: Nat) a r r'.
(KnownNat n, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockN n a -> r
gmapT :: (forall b. Data b => b -> b) -> BlockN n a -> BlockN n a
$cgmapT :: forall (n :: Nat) a.
(KnownNat n, Data a) =>
(forall b. Data b => b -> b) -> BlockN n a -> BlockN n a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BlockN n a))
$cdataCast2 :: forall (n :: Nat) a (t :: Type -> Type -> Type)
(c :: Type -> Type).
(KnownNat n, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BlockN n a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (BlockN n a))
$cdataCast1 :: forall (n :: Nat) a (t :: Type -> Type) (c :: Type -> Type).
(KnownNat n, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BlockN n a))
dataTypeOf :: BlockN n a -> DataType
$cdataTypeOf :: forall (n :: Nat) a. (KnownNat n, Data a) => BlockN n a -> DataType
toConstr :: BlockN n a -> Constr
$ctoConstr :: forall (n :: Nat) a. (KnownNat n, Data a) => BlockN n a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BlockN n a)
$cgunfold :: forall (n :: Nat) a (c :: Type -> Type).
(KnownNat n, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BlockN n a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockN n a -> c (BlockN n a)
$cgfoldl :: forall (n :: Nat) a (c :: Type -> Type).
(KnownNat n, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockN n a -> c (BlockN n a)
$cp1Data :: forall (n :: Nat) a. (KnownNat n, Data a) => Typeable (BlockN n a)
Data, Eq (BlockN n a)
Eq (BlockN n a)
-> (BlockN n a -> BlockN n a -> Ordering)
-> (BlockN n a -> BlockN n a -> Bool)
-> (BlockN n a -> BlockN n a -> Bool)
-> (BlockN n a -> BlockN n a -> Bool)
-> (BlockN n a -> BlockN n a -> Bool)
-> (BlockN n a -> BlockN n a -> BlockN n a)
-> (BlockN n a -> BlockN n a -> BlockN n a)
-> Ord (BlockN n a)
BlockN n a -> BlockN n a -> Bool
BlockN n a -> BlockN n a -> Ordering
BlockN n a -> BlockN n a -> BlockN n a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (n :: Nat) a. (PrimType a, Ord a) => Eq (BlockN n a)
forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> Bool
forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> Ordering
forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> BlockN n a
min :: BlockN n a -> BlockN n a -> BlockN n a
$cmin :: forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> BlockN n a
max :: BlockN n a -> BlockN n a -> BlockN n a
$cmax :: forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> BlockN n a
>= :: BlockN n a -> BlockN n a -> Bool
$c>= :: forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> Bool
> :: BlockN n a -> BlockN n a -> Bool
$c> :: forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> Bool
<= :: BlockN n a -> BlockN n a -> Bool
$c<= :: forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> Bool
< :: BlockN n a -> BlockN n a -> Bool
$c< :: forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> Bool
compare :: BlockN n a -> BlockN n a -> Ordering
$ccompare :: forall (n :: Nat) a.
(PrimType a, Ord a) =>
BlockN n a -> BlockN n a -> Ordering
$cp1Ord :: forall (n :: Nat) a. (PrimType a, Ord a) => Eq (BlockN n a)
Ord)
newtype MutableBlockN (n :: Nat) ty st = MutableBlockN { MutableBlockN n ty st -> MutableBlock ty st
unMBlock :: MutableBlock ty st }
toBlockN :: forall n ty . (PrimType ty, KnownNat n, Countable ty n) => Block ty -> Maybe (BlockN n ty)
toBlockN :: Block ty -> Maybe (BlockN n ty)
toBlockN Block ty
b
| CountOf ty
expected CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
B.length Block ty
b = BlockN n ty -> Maybe (BlockN n ty)
forall a. a -> Maybe a
Just (Block ty -> BlockN n ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN Block ty
b)
| Bool
otherwise = Maybe (BlockN n ty)
forall a. Maybe a
Nothing
where
expected :: CountOf ty
expected = forall ty. (KnownNat n, Countable ty n) => CountOf ty
forall (n :: Nat) ty. (KnownNat n, Countable ty n) => CountOf ty
toCount @n
length :: forall n ty
. (KnownNat n, Countable ty n)
=> BlockN n ty
-> CountOf ty
length :: BlockN n ty -> CountOf ty
length BlockN n ty
_ = forall ty. (KnownNat n, Countable ty n) => CountOf ty
forall (n :: Nat) ty. (KnownNat n, Countable ty n) => CountOf ty
toCount @n
lengthBytes :: forall n ty
. PrimType ty
=> BlockN n ty
-> CountOf Word8
lengthBytes :: BlockN n ty -> CountOf Word8
lengthBytes = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
B.lengthBytes (Block ty -> CountOf Word8)
-> (BlockN n ty -> Block ty) -> BlockN n ty -> CountOf Word8
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock
toBlock :: BlockN n ty -> Block ty
toBlock :: BlockN n ty -> Block ty
toBlock = BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock
cast :: forall n m a b
. ( PrimType a, PrimType b
, KnownNat n, KnownNat m
, ((PrimSize b) * m) ~ ((PrimSize a) * n)
)
=> BlockN n a
-> BlockN m b
cast :: BlockN n a -> BlockN m b
cast (BlockN Block a
b) = Block b -> BlockN m b
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block a -> Block b
forall b a. PrimType b => Block a -> Block b
B.unsafeCast Block a
b)
mutableCast :: forall n m a b st
. ( PrimType a, PrimType b
, KnownNat n, KnownNat m
, ((PrimSize b) * m) ~ ((PrimSize a) * n)
)
=> MutableBlockN n a st
-> MutableBlockN m b st
mutableCast :: MutableBlockN n a st -> MutableBlockN m b st
mutableCast (MutableBlockN MutableBlock a st
b) = MutableBlock b st -> MutableBlockN m b st
forall (n :: Nat) ty st.
MutableBlock ty st -> MutableBlockN n ty st
MutableBlockN (MutableBlock a st -> MutableBlock b st
forall t1 t2 st.
(PrimType t1, PrimType t2) =>
MutableBlock t1 st -> MutableBlock t2 st
B.unsafeRecast MutableBlock a st
b)
new :: forall n ty prim
. (PrimType ty, KnownNat n, Countable ty n, PrimMonad prim)
=> prim (MutableBlockN n ty (PrimState prim))
new :: prim (MutableBlockN n ty (PrimState prim))
new = MutableBlock ty (PrimState prim)
-> MutableBlockN n ty (PrimState prim)
forall (n :: Nat) ty st.
MutableBlock ty st -> MutableBlockN n ty st
MutableBlockN (MutableBlock ty (PrimState prim)
-> MutableBlockN n ty (PrimState prim))
-> prim (MutableBlock ty (PrimState prim))
-> prim (MutableBlockN n ty (PrimState prim))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CountOf ty -> prim (MutableBlock ty (PrimState prim))
forall (prim :: Type -> Type) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
B.new (forall ty. (KnownNat n, Countable ty n) => CountOf ty
forall (n :: Nat) ty. (KnownNat n, Countable ty n) => CountOf ty
toCount @n)
newPinned :: forall n ty prim
. (PrimType ty, KnownNat n, Countable ty n, PrimMonad prim)
=> prim (MutableBlockN n ty (PrimState prim))
newPinned :: prim (MutableBlockN n ty (PrimState prim))
newPinned = MutableBlock ty (PrimState prim)
-> MutableBlockN n ty (PrimState prim)
forall (n :: Nat) ty st.
MutableBlock ty st -> MutableBlockN n ty st
MutableBlockN (MutableBlock ty (PrimState prim)
-> MutableBlockN n ty (PrimState prim))
-> prim (MutableBlock ty (PrimState prim))
-> prim (MutableBlockN n ty (PrimState prim))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CountOf ty -> prim (MutableBlock ty (PrimState prim))
forall (prim :: Type -> Type) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
B.newPinned (forall ty. (KnownNat n, Countable ty n) => CountOf ty
forall (n :: Nat) ty. (KnownNat n, Countable ty n) => CountOf ty
toCount @n)
singleton :: PrimType ty => ty -> BlockN 1 ty
singleton :: ty -> BlockN 1 ty
singleton ty
a = Block ty -> BlockN 1 ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (ty -> Block ty
forall ty. PrimType ty => ty -> Block ty
B.singleton ty
a)
replicate :: forall n ty . (KnownNat n, Countable ty n, PrimType ty) => ty -> BlockN n ty
replicate :: ty -> BlockN n ty
replicate ty
a = Block ty -> BlockN n ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (CountOf ty -> ty -> Block ty
forall ty. PrimType ty => CountOf ty -> ty -> Block ty
B.replicate (forall ty. (KnownNat n, Countable ty n) => CountOf ty
forall (n :: Nat) ty. (KnownNat n, Countable ty n) => CountOf ty
toCount @n) ty
a)
thaw :: (KnownNat n, PrimMonad prim, PrimType ty) => BlockN n ty -> prim (MutableBlockN n ty (PrimState prim))
thaw :: BlockN n ty -> prim (MutableBlockN n ty (PrimState prim))
thaw BlockN n ty
b = MutableBlock ty (PrimState prim)
-> MutableBlockN n ty (PrimState prim)
forall (n :: Nat) ty st.
MutableBlock ty st -> MutableBlockN n ty st
MutableBlockN (MutableBlock ty (PrimState prim)
-> MutableBlockN n ty (PrimState prim))
-> prim (MutableBlock ty (PrimState prim))
-> prim (MutableBlockN n ty (PrimState prim))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Block ty -> prim (MutableBlock ty (PrimState prim))
forall (prim :: Type -> Type) ty.
(PrimMonad prim, PrimType ty) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
B.thaw (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
freeze :: (PrimMonad prim, PrimType ty, Countable ty n) => MutableBlockN n ty (PrimState prim) -> prim (BlockN n ty)
freeze :: MutableBlockN n ty (PrimState prim) -> prim (BlockN n ty)
freeze MutableBlockN n ty (PrimState prim)
b = Block ty -> BlockN n ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block ty -> BlockN n ty) -> prim (Block ty) -> prim (BlockN n ty)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableBlock ty (PrimState prim) -> prim (Block ty)
forall ty (prim :: Type -> Type).
(PrimType ty, PrimMonad prim) =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
B.freeze (MutableBlockN n ty (PrimState prim)
-> MutableBlock ty (PrimState prim)
forall (n :: Nat) ty st.
MutableBlockN n ty st -> MutableBlock ty st
unMBlock MutableBlockN n ty (PrimState prim)
b)
indexStatic :: forall i n ty . (KnownNat i, CmpNat i n ~ 'LT, PrimType ty, Offsetable ty i) => BlockN n ty -> ty
indexStatic :: BlockN n ty -> ty
indexStatic BlockN n ty
b = Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b) (forall ty. (KnownNat i, Offsetable ty i) => Offset ty
forall (n :: Nat) ty. (KnownNat n, Offsetable ty n) => Offset ty
toOffset @i)
index :: forall i n ty . PrimType ty => BlockN n ty -> Offset ty -> ty
index :: BlockN n ty -> Offset ty -> ty
index BlockN n ty
b Offset ty
ofs = Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
B.index (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b) Offset ty
ofs
map :: (PrimType a, PrimType b) => (a -> b) -> BlockN n a -> BlockN n b
map :: (a -> b) -> BlockN n a -> BlockN n b
map a -> b
f BlockN n a
b = Block b -> BlockN n b
forall (n :: Nat) a. Block a -> BlockN n a
BlockN ((a -> b) -> Block a -> Block b
forall a b.
(PrimType a, PrimType b) =>
(a -> b) -> Block a -> Block b
B.map a -> b
f (BlockN n a -> Block a
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n a
b))
foldl' :: PrimType ty => (a -> ty -> a) -> a -> BlockN n ty -> a
foldl' :: (a -> ty -> a) -> a -> BlockN n ty -> a
foldl' a -> ty -> a
f a
acc BlockN n ty
b = (a -> ty -> a) -> a -> Block ty -> a
forall ty a. PrimType ty => (a -> ty -> a) -> a -> Block ty -> a
B.foldl' a -> ty -> a
f a
acc (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
foldr :: PrimType ty => (ty -> a -> a) -> a -> BlockN n ty -> a
foldr :: (ty -> a -> a) -> a -> BlockN n ty -> a
foldr ty -> a -> a
f a
acc BlockN n ty
b = (ty -> a -> a) -> a -> Block ty -> a
forall ty a. PrimType ty => (ty -> a -> a) -> a -> Block ty -> a
B.foldr ty -> a -> a
f a
acc (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
cons :: PrimType ty => ty -> BlockN n ty -> BlockN (n+1) ty
cons :: ty -> BlockN n ty -> BlockN (n + 1) ty
cons ty
e = Block ty -> BlockN (n + 1) ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block ty -> BlockN (n + 1) ty)
-> (BlockN n ty -> Block ty) -> BlockN n ty -> BlockN (n + 1) ty
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ty -> Block ty -> Block ty
forall ty. PrimType ty => ty -> Block ty -> Block ty
B.cons ty
e (Block ty -> Block ty)
-> (BlockN n ty -> Block ty) -> BlockN n ty -> Block ty
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock
snoc :: PrimType ty => BlockN n ty -> ty -> BlockN (n+1) ty
snoc :: BlockN n ty -> ty -> BlockN (n + 1) ty
snoc BlockN n ty
b = Block ty -> BlockN (n + 1) ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block ty -> BlockN (n + 1) ty)
-> (ty -> Block ty) -> ty -> BlockN (n + 1) ty
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Block ty -> ty -> Block ty
forall ty. PrimType ty => Block ty -> ty -> Block ty
B.snoc (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
sub :: forall i j n ty
. ( (i <=? n) ~ 'True
, (j <=? n) ~ 'True
, (i <=? j) ~ 'True
, PrimType ty
, KnownNat i
, KnownNat j
, Offsetable ty i
, Offsetable ty j )
=> BlockN n ty
-> BlockN (j-i) ty
sub :: BlockN n ty -> BlockN (j - i) ty
sub BlockN n ty
block = Block ty -> BlockN (j - i) ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block ty -> Offset ty -> Offset ty -> Block ty
forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
B.sub (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
block) (forall ty. (KnownNat i, Offsetable ty i) => Offset ty
forall (n :: Nat) ty. (KnownNat n, Offsetable ty n) => Offset ty
toOffset @i) (forall ty. (KnownNat j, Offsetable ty j) => Offset ty
forall (n :: Nat) ty. (KnownNat n, Offsetable ty n) => Offset ty
toOffset @j))
uncons :: forall n ty . (CmpNat 0 n ~ 'LT, PrimType ty, KnownNat n, Offsetable ty n)
=> BlockN n ty
-> (ty, BlockN (n-1) ty)
uncons :: BlockN n ty -> (ty, BlockN (n - 1) ty)
uncons BlockN n ty
b = (BlockN n ty -> ty
forall (i :: Nat) (n :: Nat) ty.
(KnownNat i, CmpNat i n ~ 'LT, PrimType ty, Offsetable ty i) =>
BlockN n ty -> ty
indexStatic @0 BlockN n ty
b, Block ty -> BlockN (n - 1) ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block ty -> Offset ty -> Offset ty -> Block ty
forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
B.sub (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b) Offset ty
1 (forall ty. (KnownNat n, Offsetable ty n) => Offset ty
forall (n :: Nat) ty. (KnownNat n, Offsetable ty n) => Offset ty
toOffset @n)))
unsnoc :: forall n ty . (CmpNat 0 n ~ 'LT, KnownNat n, PrimType ty, Offsetable ty n)
=> BlockN n ty
-> (BlockN (n-1) ty, ty)
unsnoc :: BlockN n ty -> (BlockN (n - 1) ty, ty)
unsnoc BlockN n ty
b =
( Block ty -> BlockN (n - 1) ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block ty -> Offset ty -> Offset ty -> Block ty
forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
B.sub (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b) Offset ty
0 (forall ty. (KnownNat n, Offsetable ty n) => Offset ty
forall (n :: Nat) ty. (KnownNat n, Offsetable ty n) => Offset ty
toOffset @n Offset ty -> Offset ty -> Offset ty
forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset ty
1))
, Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b) (forall ty. (KnownNat n, Offsetable ty n) => Offset ty
forall (n :: Nat) ty. (KnownNat n, Offsetable ty n) => Offset ty
toOffset @n Offset ty -> Offset ty -> Offset ty
forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset ty
1))
splitAt :: forall i n ty . (CmpNat i n ~ 'LT, PrimType ty, KnownNat i, Countable ty i) => BlockN n ty -> (BlockN i ty, BlockN (n-i) ty)
splitAt :: BlockN n ty -> (BlockN i ty, BlockN (n - i) ty)
splitAt BlockN n ty
b =
let (Block ty
left, Block ty
right) = CountOf ty -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
B.splitAt (forall ty. (KnownNat i, Countable ty i) => CountOf ty
forall (n :: Nat) ty. (KnownNat n, Countable ty n) => CountOf ty
toCount @i) (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
in (Block ty -> BlockN i ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN Block ty
left, Block ty -> BlockN (n - i) ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN Block ty
right)
elem :: PrimType ty => ty -> BlockN n ty -> Bool
elem :: ty -> BlockN n ty -> Bool
elem ty
e BlockN n ty
b = ty -> Block ty -> Bool
forall ty. PrimType ty => ty -> Block ty -> Bool
B.elem ty
e (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
all :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool
all :: (ty -> Bool) -> BlockN n ty -> Bool
all ty -> Bool
p BlockN n ty
b = (ty -> Bool) -> Block ty -> Bool
forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Bool
B.all ty -> Bool
p (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
any :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool
any :: (ty -> Bool) -> BlockN n ty -> Bool
any ty -> Bool
p BlockN n ty
b = (ty -> Bool) -> Block ty -> Bool
forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Bool
B.any ty -> Bool
p (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
find :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Maybe ty
find :: (ty -> Bool) -> BlockN n ty -> Maybe ty
find ty -> Bool
p BlockN n ty
b = (ty -> Bool) -> Block ty -> Maybe ty
forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Maybe ty
B.find ty -> Bool
p (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
reverse :: PrimType ty => BlockN n ty -> BlockN n ty
reverse :: BlockN n ty -> BlockN n ty
reverse = Block ty -> BlockN n ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (Block ty -> BlockN n ty)
-> (BlockN n ty -> Block ty) -> BlockN n ty -> BlockN n ty
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Block ty -> Block ty
forall ty. PrimType ty => Block ty -> Block ty
B.reverse (Block ty -> Block ty)
-> (BlockN n ty -> Block ty) -> BlockN n ty -> Block ty
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock
sortBy :: PrimType ty => (ty -> ty -> Ordering) -> BlockN n ty -> BlockN n ty
sortBy :: (ty -> ty -> Ordering) -> BlockN n ty -> BlockN n ty
sortBy ty -> ty -> Ordering
f BlockN n ty
b = Block ty -> BlockN n ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN ((ty -> ty -> Ordering) -> Block ty -> Block ty
forall ty.
PrimType ty =>
(ty -> ty -> Ordering) -> Block ty -> Block ty
B.sortBy ty -> ty -> Ordering
f (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b))
intersperse :: (CmpNat n 1 ~ 'GT, PrimType ty) => ty -> BlockN n ty -> BlockN (n+n-1) ty
intersperse :: ty -> BlockN n ty -> BlockN ((n + n) - 1) ty
intersperse ty
sep BlockN n ty
b = Block ty -> BlockN ((n + n) - 1) ty
forall (n :: Nat) a. Block a -> BlockN n a
BlockN (ty -> Block ty -> Block ty
forall ty. PrimType ty => ty -> Block ty -> Block ty
B.intersperse ty
sep (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b))
toCount :: forall n ty . (KnownNat n, Countable ty n) => CountOf ty
toCount :: CountOf ty
toCount = Proxy n -> CountOf ty
forall (n :: Nat) ty (proxy :: Nat -> Type).
(KnownNat n, NatWithinBound (CountOf ty) n) =>
proxy n -> CountOf ty
natValCountOf (Proxy n
forall k (t :: k). Proxy t
Proxy @n)
toOffset :: forall n ty . (KnownNat n, Offsetable ty n) => Offset ty
toOffset :: Offset ty
toOffset = Proxy n -> Offset ty
forall (n :: Nat) ty (proxy :: Nat -> Type).
(KnownNat n, NatWithinBound (Offset ty) n) =>
proxy n -> Offset ty
natValOffset (Proxy n
forall k (t :: k). Proxy t
Proxy @n)
withPtr :: (PrimMonad prim, KnownNat n)
=> BlockN n ty
-> (Ptr ty -> prim a)
-> prim a
withPtr :: BlockN n ty -> (Ptr ty -> prim a) -> prim a
withPtr BlockN n ty
b = Block ty -> (Ptr ty -> prim a) -> prim a
forall (prim :: Type -> Type) ty a.
PrimMonad prim =>
Block ty -> (Ptr ty -> prim a) -> prim a
B.withPtr (BlockN n ty -> Block ty
forall (n :: Nat) a. BlockN n a -> Block a
unBlock BlockN n ty
b)
withMutablePtr :: (PrimMonad prim, KnownNat n)
=> MutableBlockN n ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
withMutablePtr :: MutableBlockN n ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr MutableBlockN n ty (PrimState prim)
mb = MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
forall (prim :: Type -> Type) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
B.withMutablePtr (MutableBlockN n ty (PrimState prim)
-> MutableBlock ty (PrimState prim)
forall (n :: Nat) ty st.
MutableBlockN n ty st -> MutableBlock ty st
unMBlock MutableBlockN n ty (PrimState prim)
mb)
withMutablePtrHint :: forall n ty prim a . (PrimMonad prim, KnownNat n)
=> Bool
-> Bool
-> MutableBlockN n ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
withMutablePtrHint :: Bool
-> Bool
-> MutableBlockN n ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
withMutablePtrHint Bool
skipCopy Bool
skipCopyBack (MutableBlockN MutableBlock ty (PrimState prim)
mb) Ptr ty -> prim a
f =
Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
forall ty (prim :: Type -> Type) a.
PrimMonad prim =>
Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
B.withMutablePtrHint Bool
skipCopy Bool
skipCopyBack MutableBlock ty (PrimState prim)
mb Ptr ty -> prim a
f