{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnboxedTuples #-}
module EST (
EST,
liftST,
runEST,
earlyExitEST,
) where
import GHC.Exts (PromptTag#, State#, control0#, newPromptTag#, oneShot, prompt#, runRW#, unsafeCoerce#)
import GHC.ST (ST (..))
control0##
:: PromptTag# a
-> (((State# s -> (# State# s, b #)) -> State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #)
control0## :: forall a s b.
PromptTag# a
-> (((State# s -> (# State# s, b #))
-> State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> State# s
-> (# State# s, b #)
control0## = (PromptTag# (ZonkAny 0)
-> (((State# RealWorld -> (# State# RealWorld, ZonkAny 1 #))
-> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
-> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
-> State# RealWorld
-> (# State# RealWorld, ZonkAny 1 #))
-> PromptTag# a
-> (((State# s -> (# State# s, b #))
-> State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> State# s
-> (# State# s, b #)
forall a b. a -> b
unsafeCoerce# PromptTag# (ZonkAny 0)
-> (((State# RealWorld -> (# State# RealWorld, ZonkAny 1 #))
-> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
-> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
-> State# RealWorld
-> (# State# RealWorld, ZonkAny 1 #)
forall a b.
PromptTag# a
-> (((State# RealWorld -> (# State# RealWorld, b #))
-> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, b #)
control0#
newtype EST e s a = EST_ (forall r. (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
instance Functor (EST e s) where
fmap :: forall a b. (a -> b) -> EST e s a -> EST e s b
fmap a -> b
f (EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
g) = (forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, b #))
-> EST e s b
forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\(# PromptTag# (Either e r), State# s #)
st -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
g (# PromptTag# (Either e r), State# s #)
st of (# State# s
s, a
a #) -> (# State# s
s, a -> b
f a
a #))
instance Applicative (EST e s) where
pure :: forall a. a -> EST e s a
pure a
x = (forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\(# PromptTag# (Either e r)
_, State# s
s #) -> (# State# s
s, a
x #))
EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a -> b #)
f <*> :: forall a b. EST e s (a -> b) -> EST e s a -> EST e s b
<*> EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
x = (forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, b #))
-> EST e s b
forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST
(\(# PromptTag# (Either e r)
t, State# s
s0 #) -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a -> b #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a -> b #)
f (# PromptTag# (Either e r)
t, State# s
s0 #) of {
(# State# s
s1, a -> b
f' #) -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
x (# PromptTag# (Either e r)
t, State# s
s1 #) of {
(# State# s
s2, a
x' #) -> (# State# s
s2, a -> b
f' a
x' #) }})
instance Monad (EST e s) where
EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
m >>= :: forall a b. EST e s a -> (a -> EST e s b) -> EST e s b
>>= a -> EST e s b
k = (forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, b #))
-> EST e s b
forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST
(\(# PromptTag# (Either e r)
t, State# s
s0 #) -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
m (# PromptTag# (Either e r)
t, State# s
s0 #) of {
(# State# s
s1, a
x #) -> case a -> EST e s b
k a
x of {
EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, b #)
f -> (# PromptTag# (Either e r), State# s #) -> (# State# s, b #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, b #)
f (# PromptTag# (Either e r)
t, State# s
s1 #) }})
pattern EST :: (forall r. (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)) -> EST e s a
pattern $mEST :: forall {r} {e} {s} {a}.
EST e s a
-> ((forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> r)
-> ((# #) -> r)
-> r
$bEST :: forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST f <- EST_ f
where EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
f = (forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST_ (((# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall a b. (a -> b) -> a -> b
oneShot (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
f)
{-# COMPLETE EST #-}
liftST :: ST s a -> EST e s a
liftST :: forall s a e. ST s a -> EST e s a
liftST (ST STRep s a
f) = (forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\ (# PromptTag# (Either e r)
_, State# s
s #) -> STRep s a
f State# s
s)
earlyExitEST :: e -> EST e s any
earlyExitEST :: forall e s any. e -> EST e s any
earlyExitEST e
e = (forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, any #))
-> EST e s any
forall e s a.
(forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\(# PromptTag# (Either e r)
tag, State# s
s0 #) -> PromptTag# (Either e r)
-> (((State# s -> (# State# s, any #))
-> State# s -> (# State# s, Either e r #))
-> State# s -> (# State# s, Either e r #))
-> State# s
-> (# State# s, any #)
forall a s b.
PromptTag# a
-> (((State# s -> (# State# s, b #))
-> State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> State# s
-> (# State# s, b #)
control0## PromptTag# (Either e r)
tag (\(State# s -> (# State# s, any #))
-> State# s -> (# State# s, Either e r #)
_k State# s
s -> (# State# s
s, e -> Either e r
forall a b. a -> Either a b
Left e
e #)) State# s
s0)
runEST :: forall e a. (forall s. EST e s a) -> Either e a
runEST :: forall e a. (forall s. EST e s a) -> Either e a
runEST (EST forall r.
(# PromptTag# (Either e r), State# RealWorld #)
-> (# State# RealWorld, a #)
f) = (State# RealWorld -> Either e a) -> Either e a
forall o. (State# RealWorld -> o) -> o
runRW#
(\State# RealWorld
s0 -> case State# RealWorld -> (# State# RealWorld, PromptTag# (Either e a) #)
forall a. State# RealWorld -> (# State# RealWorld, PromptTag# a #)
newPromptTag# State# RealWorld
s0 of {
(# State# RealWorld
s1, PromptTag# (Either e a)
tag #) -> case PromptTag# (Either e a)
-> (State# RealWorld -> (# State# RealWorld, Either e a #))
-> State# RealWorld
-> (# State# RealWorld, Either e a #)
forall a.
PromptTag# a
-> (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
prompt# PromptTag# (Either e a)
tag
(\State# RealWorld
s2 -> case (# PromptTag# (Either e a), State# RealWorld #)
-> (# State# RealWorld, a #)
forall r.
(# PromptTag# (Either e r), State# RealWorld #)
-> (# State# RealWorld, a #)
f (# PromptTag# (Either e a)
tag, State# RealWorld
s2 #) of (# State# RealWorld
s3, a
a #) -> (# State# RealWorld
s3, a -> Either e a
forall a b. b -> Either a b
Right a
a #)) State# RealWorld
s1 of {
(# State# RealWorld
_, Either e a
a #) -> Either e a
a }})