{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE BangPatterns #-}
module Data.Primitive.SmallArray
( SmallArray(..)
, SmallMutableArray(..)
, newSmallArray
, readSmallArray
, writeSmallArray
, copySmallArray
, copySmallMutableArray
, indexSmallArray
, indexSmallArrayM
, indexSmallArray##
, cloneSmallArray
, cloneSmallMutableArray
, freezeSmallArray
, unsafeFreezeSmallArray
, thawSmallArray
, unsafeThawSmallArray
, runSmallArray
, createSmallArray
, sizeofSmallArray
, sizeofSmallMutableArray
#if MIN_VERSION_base(4,14,0)
, shrinkSmallMutableArray
#endif
, emptySmallArray
, smallArrayFromList
, smallArrayFromListN
, mapSmallArray'
, traverseSmallArrayP
) where
import GHC.Exts hiding (toList)
import qualified GHC.Exts
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.Primitive
import Control.Monad.ST
import Control.Monad.Zip
import Data.Data
import Data.Foldable as Foldable
import Data.Functor.Identity
#if !(MIN_VERSION_base(4,10,0))
import Data.Monoid
#endif
#if MIN_VERSION_base(4,9,0)
import qualified GHC.ST as GHCST
import qualified Data.Semigroup as Sem
#endif
import Text.ParserCombinators.ReadP
#if MIN_VERSION_base(4,10,0)
import GHC.Exts (runRW#)
#elif MIN_VERSION_base(4,9,0)
import GHC.Base (runRW#)
#endif
import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), Read1(..))
data SmallArray a = SmallArray (SmallArray# a)
deriving Typeable
#if MIN_VERSION_deepseq(1,4,3)
instance NFData1 SmallArray where
liftRnf r = foldl' (\_ -> r) ()
#endif
instance NFData a => NFData (SmallArray a) where
rnf = foldl' (\_ -> rnf) ()
data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)
deriving Typeable
newSmallArray
:: PrimMonad m
=> Int
-> a
-> m (SmallMutableArray (PrimState m) a)
newSmallArray (I# i#) x = primitive $ \s ->
case newSmallArray# i# x s of
(# s', sma# #) -> (# s', SmallMutableArray sma# #)
{-# INLINE newSmallArray #-}
readSmallArray
:: PrimMonad m
=> SmallMutableArray (PrimState m) a
-> Int
-> m a
readSmallArray (SmallMutableArray sma#) (I# i#) =
primitive $ readSmallArray# sma# i#
{-# INLINE readSmallArray #-}
writeSmallArray
:: PrimMonad m
=> SmallMutableArray (PrimState m) a
-> Int
-> a
-> m ()
writeSmallArray (SmallMutableArray sma#) (I# i#) x =
primitive_ $ writeSmallArray# sma# i# x
{-# INLINE writeSmallArray #-}
indexSmallArrayM
:: Monad m
=> SmallArray a
-> Int
-> m a
indexSmallArrayM (SmallArray sa#) (I# i#) =
case indexSmallArray# sa# i# of
(# x #) -> pure x
{-# INLINE indexSmallArrayM #-}
indexSmallArray
:: SmallArray a
-> Int
-> a
indexSmallArray sa i = runIdentity $ indexSmallArrayM sa i
{-# INLINE indexSmallArray #-}
indexSmallArray## :: SmallArray a -> Int -> (# a #)
indexSmallArray## (SmallArray ary) (I# i) = indexSmallArray# ary i
{-# INLINE indexSmallArray## #-}
cloneSmallArray
:: SmallArray a
-> Int
-> Int
-> SmallArray a
cloneSmallArray (SmallArray sa#) (I# i#) (I# j#) =
SmallArray (cloneSmallArray# sa# i# j#)
{-# INLINE cloneSmallArray #-}
cloneSmallMutableArray
:: PrimMonad m
=> SmallMutableArray (PrimState m) a
-> Int
-> Int
-> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray (SmallMutableArray sma#) (I# o#) (I# l#) =
primitive $ \s -> case cloneSmallMutableArray# sma# o# l# s of
(# s', smb# #) -> (# s', SmallMutableArray smb# #)
{-# INLINE cloneSmallMutableArray #-}
freezeSmallArray
:: PrimMonad m
=> SmallMutableArray (PrimState m) a
-> Int
-> Int
-> m (SmallArray a)
freezeSmallArray (SmallMutableArray sma#) (I# i#) (I# j#) =
primitive $ \s -> case freezeSmallArray# sma# i# j# s of
(# s', sa# #) -> (# s', SmallArray sa# #)
{-# INLINE freezeSmallArray #-}
unsafeFreezeSmallArray
:: PrimMonad m => SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray (SmallMutableArray sma#) =
primitive $ \s -> case unsafeFreezeSmallArray# sma# s of
(# s', sa# #) -> (# s', SmallArray sa# #)
{-# INLINE unsafeFreezeSmallArray #-}
thawSmallArray
:: PrimMonad m
=> SmallArray a
-> Int
-> Int
-> m (SmallMutableArray (PrimState m) a)
thawSmallArray (SmallArray sa#) (I# o#) (I# l#) =
primitive $ \s -> case thawSmallArray# sa# o# l# s of
(# s', sma# #) -> (# s', SmallMutableArray sma# #)
{-# INLINE thawSmallArray #-}
unsafeThawSmallArray
:: PrimMonad m => SmallArray a -> m (SmallMutableArray (PrimState m) a)
unsafeThawSmallArray (SmallArray sa#) =
primitive $ \s -> case unsafeThawSmallArray# sa# s of
(# s', sma# #) -> (# s', SmallMutableArray sma# #)
{-# INLINE unsafeThawSmallArray #-}
copySmallArray
:: PrimMonad m
=> SmallMutableArray (PrimState m) a
-> Int
-> SmallArray a
-> Int
-> Int
-> m ()
copySmallArray
(SmallMutableArray dst#) (I# do#) (SmallArray src#) (I# so#) (I# l#) =
primitive_ $ copySmallArray# src# so# dst# do# l#
{-# INLINE copySmallArray #-}
copySmallMutableArray
:: PrimMonad m
=> SmallMutableArray (PrimState m) a
-> Int
-> SmallMutableArray (PrimState m) a
-> Int
-> Int
-> m ()
copySmallMutableArray
(SmallMutableArray dst#) (I# do#)
(SmallMutableArray src#) (I# so#)
(I# l#) =
primitive_ $ copySmallMutableArray# src# so# dst# do# l#
{-# INLINE copySmallMutableArray #-}
sizeofSmallArray :: SmallArray a -> Int
sizeofSmallArray (SmallArray sa#) = I# (sizeofSmallArray# sa#)
{-# INLINE sizeofSmallArray #-}
sizeofSmallMutableArray :: SmallMutableArray s a -> Int
sizeofSmallMutableArray (SmallMutableArray sa#) =
I# (sizeofSmallMutableArray# sa#)
{-# INLINE sizeofSmallMutableArray #-}
traverseSmallArrayP
:: PrimMonad m
=> (a -> m b)
-> SmallArray a
-> m (SmallArray b)
traverseSmallArrayP f = \ !ary ->
let
!sz = sizeofSmallArray ary
go !i !mary
| i == sz
= unsafeFreezeSmallArray mary
| otherwise
= do
a <- indexSmallArrayM ary i
b <- f a
writeSmallArray mary i b
go (i + 1) mary
in do
mary <- newSmallArray sz badTraverseValue
go 0 mary
{-# INLINE traverseSmallArrayP #-}
mapSmallArray' :: (a -> b) -> SmallArray a -> SmallArray b
mapSmallArray' f sa = createSmallArray (length sa) (die "mapSmallArray'" "impossible") $ \smb ->
fix ? 0 $ \go i ->
when (i < length sa) $ do
x <- indexSmallArrayM sa i
let !y = f x
writeSmallArray smb i y *> go (i + 1)
{-# INLINE mapSmallArray' #-}
runSmallArray
:: (forall s. ST s (SmallMutableArray s a))
-> SmallArray a
#if !MIN_VERSION_base(4,9,0)
runSmallArray m = runST $ m >>= unsafeFreezeSmallArray
#else
runSmallArray m = SmallArray (runSmallArray# m)
runSmallArray#
:: (forall s. ST s (SmallMutableArray s a))
-> SmallArray# a
runSmallArray# m = case runRW# $ \s ->
case unST m s of { (# s', SmallMutableArray mary# #) ->
unsafeFreezeSmallArray# mary# s'} of (# _, ary# #) -> ary#
unST :: ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST f) = f
#endif
createSmallArray
:: Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray 0 _ _ = SmallArray (emptySmallArray# (# #))
createSmallArray n x f = runSmallArray $ do
mary <- newSmallArray n x
f mary
pure mary
emptySmallArray# :: (# #) -> SmallArray# a
emptySmallArray# _ = case emptySmallArray of SmallArray ar -> ar
{-# NOINLINE emptySmallArray# #-}
die :: String -> String -> a
die fun problem = error $ "Data.Primitive.SmallArray." ++ fun ++ ": " ++ problem
emptySmallArray :: SmallArray a
emptySmallArray =
runST $ newSmallArray 0 (die "emptySmallArray" "impossible")
>>= unsafeFreezeSmallArray
{-# NOINLINE emptySmallArray #-}
infixl 1 ?
(?) :: (a -> b -> c) -> (b -> a -> c)
(?) = flip
{-# INLINE (?) #-}
noOp :: a -> ST s ()
noOp = const $ pure ()
smallArrayLiftEq :: (a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq p sa1 sa2 = length sa1 == length sa2 && loop (length sa1 - 1)
where
loop i
| i < 0
= True
| (# x #) <- indexSmallArray## sa1 i
, (# y #) <- indexSmallArray## sa2 i
= p x y && loop (i - 1)
instance Eq1 SmallArray where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftEq = smallArrayLiftEq
#else
eq1 = smallArrayLiftEq (==)
#endif
instance Eq a => Eq (SmallArray a) where
sa1 == sa2 = smallArrayLiftEq (==) sa1 sa2
instance Eq (SmallMutableArray s a) where
SmallMutableArray sma1# == SmallMutableArray sma2# =
isTrue# (sameSmallMutableArray# sma1# sma2#)
smallArrayLiftCompare :: (a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare elemCompare a1 a2 = loop 0
where
mn = length a1 `min` length a2
loop i
| i < mn
, (# x1 #) <- indexSmallArray## a1 i
, (# x2 #) <- indexSmallArray## a2 i
= elemCompare x1 x2 `mappend` loop (i + 1)
| otherwise = compare (length a1) (length a2)
instance Ord1 SmallArray where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftCompare = smallArrayLiftCompare
#else
compare1 = smallArrayLiftCompare compare
#endif
instance Ord a => Ord (SmallArray a) where
compare sa1 sa2 = smallArrayLiftCompare compare sa1 sa2
instance Foldable SmallArray where
foldr f = \z !ary ->
let
!sz = sizeofSmallArray ary
go i
| i == sz = z
| (# x #) <- indexSmallArray## ary i
= f x (go (i + 1))
in go 0
{-# INLINE foldr #-}
foldl f = \z !ary ->
let
go i
| i < 0 = z
| (# x #) <- indexSmallArray## ary i
= f (go (i - 1)) x
in go (sizeofSmallArray ary - 1)
{-# INLINE foldl #-}
foldr1 f = \ !ary ->
let
!sz = sizeofSmallArray ary - 1
go i =
case indexSmallArray## ary i of
(# x #) | i == sz -> x
| otherwise -> f x (go (i + 1))
in if sz < 0
then die "foldr1" "Empty SmallArray"
else go 0
{-# INLINE foldr1 #-}
foldl1 f = \ !ary ->
let
!sz = sizeofSmallArray ary - 1
go i =
case indexSmallArray## ary i of
(# x #) | i == 0 -> x
| otherwise -> f (go (i - 1)) x
in if sz < 0
then die "foldl1" "Empty SmallArray"
else go sz
{-# INLINE foldl1 #-}
foldr' f = \z !ary ->
let
go i !acc
| i == -1 = acc
| (# x #) <- indexSmallArray## ary i
= go (i - 1) (f x acc)
in go (sizeofSmallArray ary - 1) z
{-# INLINE foldr' #-}
foldl' f = \z !ary ->
let
!sz = sizeofSmallArray ary
go i !acc
| i == sz = acc
| (# x #) <- indexSmallArray## ary i
= go (i + 1) (f acc x)
in go 0 z
{-# INLINE foldl' #-}
null a = sizeofSmallArray a == 0
{-# INLINE null #-}
length = sizeofSmallArray
{-# INLINE length #-}
maximum ary | sz == 0 = die "maximum" "Empty SmallArray"
| (# frst #) <- indexSmallArray## ary 0
= go 1 frst
where
sz = sizeofSmallArray ary
go i !e
| i == sz = e
| (# x #) <- indexSmallArray## ary i
= go (i + 1) (max e x)
{-# INLINE maximum #-}
minimum ary | sz == 0 = die "minimum" "Empty SmallArray"
| (# frst #) <- indexSmallArray## ary 0
= go 1 frst
where sz = sizeofSmallArray ary
go i !e
| i == sz = e
| (# x #) <- indexSmallArray## ary i
= go (i + 1) (min e x)
{-# INLINE minimum #-}
sum = foldl' (+) 0
{-# INLINE sum #-}
product = foldl' (*) 1
{-# INLINE product #-}
newtype STA a = STA { _runSTA :: forall s. SmallMutableArray# s a -> ST s (SmallArray a) }
runSTA :: Int -> STA a -> SmallArray a
runSTA !sz = \ (STA m) -> runST $ newSmallArray_ sz >>=
\ (SmallMutableArray ar#) -> m ar#
{-# INLINE runSTA #-}
newSmallArray_ :: Int -> ST s (SmallMutableArray s a)
newSmallArray_ !n = newSmallArray n badTraverseValue
badTraverseValue :: a
badTraverseValue = die "traverse" "bad indexing"
{-# NOINLINE badTraverseValue #-}
instance Traversable SmallArray where
traverse f = traverseSmallArray f
{-# INLINE traverse #-}
traverseSmallArray
:: Applicative f
=> (a -> f b) -> SmallArray a -> f (SmallArray b)
traverseSmallArray f = \ !ary ->
let
!len = sizeofSmallArray ary
go !i
| i == len
= pure $ STA $ \mary -> unsafeFreezeSmallArray (SmallMutableArray mary)
| (# x #) <- indexSmallArray## ary i
= liftA2 (\b (STA m) -> STA $ \mary ->
writeSmallArray (SmallMutableArray mary) i b >> m mary)
(f x) (go (i + 1))
in if len == 0
then pure emptySmallArray
else runSTA len <$> go 0
{-# INLINE [1] traverseSmallArray #-}
{-# RULES
"traverse/ST" forall (f :: a -> ST s b). traverseSmallArray f = traverseSmallArrayP f
"traverse/IO" forall (f :: a -> IO b). traverseSmallArray f = traverseSmallArrayP f
"traverse/Id" forall (f :: a -> Identity b). traverseSmallArray f =
(coerce :: (SmallArray a -> SmallArray (Identity b))
-> SmallArray a -> Identity (SmallArray b)) (fmap f)
#-}
instance Functor SmallArray where
fmap f sa = createSmallArray (length sa) (die "fmap" "impossible") $ \smb ->
fix ? 0 $ \go i ->
when (i < length sa) $ do
x <- indexSmallArrayM sa i
writeSmallArray smb i (f x) *> go (i + 1)
{-# INLINE fmap #-}
x <$ sa = createSmallArray (length sa) x noOp
instance Applicative SmallArray where
pure x = createSmallArray 1 x noOp
sa *> sb = createSmallArray (la * lb) (die "*>" "impossible") $ \smb ->
fix ? 0 $ \go i ->
when (i < la) $
copySmallArray smb (i * lb) sb 0 lb *> go (i + 1)
where
la = length sa; lb = length sb
a <* b = createSmallArray (sza * szb) (die "<*" "impossible") $ \ma ->
let fill off i e = when (i < szb) $
writeSmallArray ma (off + i) e >> fill off (i + 1) e
go i = when (i < sza) $ do
x <- indexSmallArrayM a i
fill (i * szb) 0 x
go (i + 1)
in go 0
where sza = sizeofSmallArray a; szb = sizeofSmallArray b
ab <*> a = createSmallArray (szab * sza) (die "<*>" "impossible") $ \mb ->
let go1 i = when (i < szab) $
do
f <- indexSmallArrayM ab i
go2 (i * sza) f 0
go1 (i + 1)
go2 off f j = when (j < sza) $
do
x <- indexSmallArrayM a j
writeSmallArray mb (off + j) (f x)
go2 off f (j + 1)
in go1 0
where szab = sizeofSmallArray ab; sza = sizeofSmallArray a
instance Alternative SmallArray where
empty = emptySmallArray
sl <|> sr =
createSmallArray (length sl + length sr) (die "<|>" "impossible") $ \sma ->
copySmallArray sma 0 sl 0 (length sl)
*> copySmallArray sma (length sl) sr 0 (length sr)
many sa | null sa = pure []
| otherwise = die "many" "infinite arrays are not well defined"
some sa | null sa = emptySmallArray
| otherwise = die "some" "infinite arrays are not well defined"
data ArrayStack a
= PushArray !(SmallArray a) !(ArrayStack a)
| EmptyStack
instance Monad SmallArray where
return = pure
(>>) = (*>)
sa >>= f = collect 0 EmptyStack (la - 1)
where
la = length sa
collect sz stk i
| i < 0 = createSmallArray sz (die ">>=" "impossible") $ fill 0 stk
| (# x #) <- indexSmallArray## sa i
, let sb = f x
lsb = length sb
= if lsb == 0
then collect sz stk (i - 1)
else collect (sz + lsb) (PushArray sb stk) (i - 1)
fill _ EmptyStack _ = return ()
fill off (PushArray sb sbs) smb =
copySmallArray smb off sb 0 (length sb)
*> fill (off + length sb) sbs smb
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
instance Fail.MonadFail SmallArray where
fail _ = emptySmallArray
instance MonadPlus SmallArray where
mzero = empty
mplus = (<|>)
zipW :: String -> (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
zipW nm = \f sa sb -> let mn = length sa `min` length sb in
createSmallArray mn (die nm "impossible") $ \mc ->
fix ? 0 $ \go i -> when (i < mn) $ do
x <- indexSmallArrayM sa i
y <- indexSmallArrayM sb i
writeSmallArray mc i (f x y)
go (i + 1)
{-# INLINE zipW #-}
instance MonadZip SmallArray where
mzip = zipW "mzip" (,)
mzipWith = zipW "mzipWith"
{-# INLINE mzipWith #-}
munzip sab = runST $ do
let sz = length sab
sma <- newSmallArray sz $ die "munzip" "impossible"
smb <- newSmallArray sz $ die "munzip" "impossible"
fix ? 0 $ \go i ->
when (i < sz) $ case indexSmallArray sab i of
(x, y) -> do writeSmallArray sma i x
writeSmallArray smb i y
go (i + 1)
(,) <$> unsafeFreezeSmallArray sma
<*> unsafeFreezeSmallArray smb
instance MonadFix SmallArray where
mfix f = createSmallArray (sizeofSmallArray (f err))
(die "mfix" "impossible") $ fix ? 0 $
\r !i !mary -> when (i < sz) $ do
writeSmallArray mary i (fix (\xi -> f xi `indexSmallArray` i))
r (i + 1) mary
where
sz = sizeofSmallArray (f err)
err = error "mfix for Data.Primitive.SmallArray applied to strict function."
#if MIN_VERSION_base(4,9,0)
instance Sem.Semigroup (SmallArray a) where
(<>) = (<|>)
sconcat = mconcat . toList
#endif
instance Monoid (SmallArray a) where
mempty = empty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<|>)
#endif
mconcat l = createSmallArray n (die "mconcat" "impossible") $ \ma ->
let go !_ [ ] = return ()
go off (a:as) =
copySmallArray ma off a 0 (sizeofSmallArray a) >> go (off + sizeofSmallArray a) as
in go 0 l
where n = sum (fmap length l)
instance IsList (SmallArray a) where
type Item (SmallArray a) = a
fromListN = smallArrayFromListN
fromList = smallArrayFromList
toList = Foldable.toList
smallArrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS
smallArrayLiftShowsPrec elemShowsPrec elemListShowsPrec p sa = showParen (p > 10) $
showString "fromListN " . shows (length sa) . showString " "
. listLiftShowsPrec elemShowsPrec elemListShowsPrec 11 (toList sa)
listLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec _ sl _ = sl
instance Show a => Show (SmallArray a) where
showsPrec p sa = smallArrayLiftShowsPrec showsPrec showList p sa
instance Show1 SmallArray where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftShowsPrec = smallArrayLiftShowsPrec
#else
showsPrec1 = smallArrayLiftShowsPrec showsPrec showList
#endif
smallArrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
smallArrayLiftReadsPrec _ listReadsPrec p = readParen (p > 10) . readP_to_S $ do
() <$ string "fromListN"
skipSpaces
n <- readS_to_P reads
skipSpaces
l <- readS_to_P listReadsPrec
return $ smallArrayFromListN n l
instance Read a => Read (SmallArray a) where
readsPrec = smallArrayLiftReadsPrec readsPrec readList
instance Read1 SmallArray where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftReadsPrec = smallArrayLiftReadsPrec
#else
readsPrec1 = smallArrayLiftReadsPrec readsPrec readList
#endif
smallArrayDataType :: DataType
smallArrayDataType =
mkDataType "Data.Primitive.SmallArray.SmallArray" [fromListConstr]
fromListConstr :: Constr
fromListConstr = mkConstr smallArrayDataType "fromList" [] Prefix
instance Data a => Data (SmallArray a) where
toConstr _ = fromListConstr
dataTypeOf _ = smallArrayDataType
gunfold k z c = case constrIndex c of
1 -> k (z fromList)
_ -> die "gunfold" "SmallArray"
gfoldl f z m = z fromList `f` toList m
instance (Typeable s, Typeable a) => Data (SmallMutableArray s a) where
toConstr _ = die "toConstr" "SmallMutableArray"
gunfold _ _ = die "gunfold" "SmallMutableArray"
dataTypeOf _ = mkNoRepType "Data.Primitive.SmallArray.SmallMutableArray"
smallArrayFromListN :: Int -> [a] -> SmallArray a
smallArrayFromListN n l =
createSmallArray n
(die "smallArrayFromListN" "uninitialized element") $ \sma ->
let go !ix [] = if ix == n
then return ()
else die "smallArrayFromListN" "list length less than specified size"
go !ix (x : xs) = if ix < n
then do
writeSmallArray sma ix x
go (ix + 1) xs
else die "smallArrayFromListN" "list length greater than specified size"
in go 0 l
smallArrayFromList :: [a] -> SmallArray a
smallArrayFromList l = smallArrayFromListN (length l) l
#if MIN_VERSION_base(4,14,0)
shrinkSmallMutableArray :: PrimMonad m
=> SmallMutableArray (PrimState m) a
-> Int
-> m ()
{-# inline shrinkSmallMutableArray #-}
shrinkSmallMutableArray (SmallMutableArray x) (I# n) = primitive
(\s0 -> case GHC.Exts.shrinkSmallMutableArray# x n s0 of
s1 -> (# s1, () #)
)
#endif