module PrimitiveExtras.SmallArray where
import qualified Focus
import GHC.Exts hiding (toList)
import qualified ListT
import PrimitiveExtras.Prelude
{-# INLINE newEmptySmallArray #-}
newEmptySmallArray :: (PrimMonad m) => Int -> m (SmallMutableArray (PrimState m) a)
newEmptySmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newEmptySmallArray Int
size = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
size (forall a b. a -> b
unsafeCoerce Integer
0)
{-# INLINE list #-}
list :: [a] -> SmallArray a
list :: forall a. [a] -> SmallArray a
list [a]
list =
let !size :: Int
size = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list
in forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray forall a b. (a -> b) -> a -> b
$ do
SmallMutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newEmptySmallArray Int
size
let populate :: Int -> [a] -> ST s (SmallMutableArray s a)
populate Int
index [a]
list = case [a]
list of
a
element : [a]
list -> do
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
index a
element
Int -> [a] -> ST s (SmallMutableArray s a)
populate (forall a. Enum a => a -> a
succ Int
index) [a]
list
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s a
m
in Int -> [a] -> ST s (SmallMutableArray s a)
populate Int
0 [a]
list
{-# INLINE unset #-}
unset :: Int -> SmallArray a -> SmallArray a
unset :: forall a. Int -> SmallArray a -> SmallArray a
unset Int
index SmallArray a
array =
{-# SCC "unset" #-}
let !size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
!newSize :: Int
newSize = forall a. Enum a => a -> a
pred Int
size
!newIndex :: Int
newIndex = forall a. Enum a => a -> a
succ Int
index
!amountOfFollowingElements :: Int
amountOfFollowingElements = Int
size forall a. Num a => a -> a -> a
- Int
newIndex
in forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray forall a b. (a -> b) -> a -> b
$ do
SmallMutableArray s a
newMa <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
newSize forall a. HasCallStack => a
undefined
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
newMa Int
0 SmallArray a
array Int
0 Int
index
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
newMa Int
index SmallArray a
array Int
newIndex Int
amountOfFollowingElements
forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s a
newMa
{-# INLINE set #-}
set :: Int -> a -> SmallArray a -> SmallArray a
set :: forall a. Int -> a -> SmallArray a -> SmallArray a
set Int
index a
a SmallArray a
array =
{-# SCC "set" #-}
let size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
in forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
SmallMutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray SmallArray a
array Int
0 Int
size
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
index a
a
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
m
{-# INLINE insert #-}
insert :: Int -> a -> SmallArray a -> SmallArray a
insert :: forall a. Int -> a -> SmallArray a -> SmallArray a
insert Int
index a
a SmallArray a
array =
{-# SCC "insert" #-}
let !size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
!newSize :: Int
newSize = forall a. Enum a => a -> a
succ Int
size
!nextIndex :: Int
nextIndex = forall a. Enum a => a -> a
succ Int
index
!amountOfFollowingElements :: Int
amountOfFollowingElements = Int
size forall a. Num a => a -> a -> a
- Int
index
in forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray forall a b. (a -> b) -> a -> b
$ do
SmallMutableArray s a
newMa <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
newSize a
a
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
newMa Int
0 SmallArray a
array Int
0 Int
index
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
newMa Int
nextIndex SmallArray a
array Int
index Int
amountOfFollowingElements
forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s a
newMa
{-# INLINE adjust #-}
adjust :: (a -> a) -> Int -> SmallArray a -> SmallArray a
adjust :: forall a. (a -> a) -> Int -> SmallArray a -> SmallArray a
adjust a -> a
fn Int
index SmallArray a
array =
let size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
in if Int
size forall a. Ord a => a -> a -> Bool
> Int
index Bool -> Bool -> Bool
&& Int
index forall a. Ord a => a -> a -> Bool
>= Int
0
then forall a. (a -> a) -> Int -> Int -> SmallArray a -> SmallArray a
unsafeAdjustWithSize a -> a
fn Int
index Int
size SmallArray a
array
else SmallArray a
array
{-# INLINE unsafeAdjust #-}
unsafeAdjust :: (a -> a) -> Int -> SmallArray a -> SmallArray a
unsafeAdjust :: forall a. (a -> a) -> Int -> SmallArray a -> SmallArray a
unsafeAdjust a -> a
fn Int
index SmallArray a
array =
forall a. (a -> a) -> Int -> Int -> SmallArray a -> SmallArray a
unsafeAdjustWithSize a -> a
fn Int
index (forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array) SmallArray a
array
{-# INLINE unsafeAdjustWithSize #-}
unsafeAdjustWithSize :: (a -> a) -> Int -> Int -> SmallArray a -> SmallArray a
unsafeAdjustWithSize :: forall a. (a -> a) -> Int -> Int -> SmallArray a -> SmallArray a
unsafeAdjustWithSize a -> a
fn Int
index Int
size SmallArray a
array =
forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
SmallMutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray SmallArray a
array Int
0 Int
size
a
element <- forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray SmallMutableArray s a
m Int
index
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
index forall a b. (a -> b) -> a -> b
$! a -> a
fn a
element
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
m
{-# INLINE cons #-}
cons :: a -> SmallArray a -> SmallArray a
cons :: forall a. a -> SmallArray a -> SmallArray a
cons a
a SmallArray a
array =
{-# SCC "cons" #-}
let size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
newSize :: Int
newSize = forall a. Enum a => a -> a
succ Int
size
in forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray forall a b. (a -> b) -> a -> b
$ do
SmallMutableArray s a
newMa <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
newSize a
a
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
newMa Int
1 SmallArray a
array Int
0 Int
size
forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s a
newMa
{-# INLINE orderedPair #-}
orderedPair :: Int -> e -> Int -> e -> SmallArray e
orderedPair :: forall e. Int -> e -> Int -> e -> SmallArray e
orderedPair Int
i1 e
e1 Int
i2 e
e2 =
{-# SCC "orderedPair" #-}
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray
forall a b. (a -> b) -> a -> b
$ if
| Int
i1 forall a. Ord a => a -> a -> Bool
< Int
i2 -> do
SmallMutableArray s e
a <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
2 e
e1
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s e
a Int
1 e
e2
forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s e
a
| Int
i1 forall a. Ord a => a -> a -> Bool
> Int
i2 -> do
SmallMutableArray s e
a <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
2 e
e1
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s e
a Int
0 e
e2
forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s e
a
| Bool
otherwise -> do
SmallMutableArray s e
a <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
1 e
e2
forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s e
a
{-# INLINE findAndReplace #-}
findAndReplace :: (a -> Maybe a) -> SmallArray a -> SmallArray a
findAndReplace :: forall a. (a -> Maybe a) -> SmallArray a -> SmallArray a
findAndReplace a -> Maybe a
f SmallArray a
array =
let size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
iterate :: Int -> SmallArray a
iterate Int
index =
if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
then case a -> Maybe a
f (forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
array Int
index) of
Just a
newElement -> forall a. Int -> a -> SmallArray a -> SmallArray a
set Int
index a
newElement SmallArray a
array
Maybe a
Nothing -> Int -> SmallArray a
iterate (forall a. Enum a => a -> a
succ Int
index)
else SmallArray a
array
in Int -> SmallArray a
iterate Int
0
{-# INLINE findAndMap #-}
findAndMap :: (a -> Maybe b) -> SmallArray a -> Maybe b
findAndMap :: forall a b. (a -> Maybe b) -> SmallArray a -> Maybe b
findAndMap a -> Maybe b
f SmallArray a
array =
let size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
iterate :: Int -> Maybe b
iterate Int
index =
if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
then case a -> Maybe b
f (forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
array Int
index) of
Just b
b -> forall a. a -> Maybe a
Just b
b
Maybe b
Nothing -> Int -> Maybe b
iterate (forall a. Enum a => a -> a
succ Int
index)
else forall a. Maybe a
Nothing
in Int -> Maybe b
iterate Int
0
{-# INLINE find #-}
find :: (a -> Bool) -> SmallArray a -> Maybe a
find :: forall a. (a -> Bool) -> SmallArray a -> Maybe a
find a -> Bool
test SmallArray a
array =
{-# SCC "find" #-}
let !size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
iterate :: Int -> Maybe a
iterate !Int
index =
if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
then
let !element :: a
element = forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
array Int
index
in if a -> Bool
test a
element
then forall a. a -> Maybe a
Just a
element
else Int -> Maybe a
iterate (forall a. Enum a => a -> a
succ Int
index)
else forall a. Maybe a
Nothing
in Int -> Maybe a
iterate Int
0
{-# INLINE findWithIndex #-}
findWithIndex :: (a -> Bool) -> SmallArray a -> Maybe (Int, a)
findWithIndex :: forall a. (a -> Bool) -> SmallArray a -> Maybe (Int, a)
findWithIndex a -> Bool
test SmallArray a
array =
{-# SCC "findWithIndex" #-}
let !size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array
iterate :: Int -> Maybe (Int, a)
iterate !Int
index =
if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
then
let !element :: a
element = forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
array Int
index
in if a -> Bool
test a
element
then forall a. a -> Maybe a
Just (Int
index, a
element)
else Int -> Maybe (Int, a)
iterate (forall a. Enum a => a -> a
succ Int
index)
else forall a. Maybe a
Nothing
in Int -> Maybe (Int, a)
iterate Int
0
{-# INLINE elementsUnfoldlM #-}
elementsUnfoldlM :: (Monad m) => SmallArray e -> UnfoldlM m e
elementsUnfoldlM :: forall (m :: * -> *) e. Monad m => SmallArray e -> UnfoldlM m e
elementsUnfoldlM SmallArray e
array = forall (m :: * -> *) a.
(forall x. (x -> a -> m x) -> x -> m x) -> UnfoldlM m a
UnfoldlM forall a b. (a -> b) -> a -> b
$ \x -> e -> m x
step x
initialState ->
let !size :: Int
size = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray e
array
iterate :: Int -> x -> m x
iterate Int
index !x
state =
if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
then do
e
element <- forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray e
array Int
index
x
newState <- x -> e -> m x
step x
state e
element
Int -> x -> m x
iterate (forall a. Enum a => a -> a
succ Int
index) x
newState
else forall (m :: * -> *) a. Monad m => a -> m a
return x
state
in Int -> x -> m x
iterate Int
0 x
initialState
{-# INLINE elementsListT #-}
elementsListT :: (Monad m) => SmallArray a -> ListT m a
elementsListT :: forall (m :: * -> *) a. Monad m => SmallArray a -> ListT m a
elementsListT = forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> ListT m a
ListT.fromFoldable
{-# INLINE onFoundElementFocus #-}
onFoundElementFocus :: (Monad m) => (a -> Bool) -> (a -> Bool) -> Focus a m b -> Focus (SmallArray a) m b
onFoundElementFocus :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool)
-> (a -> Bool) -> Focus a m b -> Focus (SmallArray a) m b
onFoundElementFocus a -> Bool
testAsKey a -> Bool
testWholeEntry (Focus m (b, Change a)
concealA a -> m (b, Change a)
revealA) = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m (b, Change (SmallArray a))
concealArray SmallArray a -> m (b, Change (SmallArray a))
revealArray
where
concealArray :: m (b, Change (SmallArray a))
concealArray = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {f :: * -> *} {a}. Applicative f => Change a -> Change (f a)
arrayChange) m (b, Change a)
concealA
where
arrayChange :: Change a -> Change (f a)
arrayChange = \case
Focus.Set a
newEntry -> forall a. a -> Change a
Focus.Set (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
newEntry)
Change a
_ -> forall a. Change a
Focus.Leave
revealArray :: SmallArray a -> m (b, Change (SmallArray a))
revealArray SmallArray a
array = case forall a. (a -> Bool) -> SmallArray a -> Maybe (Int, a)
findWithIndex a -> Bool
testAsKey SmallArray a
array of
Just (Int
index, a
entry) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Change a -> Change (SmallArray a)
arrayChange) (a -> m (b, Change a)
revealA a
entry)
where
arrayChange :: Change a -> Change (SmallArray a)
arrayChange = \case
Change a
Focus.Leave -> forall a. Change a
Focus.Leave
Focus.Set a
newEntry ->
if a -> Bool
testWholeEntry a
newEntry
then forall a. Change a
Focus.Leave
else forall a. a -> Change a
Focus.Set (forall a. Int -> a -> SmallArray a -> SmallArray a
set Int
index a
newEntry SmallArray a
array)
Change a
Focus.Remove ->
if forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
array forall a. Ord a => a -> a -> Bool
> Int
1
then forall a. a -> Change a
Focus.Set (forall a. Int -> SmallArray a -> SmallArray a
unset Int
index SmallArray a
array)
else forall a. Change a
Focus.Remove
Maybe (Int, a)
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Change a -> Change (SmallArray a)
arrayChange) m (b, Change a)
concealA
where
arrayChange :: Change a -> Change (SmallArray a)
arrayChange = \case
Focus.Set a
newEntry -> forall a. a -> Change a
Focus.Set (forall a. a -> SmallArray a -> SmallArray a
cons a
newEntry SmallArray a
array)
Change a
_ -> forall a. Change a
Focus.Leave
{-# INLINE focusOnFoundElement #-}
focusOnFoundElement :: (Monad m) => Focus a m b -> (a -> Bool) -> (a -> Bool) -> SmallArray a -> m (b, SmallArray a)
focusOnFoundElement :: forall (m :: * -> *) a b.
Monad m =>
Focus a m b
-> (a -> Bool)
-> (a -> Bool)
-> SmallArray a
-> m (b, SmallArray a)
focusOnFoundElement Focus a m b
focus a -> Bool
testAsKey a -> Bool
testWholeEntry = case forall (m :: * -> *) a b.
Monad m =>
(a -> Bool)
-> (a -> Bool) -> Focus a m b -> Focus (SmallArray a) m b
onFoundElementFocus a -> Bool
testAsKey a -> Bool
testWholeEntry Focus a m b
focus of
Focus m (b, Change (SmallArray a))
conceal SmallArray a -> m (b, Change (SmallArray a))
reveal -> \SmallArray a
sa -> do
(b
b, Change (SmallArray a)
change) <- SmallArray a -> m (b, Change (SmallArray a))
reveal SmallArray a
sa
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (b
b,) forall a b. (a -> b) -> a -> b
$ case Change (SmallArray a)
change of
Change (SmallArray a)
Focus.Leave -> SmallArray a
sa
Focus.Set SmallArray a
newSa -> SmallArray a
newSa
Change (SmallArray a)
Focus.Remove -> forall (f :: * -> *) a. Alternative f => f a
empty
toList :: forall a. SmallArray a -> [a]
toList :: forall a. SmallArray a -> [a]
toList SmallArray a
array = forall (t :: * -> *) a. Foldable t => t a -> [a]
PrimitiveExtras.Prelude.toList (forall (m :: * -> *) e. Monad m => SmallArray e -> UnfoldlM m e
elementsUnfoldlM SmallArray a
array :: UnfoldlM Identity a)