{-# LANGUAGE Unsafe #-}
{-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module GHC.Event.Internal
    (
    
      Backend
    , backend
    , delete
    , poll
    , modifyFd
    , modifyFdOnce
    , module GHC.Event.Internal.Types
    
    , throwErrnoIfMinus1NoRetry
    
    , exchangePtr
    ) where
import Foreign.C.Error (eINTR, getErrno, throwErrno)
import System.Posix.Types (Fd)
import GHC.Base
import GHC.Num (Num(..))
import GHC.Event.Internal.Types
import GHC.Ptr (Ptr(..))
data Backend = forall a. Backend {
      ()
_beState :: !a
    
    
    , ()
_bePoll :: a                          
              -> Maybe Timeout              
              -> (Fd -> Event -> IO ())     
              -> IO Int
    
    
    , ()
_beModifyFd :: a
                  -> Fd       
                  -> Event    
                  -> Event    
                  -> IO Bool
    
    
    , ()
_beModifyFdOnce :: a
                         -> Fd    
                         -> Event 
                         -> IO Bool
    , ()
_beDelete :: a -> IO ()
    }
backend :: (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
        -> (a -> Fd -> Event -> Event -> IO Bool)
        -> (a -> Fd -> Event -> IO Bool)
        -> (a -> IO ())
        -> a
        -> Backend
backend :: forall a.
(a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> a
-> Backend
backend a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll a -> Fd -> Event -> Event -> IO Bool
bModifyFd a -> Fd -> Event -> IO Bool
bModifyFdOnce a -> IO ()
bDelete a
state =
  a
-> (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> Backend
forall a.
a
-> (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> Backend
Backend a
state a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll a -> Fd -> Event -> Event -> IO Bool
bModifyFd a -> Fd -> Event -> IO Bool
bModifyFdOnce a -> IO ()
bDelete
{-# INLINE backend #-}
poll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
poll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
poll (Backend a
bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll a -> Fd -> Event -> Event -> IO Bool
_ a -> Fd -> Event -> IO Bool
_ a -> IO ()
_) = a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll a
bState
{-# INLINE poll #-}
modifyFd :: Backend -> Fd -> Event -> Event -> IO Bool
modifyFd :: Backend -> Fd -> Event -> Event -> IO Bool
modifyFd (Backend a
bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
_ a -> Fd -> Event -> Event -> IO Bool
bModifyFd a -> Fd -> Event -> IO Bool
_ a -> IO ()
_) = a -> Fd -> Event -> Event -> IO Bool
bModifyFd a
bState
{-# INLINE modifyFd #-}
modifyFdOnce :: Backend -> Fd -> Event -> IO Bool
modifyFdOnce :: Backend -> Fd -> Event -> IO Bool
modifyFdOnce (Backend a
bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
_ a -> Fd -> Event -> Event -> IO Bool
_ a -> Fd -> Event -> IO Bool
bModifyFdOnce a -> IO ()
_) = a -> Fd -> Event -> IO Bool
bModifyFdOnce a
bState
{-# INLINE modifyFdOnce #-}
delete :: Backend -> IO ()
delete :: Backend -> IO ()
delete (Backend a
bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
_ a -> Fd -> Event -> Event -> IO Bool
_ a -> Fd -> Event -> IO Bool
_ a -> IO ()
bDelete) = a -> IO ()
bDelete a
bState
{-# INLINE delete #-}
throwErrnoIfMinus1NoRetry :: (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1NoRetry :: forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1NoRetry String
loc IO a
f = do
    a
res <- IO a
f
    if a
res a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1
        then do
            Errno
err <- IO Errno
getErrno
            if Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR then a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
0 else String -> IO a
forall a. String -> IO a
throwErrno String
loc
        else a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
{-# INLINE exchangePtr #-}
exchangePtr :: Ptr (Ptr a) -> Ptr a -> IO (Ptr a)
exchangePtr :: forall a. Ptr (Ptr a) -> Ptr a -> IO (Ptr a)
exchangePtr (Ptr Addr#
dst) (Ptr Addr#
val) =
  (State# RealWorld -> (# State# RealWorld, Ptr a #)) -> IO (Ptr a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Ptr a #)) -> IO (Ptr a))
-> (State# RealWorld -> (# State# RealWorld, Ptr a #))
-> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
      case (Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #)
forall d. Addr# -> Addr# -> State# d -> (# State# d, Addr# #)
atomicExchangeAddrAddr# Addr#
dst Addr#
val State# RealWorld
s) of
        (# State# RealWorld
s2, Addr#
old_val #) -> (# State# RealWorld
s2, Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
old_val #)