module StateBase (PreCST(..), ErrorState(..), BaseState(..),
nop, yield, (+>=), (+>), fixCST,
unpackCST, readCST, writeCST, transCST, liftIO)
where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
import Control.Monad.Fail (MonadFail (..))
import Position (Position)
import UNames (NameSupply)
import StateTrans (STB,
fixSTB, readGeneric, writeGeneric, transGeneric, readBase,
transBase)
import qualified
StateTrans (liftIO)
import Errors (ErrorLvl(..), Error)
infixr 1 +>=, +>
data ErrorState = ErrorState ErrorLvl
Int
[Error]
data BaseState e = BaseState {
BaseState e -> (String, String, String)
idTKBS :: (String, String, String),
BaseState e -> (String, String, String)
idBS :: (String, String, String),
BaseState e -> ErrorState
errorsBS :: ErrorState,
BaseState e -> [NameSupply]
suppliesBS :: [NameSupply],
:: e
}
newtype PreCST e s a = CST (STB (BaseState e) s a)
instance Functor (PreCST e s) where
fmap :: (a -> b) -> PreCST e s a -> PreCST e s b
fmap = (a -> b) -> PreCST e s a -> PreCST e s b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (PreCST e s) where
pure :: a -> PreCST e s a
pure = a -> PreCST e s a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: PreCST e s (a -> b) -> PreCST e s a -> PreCST e s b
(<*>) = PreCST e s (a -> b) -> PreCST e s a -> PreCST e s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (PreCST e s) where
return :: a -> PreCST e s a
return = a -> PreCST e s a
forall a e s. a -> PreCST e s a
yield
>>= :: PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
(>>=) = PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
forall e s a b. PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
(+>=)
>> :: PreCST e s a -> PreCST e s b -> PreCST e s b
(>>) = PreCST e s a -> PreCST e s b -> PreCST e s b
forall e s a b. PreCST e s a -> PreCST e s b -> PreCST e s b
(+>)
instance MonadFail (PreCST e s) where
fail :: String -> PreCST e s a
fail = String -> PreCST e s a
forall a. HasCallStack => String -> a
error
unpackCST :: PreCST e s a -> STB (BaseState e) s a
unpackCST :: PreCST e s a -> STB (BaseState e) s a
unpackCST PreCST e s a
m = let CST STB (BaseState e) s a
m' = PreCST e s a
m in STB (BaseState e) s a
m'
yield :: a -> PreCST e s a
yield :: a -> PreCST e s a
yield a
a = STB (BaseState e) s a -> PreCST e s a
forall e s a. STB (BaseState e) s a -> PreCST e s a
CST (STB (BaseState e) s a -> PreCST e s a)
-> STB (BaseState e) s a -> PreCST e s a
forall a b. (a -> b) -> a -> b
$ a -> STB (BaseState e) s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
(+>=) :: PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
PreCST e s a
m +>= :: PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
+>= a -> PreCST e s b
k = STB (BaseState e) s b -> PreCST e s b
forall e s a. STB (BaseState e) s a -> PreCST e s a
CST (STB (BaseState e) s b -> PreCST e s b)
-> STB (BaseState e) s b -> PreCST e s b
forall a b. (a -> b) -> a -> b
$ PreCST e s a -> STB (BaseState e) s a
forall e s a. PreCST e s a -> STB (BaseState e) s a
unpackCST PreCST e s a
m STB (BaseState e) s a
-> (a -> STB (BaseState e) s b) -> STB (BaseState e) s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
a -> PreCST e s b -> STB (BaseState e) s b
forall e s a. PreCST e s a -> STB (BaseState e) s a
unpackCST (a -> PreCST e s b
k a
a))
(+>) :: PreCST e s a -> PreCST e s b -> PreCST e s b
PreCST e s a
k +> :: PreCST e s a -> PreCST e s b -> PreCST e s b
+> PreCST e s b
m = PreCST e s a
k PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
forall e s a b. PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
+>= PreCST e s b -> a -> PreCST e s b
forall a b. a -> b -> a
const PreCST e s b
m
nop :: PreCST e s ()
nop :: PreCST e s ()
nop = () -> PreCST e s ()
forall a e s. a -> PreCST e s a
yield ()
fixCST :: (a -> PreCST e s a) -> PreCST e s a
fixCST :: (a -> PreCST e s a) -> PreCST e s a
fixCST a -> PreCST e s a
m = STB (BaseState e) s a -> PreCST e s a
forall e s a. STB (BaseState e) s a -> PreCST e s a
CST (STB (BaseState e) s a -> PreCST e s a)
-> STB (BaseState e) s a -> PreCST e s a
forall a b. (a -> b) -> a -> b
$ (a -> STB (BaseState e) s a) -> STB (BaseState e) s a
forall a bs gs. (a -> STB bs gs a) -> STB bs gs a
fixSTB (PreCST e s a -> STB (BaseState e) s a
forall e s a. PreCST e s a -> STB (BaseState e) s a
unpackCST (PreCST e s a -> STB (BaseState e) s a)
-> (a -> PreCST e s a) -> a -> STB (BaseState e) s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PreCST e s a
m)
readCST :: (s -> a) -> PreCST e s a
readCST :: (s -> a) -> PreCST e s a
readCST s -> a
f = STB (BaseState e) s a -> PreCST e s a
forall e s a. STB (BaseState e) s a -> PreCST e s a
CST (STB (BaseState e) s a -> PreCST e s a)
-> STB (BaseState e) s a -> PreCST e s a
forall a b. (a -> b) -> a -> b
$ (s -> a) -> STB (BaseState e) s a
forall gs a bs. (gs -> a) -> STB bs gs a
readGeneric s -> a
f
writeCST :: s -> PreCST e s ()
writeCST :: s -> PreCST e s ()
writeCST s
s' = STB (BaseState e) s () -> PreCST e s ()
forall e s a. STB (BaseState e) s a -> PreCST e s a
CST (STB (BaseState e) s () -> PreCST e s ())
-> STB (BaseState e) s () -> PreCST e s ()
forall a b. (a -> b) -> a -> b
$ s -> STB (BaseState e) s ()
forall gs bs. gs -> STB bs gs ()
writeGeneric s
s'
transCST :: (s -> (s, a)) -> PreCST e s a
transCST :: (s -> (s, a)) -> PreCST e s a
transCST s -> (s, a)
f = STB (BaseState e) s a -> PreCST e s a
forall e s a. STB (BaseState e) s a -> PreCST e s a
CST (STB (BaseState e) s a -> PreCST e s a)
-> STB (BaseState e) s a -> PreCST e s a
forall a b. (a -> b) -> a -> b
$ (s -> (s, a)) -> STB (BaseState e) s a
forall gs a bs. (gs -> (gs, a)) -> STB bs gs a
transGeneric s -> (s, a)
f
liftIO :: IO a -> PreCST e s a
liftIO :: IO a -> PreCST e s a
liftIO IO a
m = STB (BaseState e) s a -> PreCST e s a
forall e s a. STB (BaseState e) s a -> PreCST e s a
CST (STB (BaseState e) s a -> PreCST e s a)
-> STB (BaseState e) s a -> PreCST e s a
forall a b. (a -> b) -> a -> b
$ (IO a -> STB (BaseState e) s a
forall a bs gs. IO a -> STB bs gs a
StateTrans.liftIO IO a
m)