组成延续和状态单子变换器的正确方法答案

【问题标题】：Right way to compose continuation and state monad transformers组成延续和状态单子变换器的正确方法
【发布时间】：2014-05-17 20:39:18
【问题描述】：

我有用 Haskell 编写的原始解释器。该解释器可以正确处理return 语句（see my previous question）。

现在我想为我的解释器添加全局状态。此状态可以从全局代码或函数代码更改（函数代码以runCont运行，提供return逻辑）。

代码如下：

import Control.Monad.Cont
import Control.Monad.State

type MyState = String
data Statement = Return Int | GetState | SetState MyState | FuncCall [Statement] deriving (Show)
data Value = Undefined | Value Int | StateValue MyState deriving (Show)

type Eval a = StateT MyState (Cont (Value, MyState)) a

runEval ::(Eval Value) -> MyState -> (Value, MyState)
runEval eval state = runCont (runStateT eval state) id

evalProg :: [Statement] -> Value
evalProg stmts = fst $ runEval (evalBlock stmts) $ ""

evalBlock :: [Statement] -> Eval Value
evalBlock [] = return Undefined
evalBlock [stmt] = evalStatment stmt
evalBlock (st:stmts) = evalStatment st >> evalBlock stmts

evalStatment :: Statement -> Eval Value
evalStatment (Return val) = do
    state <- get
    lift $ cont $ \_ -> (Value val, state)
evalStatment (SetState state) = put state >> return Undefined
evalStatment (FuncCall stmts) = do
    -- I don't like this peace of code
    state <- get
    (value, newState) <- return $ runEval (evalBlock stmts) $ state
    put newState
    return value
evalStatment GetState = get >>= return . StateValue

test2 = evalProg [SetState "Hello", FuncCall [SetState "Galaxy", Return 3], GetState] -- result is StateValue "Galaxy"

这段代码运行良好，但我不喜欢这段代码的evalStatment (FuncCall stmts) 部分。我将解释器的当前状态传递给runEval 函数，然后取回修改后的状态并将其设置为新解释器的状态。

是否可以改进此代码？我能以某种方式制作函数的代码吗 (FuncCall) 隐式操作解释器的状态（不获取当前状态和运行函数的代码和显式设置解释器的新状态）？

【问题讨论】：

你只需要sequence :: Monad m => [m a] -> m [a]吗？后面可能是liftM last :: Monad m => m [a] -> m a?

标签： haskell state continuations monad-transformers

【解决方案1】：

我建议您将基本 Monad 更改为

type Eval a = ContT Value (State MyState) a

这样，State MyState 部分位于“monad 转换器堆栈”的底部，您将能够更轻松地仅拉出上部延续部分而不会影响状态。那么FuncCall的情况就可以简单了

evalStatment (FuncCall stmts) = lift $ runContT (evalBlock stmts) return

当然，这也需要重写一些其他部分。但并不多，而且大部分实际上变得更简单了！以下是我需要更改的所有部分：

type Eval a = ContT Value (State MyState) a

runEval eval state = runState (runContT eval return) state 

evalStatment (Return val) = ContT $ \_ -> return (Value val)

evalStatment (FuncCall stmts) = lift $ runContT (evalBlock stmts) return

【讨论】：