{-# LANGUAGE Unsafe #-}
{-# LANGUAGE DataKinds, MagicHash, RoleAnnotations, TupleSections, UnboxedTuples #-}
{-# 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 Control.Applicative (liftA, liftA2)
import Control.Monad (liftM2)

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 #))

instance Functor RT where
  fmap :: (a -> b) -> RT a -> RT b
  fmap :: forall a b. (a -> b) -> RT a -> RT b
fmap = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA -- TODO:

  {-# INLINE fmap #-}

-- TODO: (*>), (<*), (<*>)?
instance Applicative RT where
  pure :: a -> RT a
  pure :: forall a. a -> RT a
pure a
x = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT (# , a
x #)

  liftA2 :: (a -> b -> c) -> RT a -> RT b -> RT c
  liftA2 :: forall a b c. (a -> b -> c) -> RT a -> RT b -> RT c
liftA2 = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 -- TODO:

  {-# INLINE pure #-}
  {-# INLINE liftA2 #-}

-- TODO: (>>)
instance Monad RT where
  return :: a -> RT a
  return :: forall a. a -> RT a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

  (>>=) :: RT a -> (a -> RT b) -> RT b
  RT State# RealWorld -> (# State# RealWorld, a #)
m >>= :: forall a b. RT a -> (a -> RT b) -> RT b
>>= a -> RT b
k = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
    case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
s# of
      (# State# RealWorld
s'#, a
x #) -> let RT State# RealWorld -> (# State# RealWorld, b #)
n = a -> RT b
k a
x in State# RealWorld -> (# State# RealWorld, b #)
n State# RealWorld
s'#

  {-# INLINE return #-}
  {-# INLINE (>>=) #-}

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

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 = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
  case 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' = forall r. Reg r a -> RT b
k (forall r a. MutVar# RealWorld a -> Reg r a
Reg MutVar# RealWorld a
reg#) in State# RealWorld -> (# State# RealWorld, b #)
k' State# RealWorld
s'#

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

writeReg :: Reg r a -> a -> RT ()
writeReg :: forall r a. Reg r a -> a -> RT ()
writeReg (Reg MutVar# RealWorld a
reg#) a
x = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
  case 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'#, () #)

-- ioToRT?
-- rtToIO?
-- fromIORef?