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 {
forall e. BaseState e -> (String, String, String)
idTKBS :: (String, String, String),
forall e. BaseState e -> (String, String, String)
idBS :: (String, String, String),
forall e. BaseState e -> ErrorState
errorsBS :: ErrorState,
forall e. BaseState e -> [NameSupply]
suppliesBS :: [NameSupply],
:: e
}
newtype PreCST e s a = CST (STB (BaseState e) s a)
instance Functor (PreCST e s) where
fmap :: forall a b. (a -> b) -> PreCST e s a -> PreCST e s b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (PreCST e s) where
pure :: forall a. a -> PreCST e s a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a 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 :: forall a. a -> PreCST e s a
return = forall a e s. a -> PreCST e s a
yield
>>= :: forall a 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
(+>=)
>> :: forall a 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 :: forall a. String -> PreCST e s a
fail = forall a. HasCallStack => String -> a
error
unpackCST :: PreCST e s a -> STB (BaseState e) s a
unpackCST :: forall e s a. 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 :: forall a e s. a -> PreCST e s a
yield a
a = forall e s a. STB (BaseState e) s a -> PreCST e s a
CST forall a b. (a -> b) -> a -> b
$ 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 +>= :: forall e s a b. PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
+>= a -> PreCST e s b
k = forall e s a. STB (BaseState e) s a -> PreCST e s a
CST forall a b. (a -> b) -> a -> b
$ forall e s a. PreCST e s a -> STB (BaseState e) s a
unpackCST PreCST e s a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
a -> 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 +> :: forall e s a b. PreCST e s a -> PreCST e s b -> PreCST e s b
+> PreCST e s b
m = PreCST e s a
k forall e s a b. PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b
+>= forall a b. a -> b -> a
const PreCST e s b
m
nop :: PreCST e s ()
nop :: forall e s. PreCST e s ()
nop = forall a e s. a -> PreCST e s a
yield ()
fixCST :: (a -> PreCST e s a) -> PreCST e s a
fixCST :: forall a e s. (a -> PreCST e s a) -> PreCST e s a
fixCST a -> PreCST e s a
m = forall e s a. STB (BaseState e) s a -> PreCST e s a
CST forall a b. (a -> b) -> a -> b
$ forall a bs gs. (a -> STB bs gs a) -> STB bs gs a
fixSTB (forall e s a. PreCST e s a -> STB (BaseState e) s a
unpackCST forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PreCST e s a
m)
readCST :: (s -> a) -> PreCST e s a
readCST :: forall s a e. (s -> a) -> PreCST e s a
readCST s -> a
f = forall e s a. STB (BaseState e) s a -> PreCST e s a
CST forall a b. (a -> b) -> a -> b
$ forall gs a bs. (gs -> a) -> STB bs gs a
readGeneric s -> a
f
writeCST :: s -> PreCST e s ()
writeCST :: forall s e. s -> PreCST e s ()
writeCST s
s' = forall e s a. STB (BaseState e) s a -> PreCST e s a
CST forall a b. (a -> b) -> a -> b
$ forall gs bs. gs -> STB bs gs ()
writeGeneric s
s'
transCST :: (s -> (s, a)) -> PreCST e s a
transCST :: forall s a e. (s -> (s, a)) -> PreCST e s a
transCST s -> (s, a)
f = forall e s a. STB (BaseState e) s a -> PreCST e s a
CST forall a b. (a -> b) -> a -> b
$ forall gs a bs. (gs -> (gs, a)) -> STB bs gs a
transGeneric s -> (s, a)
f
liftIO :: IO a -> PreCST e s a
liftIO :: forall a e s. IO a -> PreCST e s a
liftIO IO a
m = forall e s a. STB (BaseState e) s a -> PreCST e s a
CST forall a b. (a -> b) -> a -> b
$ (forall a bs gs. IO a -> STB bs gs a
StateTrans.liftIO IO a
m)