{-# LANGUAGE Unsafe #-}
{-# LANGUAGE DataKinds, MagicHash, RoleAnnotations, UnboxedTuples, DerivingVia #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.Gigaparsec.Internal.RT (module Text.Gigaparsec.Internal.RT) where

import GHC.Base (MutVar#, RealWorld, State#, runRW#, newMutVar#, readMutVar#, writeMutVar#)

import Data.Coerce (coerce)
import GHC.IO (IO(IO))
import GHC.IORef (IORef(IORef))
import GHC.STRef (STRef(STRef))

type Reg :: * -> * -> *
type role Reg phantom representational
-- Don't even expose the constructor, then it's pretty much safe
data Reg r a = Reg (MutVar# RealWorld a)

type RT :: * -> *
newtype RT a = RT (State# RealWorld -> (# State# RealWorld, a #))
  deriving ((forall a b. (a -> b) -> RT a -> RT b)
-> (forall a b. a -> RT b -> RT a) -> Functor RT
forall a b. a -> RT b -> RT a
forall a b. (a -> b) -> RT a -> RT b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RT a -> RT b
fmap :: forall a b. (a -> b) -> RT a -> RT b
$c<$ :: forall a b. a -> RT b -> RT a
<$ :: forall a b. a -> RT b -> RT a
Functor, Functor RT
Functor RT =>
(forall a. a -> RT a)
-> (forall a b. RT (a -> b) -> RT a -> RT b)
-> (forall a b c. (a -> b -> c) -> RT a -> RT b -> RT c)
-> (forall a b. RT a -> RT b -> RT b)
-> (forall a b. RT a -> RT b -> RT a)
-> Applicative RT
forall a. a -> RT a
forall a b. RT a -> RT b -> RT a
forall a b. RT a -> RT b -> RT b
forall a b. RT (a -> b) -> RT a -> RT b
forall a b c. (a -> b -> c) -> RT a -> RT b -> RT c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> RT a
pure :: forall a. a -> RT a
$c<*> :: forall a b. RT (a -> b) -> RT a -> RT b
<*> :: forall a b. RT (a -> b) -> RT a -> RT b
$cliftA2 :: forall a b c. (a -> b -> c) -> RT a -> RT b -> RT c
liftA2 :: forall a b c. (a -> b -> c) -> RT a -> RT b -> RT c
$c*> :: forall a b. RT a -> RT b -> RT b
*> :: forall a b. RT a -> RT b -> RT b
$c<* :: forall a b. RT a -> RT b -> RT a
<* :: forall a b. RT a -> RT b -> RT a
Applicative, Applicative RT
Applicative RT =>
(forall a b. RT a -> (a -> RT b) -> RT b)
-> (forall a b. RT a -> RT b -> RT b)
-> (forall a. a -> RT a)
-> Monad RT
forall a. a -> RT a
forall a b. RT a -> RT b -> RT b
forall a b. RT a -> (a -> RT b) -> RT b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. RT a -> (a -> RT b) -> RT b
>>= :: forall a b. RT a -> (a -> RT b) -> RT b
$c>> :: forall a b. RT a -> RT b -> RT b
>> :: forall a b. RT a -> RT b -> RT b
$creturn :: forall a. a -> RT a
return :: forall a. a -> RT a
Monad) via IO

{-# INLINE runRT #-}
runRT :: RT a -> a
runRT :: forall a. RT a -> a
runRT (RT State# RealWorld -> (# State# RealWorld, a #)
mx) = case (State# RealWorld -> (# State# RealWorld, a #))
-> (# State# RealWorld, a #)
forall o. (State# RealWorld -> o) -> o
runRW# State# RealWorld -> (# State# RealWorld, a #)
mx of (# State# RealWorld
_, a
x #) -> a
x

{-# INLINABLE newReg #-}
newReg :: a -> (forall r. Reg r a -> RT b) -> RT b
newReg :: forall a b. a -> (forall r. Reg r a -> RT b) -> RT b
newReg a
x forall r. Reg r a -> RT b
k = (State# RealWorld -> (# State# RealWorld, b #)) -> RT b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT ((State# RealWorld -> (# State# RealWorld, b #)) -> RT b)
-> (State# RealWorld -> (# State# RealWorld, b #)) -> RT b
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
  case a
-> State# RealWorld -> (# State# RealWorld, MutVar# RealWorld a #)
forall a d. a -> State# d -> (# State# d, MutVar# d a #)
newMutVar# a
x State# RealWorld
s# of
    (# State# RealWorld
s'#, MutVar# RealWorld a
reg# #) -> let RT State# RealWorld -> (# State# RealWorld, b #)
k' = Reg Any a -> RT b
forall r. Reg r a -> RT b
k (MutVar# RealWorld a -> Reg Any a
forall r a. MutVar# RealWorld a -> Reg r a
Reg MutVar# RealWorld a
reg#) in State# RealWorld -> (# State# RealWorld, b #)
k' State# RealWorld
s'#

{-# INLINE readReg #-}
readReg :: Reg r a -> RT a
readReg :: forall r a. Reg r a -> RT a
readReg (Reg MutVar# RealWorld a
reg#) = (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT ((State# RealWorld -> (# State# RealWorld, a #)) -> RT a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> MutVar# RealWorld a
-> State# RealWorld -> (# State# RealWorld, a #)
forall d a. MutVar# d a -> State# d -> (# State# d, a #)
readMutVar# MutVar# RealWorld a
reg# State# RealWorld
s#

{-# INLINABLE writeReg #-}
writeReg :: Reg r a -> a -> RT ()
writeReg :: forall r a. Reg r a -> a -> RT ()
writeReg (Reg MutVar# RealWorld a
reg#) a
x = (State# RealWorld -> (# State# RealWorld, () #)) -> RT ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT ((State# RealWorld -> (# State# RealWorld, () #)) -> RT ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> RT ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
  case MutVar# RealWorld a -> a -> State# RealWorld -> State# RealWorld
forall d a. MutVar# d a -> a -> State# d -> State# d
writeMutVar# MutVar# RealWorld a
reg# a
x State# RealWorld
s# of
    State# RealWorld
s'# -> (# State# RealWorld
s'#, () #)

{-# INLINE unsafeIOToRT #-}
unsafeIOToRT :: IO a -> RT a
unsafeIOToRT :: forall a. IO a -> RT a
unsafeIOToRT = IO a -> RT a
forall a b. Coercible a b => a -> b
coerce

{-# INLINE rtToIO #-}
rtToIO :: RT a -> IO a
rtToIO :: forall a. RT a -> IO a
rtToIO = RT a -> IO a
forall a b. Coercible a b => a -> b
coerce

{-# INLINE fromIORef #-}
fromIORef :: IORef a -> Reg r a
fromIORef :: forall a r. IORef a -> Reg r a
fromIORef (IORef (STRef MutVar# RealWorld a
reg#)) = MutVar# RealWorld a -> Reg r a
forall r a. MutVar# RealWorld a -> Reg r a
Reg MutVar# RealWorld a
reg#