F# переписать вычислительное выражение

Question

Я изучаю продолжения, потому что я хочу использовать интересные сопрограммы... в любом случае, я хочу лучше понять одну реализацию, которую я нашел.

Для этого я хочу переписать реализацию без использования вычислительного выражения (продолжение 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``()

Итак, я хочу переписать Put член класса Coroutine без использования вычислительного выражения K,

Я, конечно, читал эту, эту и несколько других статей о катаморфизмах, но переписать этот монанд продолжения не так просто, как, например, переписать монаду записи...

Я пробую несколько способов, это один из них:

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#?)

Answer 1

Ваша версия 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