{-# LANGUAGE FlexibleInstances #-}
module Language.Egison.RState
( RState (..)
, RuntimeT
, RuntimeM
, MonadRuntime (..)
, runRuntimeT
, evalRuntimeT
) where
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Strict
import Language.Egison.AST
import Language.Egison.CmdOptions
data RState = RState
{ RState -> Int
indexCounter :: Int
, RState -> [Op]
exprOps :: [Op]
, RState -> [Op]
patternOps :: [Op]
}
initialRState :: RState
initialRState :: RState
initialRState = RState :: Int -> [Op] -> [Op] -> RState
RState
{ indexCounter :: Int
indexCounter = Int
0
, exprOps :: [Op]
exprOps = [Op]
reservedExprOp
, patternOps :: [Op]
patternOps = [Op]
reservedPatternOp
}
type RuntimeT m = ReaderT EgisonOpts (StateT RState m)
type RuntimeM = RuntimeT IO
class (Applicative m, Monad m) => MonadRuntime m where
fresh :: m String
instance Monad m => MonadRuntime (RuntimeT m) where
fresh :: RuntimeT m String
fresh = do
RState
st <- StateT RState m RState
-> ReaderT EgisonOpts (StateT RState m) RState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT RState m RState
forall (m :: * -> *) s. Monad m => StateT s m s
get
StateT RState m () -> ReaderT EgisonOpts (StateT RState m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((RState -> RState) -> StateT RState m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\RState
st -> RState
st { indexCounter :: Int
indexCounter = RState -> Int
indexCounter RState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }))
String -> RuntimeT m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> RuntimeT m String) -> String -> RuntimeT m String
forall a b. (a -> b) -> a -> b
$ String
"$_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (RState -> Int
indexCounter RState
st)
runRuntimeT :: Monad m => EgisonOpts -> RuntimeT m a -> m (a, RState)
runRuntimeT :: EgisonOpts -> RuntimeT m a -> m (a, RState)
runRuntimeT EgisonOpts
opts = (StateT RState m a -> RState -> m (a, RState))
-> RState -> StateT RState m a -> m (a, RState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT RState m a -> RState -> m (a, RState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT RState
initialRState (StateT RState m a -> m (a, RState))
-> (RuntimeT m a -> StateT RState m a)
-> RuntimeT m a
-> m (a, RState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RuntimeT m a -> EgisonOpts -> StateT RState m a)
-> EgisonOpts -> RuntimeT m a -> StateT RState m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RuntimeT m a -> EgisonOpts -> StateT RState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT EgisonOpts
opts
evalRuntimeT :: Monad m => EgisonOpts -> RuntimeT m a -> m a
evalRuntimeT :: EgisonOpts -> RuntimeT m a -> m a
evalRuntimeT EgisonOpts
opts = (StateT RState m a -> RState -> m a)
-> RState -> StateT RState m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT RState m a -> RState -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT RState
initialRState (StateT RState m a -> m a)
-> (RuntimeT m a -> StateT RState m a) -> RuntimeT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RuntimeT m a -> EgisonOpts -> StateT RState m a)
-> EgisonOpts -> RuntimeT m a -> StateT RState m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RuntimeT m a -> EgisonOpts -> StateT RState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT EgisonOpts
opts