异步 – F#异步工作流/任务与免费monad相结合

此外,Free Monad真的只在Haskell中有意义,你需要做的就是定义一个仿函数,然后你自动完成其余的实现.在F#中,您还必须编写其余的代码,因此使用Free比传统的解释器模式没有多大好处.
您链接到的TurtleProgram代码只是一个实验 – 我不建议使用Free代替实际代码.

最后,如果您已经知道将要使用的效果,并且您不会有多个解释,那么使用这种方法是没有意义的.只有当收益超过复杂性时才有意义.

无论如何,如果你确实想要编写一个解释器版本(而不是Free),我就是这样做的：

首先,定义指令而不产生任何影响.

/// The abstract instruction set
module PipeProgram =

    type PipeInstruction<'msgIn,'state> =
        | Handle of 'msgIn * ('msgOut -> PipeInstruction<'msgIn,'state>)
        | SendOut of 'msgOut * (unit -> PipeInstruction<'msgIn,'state>)
        | Stop of 'state

然后你可以为它编写一个计算表达式：

/// A computation expression for a PipeProgram
module PipeProgramCE =
    open PipeProgram

    let rec bind f instruction =
        match instruction with
        | Handle (x,next) ->  Handle (x,(next >> bind f))
        | SendOut (x,next) -> SendOut (x,(next >> bind f))
        | Stop x -> f x

    type PipeBuilder() =
        member __.Bind (x,f) = bind f x
        member __.Return x = Stop x
        member __.Zero () = Stop ()
        member __.ReturnFrom x = x

let pipe = PipeProgramCE.PipeBuilder()

然后你就可以开始编写你的计算表??达式了.这将有助于在开始使用解释器之前清除设计.

// helper functions for CE
let stop x = PipeProgram.Stop x
let handle x = PipeProgram.Handle (x,stop)
let sendOut x  = PipeProgram.SendOut (x,stop)

let exampleProgram : PipeProgram.PipeInstruction<string,string,string> = pipe {
    let! msgOut1 = handle "In1"
    do! sendOut msgOut1
    let! msgOut2 = handle "In2"
    do! sendOut msgOut2
    return msgOut2
    }

一旦描述了说明,就可以编写解释器.正如我所说,如果你不是在写多个口译员,那么也许你根本不需要这样做.

这是一个非异步版本的解释器(“Id monad”,就像它一样)：

module PipeInterpreterSync =
    open PipeProgram

    let handle msgIn =
        printfn "In: %A"  msgIn
        let msgOut = System.Console.ReadLine()
        msgOut

    let sendOut msgOut =
        printfn "Out: %A"  msgOut
        ()

    let rec interpret instruction =
        match instruction with
        | Handle (x,next) ->
            let result = handle x
            result |> next |> interpret
        | SendOut (x,next) ->
            let result = sendOut x
            result |> next |> interpret
        | Stop x ->
            x

这是异步版本：

module PipeInterpreterAsync =
    open PipeProgram

    /// Implementation of "handle" uses async/IO
    let handleAsync msgIn = async {
        printfn "In: %A"  msgIn
        let msgOut = System.Console.ReadLine()
        return msgOut
        }

    /// Implementation of "sendOut" uses async/IO
    let sendOutAsync msgOut = async {
        printfn "Out: %A"  msgOut
        return ()
        }

    let rec interpret instruction =
        match instruction with
        | Handle (x,next) -> async {
            let! result = handleAsync x
            return! result |> next |> interpret
            }
        | SendOut (x,next) -> async {
            do! sendOutAsync x
            return! () |> next |> interpret
            }
        | Stop x -> x