{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.CompactList
( CompactList
, newCompactList
, consCompactList
, readCompactList
) where
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import GHC.IO (stToIO)
import GHC.Prim
(Compact#, compactAdd#, compactNew#, int2Word#, RealWorld, State#)
import GHC.ST (ST(ST))
import GHC.STRef (STRef, newSTRef, readSTRef, writeSTRef)
import GHC.Types (Int(I#), IO(IO))
data CompactList a = CompactList Compact# (STRef RealWorld [a]) (MVar ())
mkCompactList
:: Compact# -> [a] -> State# RealWorld -> (# State# RealWorld, CompactList a #)
mkCompactList compact# as s =
case unST (newSTRef as) s of { (# s0, ref #) ->
case unIO (newMVar ()) s0 of { (# s1, lock #) ->
(# s1, CompactList compact# ref lock #) } }
where
unST (ST a) = a
unIO (IO a) = a
compactSized :: Int -> [a] -> IO (CompactList a)
compactSized (I# size) a = IO $ \s0 ->
case compactNew# (int2Word# size) s0 of { (# s1, compact# #) ->
case compactAdd# compact# a s1 of { (# s2, pk #) ->
mkCompactList compact# pk s2 }}
newCompactList :: [a] -> IO (CompactList a)
newCompactList = compactSized 31268
readCompactList :: CompactList a -> IO [a]
readCompactList (CompactList _ ref _) = stToIO (readSTRef ref)
consCompactList :: CompactList a -> a -> IO ()
consCompactList (CompactList compact# ref lock) x =
withMVar lock $ \_ -> IO $ \s ->
case unST (readSTRef ref) s of { (# s1, xs #) ->
case compactAdd# compact# (x : xs) s1 of { (# s2, ys #) ->
unST (writeSTRef ref ys) s2 }}
where
unST (ST a) = a