module Control.Monad.Trans.FastFresh (
Fresh
, runFresh
, evalFresh
, execFresh
, FreshT(..)
, freshT
, runFreshT
, evalFreshT
, execFreshT
, FreshState
, nothingUsed
, freshIdents
, scopeFreshness
) where
import Control.Basics
import Control.Monad.Identity
import Control.Monad.State.Strict
import Control.Monad.Error
import Control.Monad.Reader
type FreshState = Integer
newtype FreshT m a = FreshT { unFreshT :: StateT FreshState m a }
deriving( Functor, Applicative, Alternative, Monad, MonadPlus, MonadTrans )
freshT :: (FreshState -> m (a, FreshState)) -> FreshT m a
freshT = FreshT . StateT
nothingUsed :: FreshState
nothingUsed = 0
runFreshT :: FreshT m a -> FreshState -> m (a, FreshState)
runFreshT (FreshT m) used = runStateT m used
evalFreshT :: Monad m => FreshT m a -> FreshState -> m a
evalFreshT (FreshT m) used = evalStateT m used
execFreshT :: Monad m => FreshT m a -> FreshState -> m FreshState
execFreshT (FreshT m) used = execStateT m used
freshIdents :: Monad m
=> Integer
-> FreshT m Integer
freshIdents k = do
i <- FreshT get
FreshT $ put $ i + k
return i
scopeFreshness :: Monad m => FreshT m a -> FreshT m a
scopeFreshness scoped = do
st <- FreshT get
x <- scoped
FreshT (put st)
return x
instance MonadError e m => MonadError e (FreshT m) where
throwError = lift . throwError
catchError m h = FreshT $ catchError (unFreshT m) (unFreshT . h)
instance MonadReader r m => MonadReader r (FreshT m) where
ask = lift ask
local f m = FreshT $ local f $ unFreshT m
instance MonadState s m => MonadState s (FreshT m) where
get = lift get
put s = lift $ put s
type Fresh = FreshT Identity
runFresh :: Fresh a -> FreshState -> (a, FreshState)
runFresh (FreshT m) used = runState m used
evalFresh :: Fresh a -> FreshState -> a
evalFresh (FreshT m) used = evalState m used
execFresh :: Fresh a -> FreshState -> FreshState
execFresh (FreshT m) used = execState m used