F# 重写计算表达式

3
我正在学习continuations,因为我想要对协程进行一些有趣的应用……无论如何,我想更好地理解我找到的一种实现方法。
为了做到这一点,我想重新编写实现方法,而不使用计算表达式(continuation Monad),但我还不能完全做到。
我有这个:
type K<'T,'r> = (('T -> 'r) -> 'r)

let returnK x = (fun k -> k x)
let bindK m f = (fun k -> m (fun a -> f a k))
let runK (c:K<_,_>) cont = c cont
let callcK (f: ('T -> K<'b,'r>) -> K<'T,'r>) : K<'T,'r> =
    fun cont -> runK (f (fun a -> (fun _ -> cont a))) cont

type ContinuationBuilder() =
    member __.Return(x) = returnK x
    member __.ReturnFrom(x) =  x
    member __.Bind(m,f) =  bindK m f
    member this.Zero () = this.Return ()

let K = new ContinuationBuilder()

/// The coroutine type from http://fssnip.net/7M
type Coroutine() =
    let tasks = new System.Collections.Generic.Queue<K<unit,unit>>()

    member this.Put(task) =

        let withYield = K {
            do! callcK (fun exit ->
                    task (fun () ->
                        callcK (fun c ->
                            tasks.Enqueue(c())
                            exit ())))
            if tasks.Count <> 0 then
                do! tasks.Dequeue() }
        tasks.Enqueue(withYield)

    member this.Run() =
        runK (tasks.Dequeue()) ignore 

// from FSharpx tests
let ``When running a coroutine it should yield elements in turn``() =
  // This test comes from the sample on http://fssnip.net/7M
  let actual = System.Text.StringBuilder()
  let coroutine = Coroutine()
  coroutine.Put(fun yield' -> K {
    actual.Append("A") |> ignore
    do! yield' ()
    actual.Append("B") |> ignore
    do! yield' ()
    actual.Append("C") |> ignore
    do! yield' ()
  })
  coroutine.Put(fun yield' -> K {
    actual.Append("1") |> ignore
    do! yield' ()
    actual.Append("2") |> ignore
    do! yield' ()
  })
  coroutine.Run()
  actual.ToString() = "A1B2C"

``When running a coroutine it should yield elements in turn``()

因此,我想重写Coroutine类的Put成员,而不使用计算表达式K

我当然已经阅读了thisthis以及其他几篇关于catamorphisms的文章,但是重写这个续航monand并不像重写Write Monad那样容易...

我尝试了几种方法,这是其中之一:

member this.Put(task) =

    let withYield =
        bindK
            (callcK (fun exit ->
                task (fun () ->
                    callcK (fun c ->
                        tasks.Enqueue(c())
                        exit ()))))
            (fun () ->
                if tasks.Count <> 0 
                then tasks.Dequeue()
                else returnK ())
    tasks.Enqueue(withYield)

当然它不起作用 :(
(顺便说一下:是否有一些广泛的文档,介绍编译器将计算重写为纯F#所应用的所有规则?)
1个回答

3
您的 Put 版本接近正确,但有两个问题:
  • bindK 函数被使用反了,需要交换参数。
  • task 应该传递一个 Cont<_,_> -> Cont<_,_>,而不是一个 unit -> Cont<_,_> -> Cont<_,_>
修复这些问题后,它可以看起来像这样:
    member this.Put(task) =
        let withYield =
            bindK
                (fun () ->
                    if tasks.Count <> 0 
                    then tasks.Dequeue()
                    else returnK ())
                (callcK (fun exit ->
                    task (
                        callcK (fun c ->
                            tasks.Enqueue(c())
                            exit ()))))
        tasks.Enqueue(withYield)

当然,这并不太优雅。 在使用 bind 时最好声明一个运算符 >>=:
let (>>=) c f = bindK f c

这样

  • do!的翻译是在之后加上>>= fun () ->
  • let! a =的翻译是在之后加上>>= fun a ->

这样你的代码看起来会更好一些:

    member this.Put2(task) =
        let withYield =
            callcK( fun exit ->
                    task( callcK (fun c ->  
                        tasks.Enqueue(c())
                        exit())
                    )
                ) >>= fun () -> 
            if tasks.Count <> 0 then
                tasks.Dequeue() 
            else returnK ()
        tasks.Enqueue withYield

谢谢你的回答。我的问题是在bindK函数中倒置了参数顺序,先是m再是f,这样它的签名与构造器相同。你给出的Put版本虽然编译通过,但测试无法编译,因为yield'应该是(unit -> K<unit,unit>) - sabotero
我在复制/粘贴时遇到了一个错误:)。我进行了编辑,以便参数可以按照这个顺序使用 let bindK m f = ...。 不过,yield' 应该是 (unit -> K<unit, unit>) - sabotero
当我进行测试时,我将 do! yield' () 更改为 do! yield',然后它就起作用了。 - AMieres
你说得完全正确!我又复制/粘贴错了!昨晚在巴黎这里很晚了。 - sabotero

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接