{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-name-shadowing #-}
module GHC.Compact (
  
  Compact(..),
  
  compact,
  compactWithSharing,
  compactAdd,
  compactAddWithSharing,
  
  getCompact,
  inCompact,
  isCompact,
  compactSize,
  
  compactResize,
  
  mkCompact,
  compactSized,
  ) where
import Control.Concurrent.MVar
import GHC.Prim
import GHC.Types
data Compact a = Compact Compact# a !(MVar ())
    
    
    
    
mkCompact
  :: Compact# -> a -> State# RealWorld -> (# State# RealWorld, Compact a #)
mkCompact :: forall a.
Compact#
-> a -> State# RealWorld -> (# State# RealWorld, Compact a #)
mkCompact Compact#
compact# a
a State# RealWorld
s =
  case IO (MVar ()) -> State# RealWorld -> (# State# RealWorld, MVar () #)
forall {a}. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (() -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()) State# RealWorld
s of { (# State# RealWorld
s1, MVar ()
lock #) ->
  (# State# RealWorld
s1, Compact# -> a -> MVar () -> Compact a
forall a. Compact# -> a -> MVar () -> Compact a
Compact Compact#
compact# a
a MVar ()
lock #) }
 where
  unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IO State# RealWorld -> (# State# RealWorld, a #)
a) = State# RealWorld -> (# State# RealWorld, a #)
a
compactSized
    :: Int 
    -> Bool 
    -> a
    -> IO (Compact a)
compactSized :: forall a. Int -> Bool -> a -> IO (Compact a)
compactSized (I# Int#
size) Bool
share a
a = (State# RealWorld -> (# State# RealWorld, Compact a #))
-> IO (Compact a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Compact a #))
 -> IO (Compact a))
-> (State# RealWorld -> (# State# RealWorld, Compact a #))
-> IO (Compact a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
  case Word# -> State# RealWorld -> (# State# RealWorld, Compact# #)
compactNew# (Int# -> Word#
int2Word# Int#
size) State# RealWorld
s0 of { (# State# RealWorld
s1, Compact#
compact# #) ->
  case Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall {a}.
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
compactAddPrim Compact#
compact# a
a State# RealWorld
s1 of { (# State# RealWorld
s2, a
pk #) ->
  Compact#
-> a -> State# RealWorld -> (# State# RealWorld, Compact a #)
forall a.
Compact#
-> a -> State# RealWorld -> (# State# RealWorld, Compact a #)
mkCompact Compact#
compact# a
pk State# RealWorld
s2 }}
 where
  compactAddPrim :: Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
compactAddPrim
    | Bool
share = Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall {a}.
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
compactAddWithSharing#
    | Bool
otherwise = Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall {a}.
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
compactAdd#
getCompact :: Compact a -> a
getCompact :: forall a. Compact a -> a
getCompact (Compact Compact#
_ a
obj MVar ()
_) = a
obj
compact :: a -> IO (Compact a)
compact :: forall a. a -> IO (Compact a)
compact = Int -> Bool -> a -> IO (Compact a)
forall a. Int -> Bool -> a -> IO (Compact a)
compactSized Int
31268 Bool
False
compactWithSharing :: a -> IO (Compact a)
compactWithSharing :: forall a. a -> IO (Compact a)
compactWithSharing = Int -> Bool -> a -> IO (Compact a)
forall a. Int -> Bool -> a -> IO (Compact a)
compactSized Int
31268 Bool
True
compactAdd :: Compact b -> a -> IO (Compact a)
compactAdd :: forall b a. Compact b -> a -> IO (Compact a)
compactAdd (Compact Compact#
compact# b
_ MVar ()
lock) a
a = MVar () -> (() -> IO (Compact a)) -> IO (Compact a)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
lock ((() -> IO (Compact a)) -> IO (Compact a))
-> (() -> IO (Compact a)) -> IO (Compact a)
forall a b. (a -> b) -> a -> b
$ \()
_ -> (State# RealWorld -> (# State# RealWorld, Compact a #))
-> IO (Compact a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Compact a #))
 -> IO (Compact a))
-> (State# RealWorld -> (# State# RealWorld, Compact a #))
-> IO (Compact a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall {a}.
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
compactAdd# Compact#
compact# a
a State# RealWorld
s of { (# State# RealWorld
s1, a
pk #) ->
  (# State# RealWorld
s1, Compact# -> a -> MVar () -> Compact a
forall a. Compact# -> a -> MVar () -> Compact a
Compact Compact#
compact# a
pk MVar ()
lock #) }
compactAddWithSharing :: Compact b -> a -> IO (Compact a)
compactAddWithSharing :: forall b a. Compact b -> a -> IO (Compact a)
compactAddWithSharing (Compact Compact#
compact# b
_ MVar ()
lock) a
a =
  MVar () -> (() -> IO (Compact a)) -> IO (Compact a)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
lock ((() -> IO (Compact a)) -> IO (Compact a))
-> (() -> IO (Compact a)) -> IO (Compact a)
forall a b. (a -> b) -> a -> b
$ \()
_ -> (State# RealWorld -> (# State# RealWorld, Compact a #))
-> IO (Compact a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Compact a #))
 -> IO (Compact a))
-> (State# RealWorld -> (# State# RealWorld, Compact a #))
-> IO (Compact a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall {a}.
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
compactAddWithSharing# Compact#
compact# a
a State# RealWorld
s of { (# State# RealWorld
s1, a
pk #) ->
    (# State# RealWorld
s1, Compact# -> a -> MVar () -> Compact a
forall a. Compact# -> a -> MVar () -> Compact a
Compact Compact#
compact# a
pk MVar ()
lock #) }
inCompact :: Compact b -> a -> IO Bool
inCompact :: forall b a. Compact b -> a -> IO Bool
inCompact (Compact Compact#
buffer b
_ MVar ()
_) !a
val =
  (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case Compact# -> a -> State# RealWorld -> (# State# RealWorld, Int# #)
forall a.
Compact# -> a -> State# RealWorld -> (# State# RealWorld, Int# #)
compactContains# Compact#
buffer a
val State# RealWorld
s of
         (# State# RealWorld
s', Int#
v #) -> (# State# RealWorld
s', Int# -> Bool
isTrue# Int#
v #) )
isCompact :: a -> IO Bool
isCompact :: forall a. a -> IO Bool
isCompact !a
val =
  (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case a -> State# RealWorld -> (# State# RealWorld, Int# #)
forall a. a -> State# RealWorld -> (# State# RealWorld, Int# #)
compactContainsAny# a
val State# RealWorld
s of
         (# State# RealWorld
s', Int#
v #) -> (# State# RealWorld
s', Int# -> Bool
isTrue# Int#
v #) )
compactSize :: Compact a -> IO Word
compactSize :: forall a. Compact a -> IO Word
compactSize (Compact Compact#
buffer a
_ MVar ()
lock) = MVar () -> (() -> IO Word) -> IO Word
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
lock ((() -> IO Word) -> IO Word) -> (() -> IO Word) -> IO Word
forall a b. (a -> b) -> a -> b
$ \()
_ -> (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word)
-> (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
   case Compact# -> State# RealWorld -> (# State# RealWorld, Word# #)
compactSize# Compact#
buffer State# RealWorld
s0 of (# State# RealWorld
s1, Word#
sz #) -> (# State# RealWorld
s1, Word# -> Word
W# Word#
sz #)
compactResize :: Compact a -> Word -> IO ()
compactResize :: forall a. Compact a -> Word -> IO ()
compactResize (Compact Compact#
oldBuffer a
_ MVar ()
lock) (W# Word#
new_size) =
  MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
lock ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \()
_ -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case Compact# -> Word# -> State# RealWorld -> State# RealWorld
compactResize# Compact#
oldBuffer Word#
new_size State# RealWorld
s of
      State# RealWorld
s' -> (# State# RealWorld
s', () #)